diff --git a/hoax.tal b/hoax.tal index b2d3882..9545a84 100644 --- a/hoax.tal +++ b/hoax.tal @@ -114,12 +114,43 @@ ( DEBUG EXIT ) BRK -@symbol-from-buf ( -> sym$ ) - ( strategy: ) - ( 1. read in groups of two ) - ( 2. build recursively, save root ) - ( 3. when done "fixup" the root ) - ( 4. return fixed root ) +@sym-from-buf-src ( src* -> sym$ ) + ;buffer/pos LDA2 STH2k ( src* limit* [limit*] ) + OVR2 SUB2 ( src* size* [limit*] ) + DUP2 #0005 LTH2 ,&small JCN ( src* size* [limit*] ) + POP2 POP2r ( src* ) + DUP2 INC2 INC2 ( src* src+2* ) + ;sym-from-buf-src JSR2 ( src* child$ ) + STH2 STH2k ( src* [child$ src*] ) + LDA STH2r INC LDA STH2 ( [child$ cc*] ) + #18 STH2r STH2r ( tag^ cc* child$ ) + ;make-obj JSR2 JMP2r ( obj$ ) + &small ( src* size* [limit*] ) + NIP #10 ORA ( src* tag^ [limit*] ) + ;alloc-obj JSR2 STH2k ( src* tag^ new* [limit* new*] ) + STA ( src* [limit* new*] ) + SWP2r STH2r SWP2 ( limit* src* [new*] ) + DUP2r INC2r ( limit* src* [new* new+1*] ) + &loop ( limit* src* [new* dst*] ) + LDAk STH2kr STA ( limit* src* [new* dst*] ; dst<-src ) + INC2 INC2r ( limit* src+1* [new* dst+1*] ) + GTH2k ,&loop JCN ( limit* src+1* [new* dst+1*] ; loop if limit>s ) + POP2 POP2 POP2r STH2r ( new* ) + ;addr-to-obj JSR2 JMP2r ( new$ ) + +@sym-from-buf ( -> sym$ ) + ;buffer/input ;sym-from-buf-src JMP2 + +( TODO: fix bug with len > 4 ) +@convert-sym-to-str ( sym$ -> ) + ;obj-to-addr JSR2 STH2k ( addr* [addr*] ) + LDA DUP #30 EOR ( old^ new^ [addr*] ) + STH2kr STA ( old^ [addr*] ; addr<-new ) + #15 LTH ,&done JCN ( [addr*] ) + STH2r INC2 INC2 INC2 LDA ( child$ ) + ;convert-sym-to-str JMP2 ( ) + &done ( [addr*] ) + POP2r JMP2r ( ) @buf-end ( -> ) #00 ;buffer/pos LDA2 STA ( ; addr<-00 ) @@ -146,11 +177,12 @@ ;buf-add JSR2 BRK @end-string ( c -> ) - ;on-key-ready #10 DEO2 - ;echo JSR2 "string 20 00 - ;buf-end JSR2 - ;buffer/input ;print JSR2 NL - POP BRK + POP ;on-key-ready #10 DEO2 ( ) + ;echo JSR2 "string 20 00 ( ) + ;sym-from-buf JSR2 ( obj$ ) + DUP2 ;convert-sym-to-str JSR2 ( obj$ ) + ;display JSR2 ( ) + ;buf-end JSR2 BRK ( ) @start-word ( c -> ) ;on-key-word #10 DEO2 @@ -160,11 +192,13 @@ ;buf-add JSR2 BRK @end-word0 ( c -> ) - ;on-key-ready #10 DEO2 - ;echo JSR2 "word 20 00 - ;buf-end JSR2 - ;buffer/input ;print JSR2 NL - POP JMP2r + POP ;on-key-ready #10 DEO2 ( ) + ;echo JSR2 "word 20 00 ( ) + ;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 @@ -239,6 +273,8 @@ #13 LIT2 "ab LIT2 "c 00 ;make-obj JSR2 D #23 LIT2 "ab LIT2 "c 00 ;make-obj JSR2 D #24 LIT2 "ab LIT2 "c 00 ;make-obj JSR2 D + #13 LIT2 "cd LIT2 "e 00 ;make-obj JSR2 STH2 + #18 LIT2 "ab STH2r ;make-obj JSR2 D STH2kr ;emit/short JSR2 NL STH2kr D STH2kr ;len JSR2 D @@ -342,11 +378,13 @@ ( shared by strings/symbols ) @display0-sym ( addr* -> ) - LDAk #0f AND DUP #05 LTH ,&short JCN + LDAk #0f AND ( addr* sz^ ) + DUP #05 LTH ,&short JCN ( addr* sz^ ) + POP INC2 LDAk ,display0-char JSR ( addr+1 ) INC2 LDAk ,display0-char JSR ( addr+2 ) INC2 LDA2 ;obj-to-addr JSR2 ,display0-sym JMP - &short + &short ( addr* sz^ ) #00 SWP SUB STH INC2 ( addr+1 [-len] ) &loop ( pos [-i] ) LDAk ,display0-char JSR ( pos [-i] )