working lshift + add
This commit is contained in:
parent
5704628f44
commit
e4f1e4982b
116
hoax.tal
116
hoax.tal
|
|
@ -85,6 +85,20 @@
|
|||
( "a" 7 bytes )
|
||||
( "abcd" 7 bytes )
|
||||
( "abcde" 12 bytes )
|
||||
( )
|
||||
( LITERAL SYNTAX )
|
||||
( )
|
||||
( 1. decimal numbers )
|
||||
( 0|-?[1-9](0-9)* )
|
||||
( )
|
||||
( 2. hexadecimal numbers )
|
||||
( 0x[0-9a-f]+ )
|
||||
( )
|
||||
( 3. bareword )
|
||||
( [^-0-9 ][^ ]*|-([^0-9 ][^ ]*)? )
|
||||
( )
|
||||
( 4. string )
|
||||
( "(\.|[^"\])" )
|
||||
|
||||
( TODO: special case empty string? )
|
||||
|
||||
|
|
@ -94,6 +108,7 @@
|
|||
%SX { ;emit/short JSR2 }
|
||||
%DEBUG { #010e DEO }
|
||||
%EXIT { #010f DEO BRK }
|
||||
%DIE { #0000 DIV }
|
||||
|
||||
%D { ;display JSR2 }
|
||||
|
||||
|
|
@ -114,6 +129,69 @@
|
|||
( DEBUG EXIT )
|
||||
BRK
|
||||
|
||||
( returns true if buffer contains a hex number or error )
|
||||
@buf-is-hex ( -> bool^ )
|
||||
;buffer/input ;buffer/pos LDA2 OVR2 SUB2 ( start* size* )
|
||||
#0003 LTH2 ,&short JCN ( start* )
|
||||
LDA2 LIT2 "0x EQU2 JMP2r ( 0x-prefix? )
|
||||
&short POP2 #00 JMP2r ( 00 )
|
||||
|
||||
( returns true if buffer contains a decimal number or error )
|
||||
@buf-is-dec
|
||||
;buffer/input ;buffer/pos LDA2 OVR2 SUB2 ( start* size* )
|
||||
DUP2 #0000 GTH2 ,&nonempty JCN ( start* size* )
|
||||
&empty POP2 POP2 #00 JMP2r ( 00 )
|
||||
&nonempty ( start* size* )
|
||||
OVR2 LDA LIT "- NEQ ,&continue JCN ( start* size* )
|
||||
SWP2 INC2 SWP2 ( start+1* size-1* )
|
||||
DUP2 #0000 EQU2 ,&empty JCN ( start+1* size-1* )
|
||||
&continue ( start* size* )
|
||||
LITr "0 #0001 GTH2 STH ADDr ( start* [lower^] )
|
||||
LDAk STH GTHr ( start* [lower>c^] )
|
||||
LDA LIT "9 GTH ( start* c>upper^ [lower>c^] )
|
||||
STHr ORA #00 EQU JMP2r ( lower<=c&&c<=upper )
|
||||
|
||||
( 0 = #30, a = #61 )
|
||||
@char-to-hex ( c^ -> n^ )
|
||||
DUP #60 GTH ,&letter JCN
|
||||
#30 SUB JMP2r
|
||||
&letter #57 SUB JMP2r
|
||||
|
||||
@lshift-16 ( num$ -> res$ )
|
||||
#0000 ;shift-and-add JMP2
|
||||
|
||||
( shift number left by 16-bits and perform an unsigned )
|
||||
( addition of the given 16-bit integer. )
|
||||
( the sign of the 16-bit integer to add is assumed )
|
||||
( to be the same as the original number. )
|
||||
@shift-and-add ( num$ $add -> res$ )
|
||||
STH2 ( num$ [add*] )
|
||||
DUP2 #8000 EQU2 ,&iszero JCN ( num$ [add*] )
|
||||
DUP2 #7fff GTH2 ,&literal JCN ( num$ )
|
||||
DUP2 ;read-object JSR2 ( num$ tag^ ohi* olo* [add*] )
|
||||
STH2 STH2 ( num$ tag^ [add* olo* ohi*] )
|
||||
DUP #f0 AND ( num$ tag^ type^ [add* olo* ohi*] )
|
||||
#30 NEQ ,&error JCN ( num$ tag^ [add* olo* ohi*] )
|
||||
#04 ANDk EQU ,&non-zero-hi JCN ( num$ tag^ [add* olo* ohi*] )
|
||||
STH2kr ORA ,&non-zero-hi JCN ( num$ tag^ [add* olo* ohi*] )
|
||||
POP2r STH2r STH2r ( num$ tag^ olo* add* )
|
||||
;make-obj JSR2 NIP2 JMP2r ( res$ )
|
||||
&non-zero-hi POP2r POP2r ( num$ tag^ [add*] )
|
||||
#04 ORA ROT ROT ( tag^ num$ [add*] )
|
||||
STH2r SWP2 ( tag^ add* num$ )
|
||||
;make-obj JMP2 ( res$ )
|
||||
&literal ( num$ [add*] )
|
||||
#7fff AND2 ( n* [add*] )
|
||||
DUP2 #4000 GTH2 ,&negative JCN ( n* [add*] )
|
||||
#30 ,&create JMP ( n* 30 [add*] )
|
||||
&iszero JMP2r ( zero$ [add*] )
|
||||
&error POP POP2 ;error JMP2 ( <ERROR> )
|
||||
&negative ( n* [add*] )
|
||||
#8000 SWP2 SUB2 #38 ( abs* 38 [add*] )
|
||||
&create ( n* ^tag [add*] )
|
||||
ROT ROT STH2r ( tag^ n* add* )
|
||||
;make-obj JMP2 ( res$ )
|
||||
|
||||
@sym-from-buf ( -> sym$ )
|
||||
;buffer/input ;sym-from-buf-src JMP2
|
||||
|
||||
|
|
@ -193,11 +271,11 @@
|
|||
@end-word0 ( c -> )
|
||||
POP ;on-key-ready #10 DEO2 ( )
|
||||
;echo JSR2 "word 20 00 ( )
|
||||
;buf-is-hex JSR2 BX SP ( )
|
||||
;buf-is-dec JSR2 BX SP ( )
|
||||
;sym-from-buf JSR2 ( obj$ )
|
||||
;display JSR2 ( )
|
||||
;buf-end JSR2 JMP2r ( )
|
||||
( ;buffer/input ;print JSR2 NL
|
||||
POP JMP2r )
|
||||
|
||||
@start-escape ( c -> )
|
||||
;on-key-escaped #10 DEO2 POP BRK
|
||||
|
|
@ -263,7 +341,12 @@
|
|||
#3fff ;u16-to-num JSR2 D
|
||||
#4000 ;u16-to-num JSR2 D
|
||||
#4001 ;u16-to-num JSR2 D
|
||||
#ffff ;u16-to-num JSR2 D
|
||||
#ffff ;u16-to-num JSR2 STH2k D
|
||||
STH2r ;lshift-16 JSR2 STH2k D
|
||||
STH2r ;lshift-16 JSR2 STH2k D
|
||||
STH2r ;lshift-16 JSR2 STH2k D
|
||||
STH2r ;lshift-16 JSR2 STH2k D
|
||||
STH2r ;lshift-16 JSR2 D
|
||||
#30 #5678 #9abc ;make-obj JSR2 STH2k D
|
||||
#34 #1234 STH2r ;make-obj JSR2 D
|
||||
#0003 ;u16-to-num JSR2 null ;cons JSR2 STH2k D
|
||||
|
|
@ -349,22 +432,27 @@
|
|||
|
||||
@display0-unk ( addr* -> )
|
||||
;echo JSR "unknown< 00 ;emit/short JSR2 LIT "> #18 DEO JMP2r
|
||||
|
||||
@display0-rat ( addr* -> )
|
||||
INC2 LDA2k ;display0 JSR2
|
||||
LIT "/ #18 DEO
|
||||
INC2 INC2 LDA2 ;display0 JMP2
|
||||
|
||||
@display0-int ( addr* -> )
|
||||
LDAk #80 LTH ,&non-neg JCN LIT "- #18 DEO
|
||||
&non-neg
|
||||
;echo JSR2 "0x 00
|
||||
&loop
|
||||
LDAk #04 AND ,&is-long JCN
|
||||
INC2 LDA2k ;emit/short JSR2
|
||||
INC2 INC2 LDA2 ;emit/short JMP2
|
||||
&is-long
|
||||
INC2 LDA2k ;emit/short JSR2
|
||||
INC2 INC2 LDA2 ;obj-to-addr JSR2
|
||||
,&loop JMP
|
||||
LDAk #80 LTH ,&non-neg JCN ( addr* )
|
||||
LIT "- #18 DEO ( addr* )
|
||||
&non-neg ( addr* )
|
||||
;echo JSR2 "0x 00 ( addr* )
|
||||
,&loop JSR JMP2r ( )
|
||||
&loop ( addr* )
|
||||
LDAk #04 AND ,&is-long JCN ( addr* )
|
||||
INC2 LDA2k ;emit/short JSR2 ( addr+1* )
|
||||
INC2 INC2 LDA2 ;emit/short JMP2 ( )
|
||||
&is-long ( addr* )
|
||||
INC2 DUP2 INC2 INC2 ( addr+1* addr+3* )
|
||||
LDA2 ;obj-to-addr JSR2 ( addr+1* obj$ )
|
||||
,&loop JSR ( addr+1* )
|
||||
LDA2 ;emit/short JMP2 ( )
|
||||
|
||||
( TODO: \n \t etc. )
|
||||
@display0-char ( c^ -> )
|
||||
|
|
|
|||
Loading…
Reference in New Issue