142 lines
5.6 KiB
ArmAsm
142 lines
5.6 KiB
ArmAsm
|
TITLE ASCIIBIN ASCII<->Binary Converter
|
||
|
|
|
||
|
|
* Author: Eric Rechlin
|
||
|
|
|
||
|
|
ASSEMBLE
|
||
|
|
NIBASC /HPHP49-C/
|
||
|
|
* NIBASC /HPHP48-R/
|
||
|
|
|
||
|
|
RPL
|
||
|
|
::
|
||
|
|
CK1NoBlame ( one argument, attribute errors correctly )
|
||
|
|
CK&DISPATCH1 ( one argument... )
|
||
|
|
THREE ( ...check if it's a string )
|
||
|
|
::
|
||
|
|
DUP ( duplicate string )
|
||
|
|
ELEVEN ( last character + 1 to pull out )
|
||
|
|
1_#1-SUB$ ( pull out string of first characters )
|
||
|
|
"%%HP:" ( test string )
|
||
|
|
ONE ( search from first position )
|
||
|
|
POS$ ( find position of test string )
|
||
|
|
DUP ( duplicate position )
|
||
|
|
#0=?SKIP ( if header doesn't exist, skip secondary )
|
||
|
|
::
|
||
|
|
#5+ ( skip "%%HP:" header )
|
||
|
|
LAST$ ( pull out the rest of the string on level three )
|
||
|
|
DUP ( duplicate string )
|
||
|
|
";" ( substring to find )
|
||
|
|
ONE ( search from first position )
|
||
|
|
POS$ ( find position of substring )
|
||
|
|
2DUP ( duplicate string and position )
|
||
|
|
#1+ ( add one to bint...this is first char to take )
|
||
|
|
LAST$ ( pull out the rest of the string on level three )
|
||
|
|
UNROT ( 3 2 1 -> 1 3 2 )
|
||
|
|
1_#1-SUB$ ( take out the Kermit header at given position )
|
||
|
|
DUPLEN$ ( get length of header while keeping header on stack )
|
||
|
|
THIRTEEN #= ( header should be 13 characters long )
|
||
|
|
?SKIP ( don't error if header string is 13 characters long )
|
||
|
|
SETSIZEERR ( otherwise, give Bad Argument Value error )
|
||
|
|
RCLSYSF ( back up system flags to hex string in level one )
|
||
|
|
UNROT ( move flags backup to level 3 to get them out of the way )
|
||
|
|
DUP ( duplicate header )
|
||
|
|
FOUR ( " T(3)A(R)F(.)" )
|
||
|
|
SUB$1# ( ^ to ASCII code )
|
||
|
|
FORTYEIGHT ( ASCII code for 0 is 48d )
|
||
|
|
#- ( subtract 48 from ASCII code to get 0 through 3 )
|
||
|
|
UNCOERCE ( convert bint to real )
|
||
|
|
DOTRANSIO ( set ASCII translation mode to real on level one )
|
||
|
|
DUP
|
||
|
|
EIGHT ( " T(3)A(R)F(.)" )
|
||
|
|
SUB$1# ( ^ to ASCII code )
|
||
|
|
DUP ( duplicate ASCII code for D/R/G )
|
||
|
|
#52 ( ASCII code for R is 82d (52h) )
|
||
|
|
#= ( is it in radians mode? )
|
||
|
|
ITE ( do next semi if true, or the next one if false )
|
||
|
|
::
|
||
|
|
SEVENTEEN ( radians mode: flag -17 )
|
||
|
|
SetSysFlag ( set system flag -17 )
|
||
|
|
DROP ( drop extra ASCII code )
|
||
|
|
;
|
||
|
|
::
|
||
|
|
SEVENTEEN ( radians mode: flag -17 )
|
||
|
|
ClrSysFlag ( not radians: clear system flag -17 )
|
||
|
|
#47 ( ASCII code for G is 71d (47h) )
|
||
|
|
#= ( is it in grads mode? )
|
||
|
|
ITE ( do next semi if true, or the next one if false )
|
||
|
|
::
|
||
|
|
EIGHTEEN ( grads/degrees mode: flag -18 )
|
||
|
|
SetSysFlag ( grads mode: set system flag -18 )
|
||
|
|
;
|
||
|
|
::
|
||
|
|
EIGHTEEN ( grads/degrees mode: flag -18 )
|
||
|
|
ClrSysFlag ( must be degrees mode: clear system flag -18 )
|
||
|
|
;
|
||
|
|
;
|
||
|
|
TWELVE ( " T(3)A(R)F(.)" )
|
||
|
|
SUB$1# ( ^ to ASCII code )
|
||
|
|
FORTYFOUR ( ASCII code for , is 44d )
|
||
|
|
#= ( is the fraction mark a comma? )
|
||
|
|
ITE ( do next semi if true, or the next one if false )
|
||
|
|
::
|
||
|
|
FIFTYONE ( fraction mark: flag -51 )
|
||
|
|
SetSysFlag ( fraction mark is comma: set system flag -51 )
|
||
|
|
;
|
||
|
|
::
|
||
|
|
FIFTYONE ( fraction mark: flag -51 )
|
||
|
|
ClrSysFlag ( fraction mark must be period: clear system flag -51 )
|
||
|
|
;
|
||
|
|
;
|
||
|
|
KINVISLF ( translate, remove all CR's; we just need LF's )
|
||
|
|
DROP ( drop empty string )
|
||
|
|
SWAP ( get backup of system flags from level two )
|
||
|
|
DOSTOSYSF ( restore system flags to previous settings )
|
||
|
|
palparse ( get object from string, returns true or false )
|
||
|
|
NOTcase2DROP ( if conversion fails drop two objects and quit )
|
||
|
|
DUP ( duplicate object/composite )
|
||
|
|
CARCOMP ( return first object of the composite )
|
||
|
|
' xSILENT' ( put object xSILENT' on the stack )
|
||
|
|
EQ ( compare them )
|
||
|
|
NOT?SEMI ( if false skip to end of secondary... )
|
||
|
|
TWO ( get 2nd... )
|
||
|
|
NTHCOMPDROP ( ...object behind the xSILENT' )
|
||
|
|
;
|
||
|
|
ZERO ( ...check if it's not a string [actually, anything] )
|
||
|
|
::
|
||
|
|
EDITDECOMP$ ( make into string )
|
||
|
|
KVISLF ( translations, add a CR to each LF for Windows/DOS )
|
||
|
|
"%%HP: T(" ( Kermit pre-header )
|
||
|
|
GetIOPAR ( put IOPAR on 6 levels of stack, TRANSIO mode is in level 1 )
|
||
|
|
6UNROLL 5DROP ( don't need upper 5 levels, so just keep level 1 )
|
||
|
|
IOCheckReal %IP># ( make sure it's valid and convert to bint )
|
||
|
|
DUP FOUR #< ( make sure TRANSIO mode is less than four )
|
||
|
|
?SKIP ( don't error if mode is less than four )
|
||
|
|
SetIOPARErr ( error if mode is not less than four )
|
||
|
|
#>$ ( convert bint to string )
|
||
|
|
!append$ ( combine TRANSIO string with existing header string )
|
||
|
|
")A(" ( string between TRANSIO mode and angle mode )
|
||
|
|
!append$ ( combine strings )
|
||
|
|
SEVENTEEN ( radians mode is system flag -17 )
|
||
|
|
TestSysFlag ( check for radians mode )
|
||
|
|
ITE
|
||
|
|
CHR_R ( character R if radians mode )
|
||
|
|
::
|
||
|
|
EIGHTEEN ( degrees/grads mode is system flag -18 )
|
||
|
|
TestSysFlag ( check for grads mode )
|
||
|
|
ITE ( do next object if true, otherwise the next one )
|
||
|
|
CHR_G ( character G if grad mode )
|
||
|
|
CHR_D ( character D otherwise )
|
||
|
|
;
|
||
|
|
CHR>$ ( convert character to string )
|
||
|
|
!append$ ( combine angle mode string with header string )
|
||
|
|
FIFTYONE ( fraction mark: system flag -51 )
|
||
|
|
TestSysFlag ( check for fraction mark as comma )
|
||
|
|
ITE
|
||
|
|
")F(,)" ( fraction mark is comma )
|
||
|
|
")F(.)" ( otherwise, fraction mark must be period )
|
||
|
|
!append$ ( combine strings )
|
||
|
|
";\0D\0A" ( semicolon, CR, LF )
|
||
|
|
!append$SWAP ( combine strings, swap )
|
||
|
|
!append$ ( combine strings )
|
||
|
|
;
|
||
|
|
;
|