d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

working lshift + add

This commit is contained in:
~d6 2022-12-12 14:43:56 -05:00
parent 5704628f44
commit e4f1e4982b
1 changed files with 102 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
hoax.tal
View File

@ -85,6 +85,20 @@
( "a" 7 bytes ) ( "a" 7 bytes )
( "abcd" 7 bytes ) ( "abcd" 7 bytes )
( "abcde" 12 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? ) ( TODO: special case empty string? )
@ -94,6 +108,7 @@
%SX { ;emit/short JSR2 } %SX { ;emit/short JSR2 }
%DEBUG { #010e DEO } %DEBUG { #010e DEO }
%EXIT { #010f DEO BRK } %EXIT { #010f DEO BRK }
%DIE { #0000 DIV }
%D { ;display JSR2 } %D { ;display JSR2 }
@ -114,6 +129,69 @@
( DEBUG EXIT ) ( DEBUG EXIT )
BRK 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$ ) @sym-from-buf ( -> sym$ )
;buffer/input ;sym-from-buf-src JMP2 ;buffer/input ;sym-from-buf-src JMP2
@ -193,11 +271,11 @@
@end-word0 ( c -> ) @end-word0 ( c -> )
POP ;on-key-ready #10 DEO2 ( ) POP ;on-key-ready #10 DEO2 ( )
;echo JSR2 "word 20 00 ( ) ;echo JSR2 "word 20 00 ( )
;buf-is-hex JSR2 BX SP ( )
;buf-is-dec JSR2 BX SP ( )
;sym-from-buf JSR2 ( obj$ ) ;sym-from-buf JSR2 ( obj$ )
;display JSR2 ( ) ;display JSR2 ( )
;buf-end JSR2 JMP2r ( ) ;buf-end JSR2 JMP2r ( )
( ;buffer/input ;print JSR2 NL
POP JMP2r )
@start-escape ( c -> ) @start-escape ( c -> )
;on-key-escaped #10 DEO2 POP BRK ;on-key-escaped #10 DEO2 POP BRK
@ -263,7 +341,12 @@
#3fff ;u16-to-num JSR2 D #3fff ;u16-to-num JSR2 D
#4000 ;u16-to-num JSR2 D #4000 ;u16-to-num JSR2 D
#4001 ;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 #30 #5678 #9abc ;make-obj JSR2 STH2k D
#34 #1234 STH2r ;make-obj JSR2 D #34 #1234 STH2r ;make-obj JSR2 D
#0003 ;u16-to-num JSR2 null ;cons JSR2 STH2k D #0003 ;u16-to-num JSR2 null ;cons JSR2 STH2k D
@ -349,22 +432,27 @@
@display0-unk ( addr* -> ) @display0-unk ( addr* -> )
;echo JSR "unknown< 00 ;emit/short JSR2 LIT "> #18 DEO JMP2r ;echo JSR "unknown< 00 ;emit/short JSR2 LIT "> #18 DEO JMP2r
@display0-rat ( addr* -> ) @display0-rat ( addr* -> )
INC2 LDA2k ;display0 JSR2 INC2 LDA2k ;display0 JSR2
LIT "/ #18 DEO LIT "/ #18 DEO
INC2 INC2 LDA2 ;display0 JMP2 INC2 INC2 LDA2 ;display0 JMP2
@display0-int ( addr* -> ) @display0-int ( addr* -> )
LDAk #80 LTH ,&non-neg JCN LIT "- #18 DEO LDAk #80 LTH ,&non-neg JCN ( addr* )
&non-neg LIT "- #18 DEO ( addr* )
;echo JSR2 "0x 00 &non-neg ( addr* )
&loop ;echo JSR2 "0x 00 ( addr* )
LDAk #04 AND ,&is-long JCN ,&loop JSR JMP2r ( )
INC2 LDA2k ;emit/short JSR2 &loop ( addr* )
INC2 INC2 LDA2 ;emit/short JMP2 LDAk #04 AND ,&is-long JCN ( addr* )
&is-long INC2 LDA2k ;emit/short JSR2 ( addr+1* )
INC2 LDA2k ;emit/short JSR2 INC2 INC2 LDA2 ;emit/short JMP2 ( )
INC2 INC2 LDA2 ;obj-to-addr JSR2 &is-long ( addr* )
,&loop JMP 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. ) ( TODO: \n \t etc. )
@display0-char ( c^ -> ) @display0-char ( c^ -> )