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

progress

This commit is contained in:
~d6 2022-12-08 18:25:45 -05:00
parent d570cf9477
commit 8cafcb7415
1 changed files with 56 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
hoax.tal
View File

@ -114,12 +114,43 @@
( DEBUG EXIT ) ( DEBUG EXIT )
BRK BRK
@symbol-from-buf ( -> sym$ ) @sym-from-buf-src ( src* -> sym$ )
( strategy: ) ;buffer/pos LDA2 STH2k ( src* limit* [limit*] )
( 1. read in groups of two ) OVR2 SUB2 ( src* size* [limit*] )
( 2. build recursively, save root ) DUP2 #0005 LTH2 ,&small JCN ( src* size* [limit*] )
( 3. when done "fixup" the root ) POP2 POP2r ( src* )
( 4. return fixed root ) 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 ( -> ) @buf-end ( -> )
#00 ;buffer/pos LDA2 STA ( ; addr<-00 ) #00 ;buffer/pos LDA2 STA ( ; addr<-00 )
@ -146,11 +177,12 @@
;buf-add JSR2 BRK ;buf-add JSR2 BRK
@end-string ( c -> ) @end-string ( c -> )
;on-key-ready #10 DEO2 POP ;on-key-ready #10 DEO2 ( )
;echo JSR2 "string 20 00 ;echo JSR2 "string 20 00 ( )
;buf-end JSR2 ;sym-from-buf JSR2 ( obj$ )
;buffer/input ;print JSR2 NL DUP2 ;convert-sym-to-str JSR2 ( obj$ )
POP BRK ;display JSR2 ( )
;buf-end JSR2 BRK ( )
@start-word ( c -> ) @start-word ( c -> )
;on-key-word #10 DEO2 ;on-key-word #10 DEO2
@ -160,11 +192,13 @@
;buf-add JSR2 BRK ;buf-add JSR2 BRK
@end-word0 ( c -> ) @end-word0 ( c -> )
;on-key-ready #10 DEO2 POP ;on-key-ready #10 DEO2 ( )
;echo JSR2 "word 20 00 ;echo JSR2 "word 20 00 ( )
;buf-end JSR2 ;sym-from-buf JSR2 ( obj$ )
;buffer/input ;print JSR2 NL ;display JSR2 ( )
POP 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
@ -239,6 +273,8 @@
#13 LIT2 "ab LIT2 "c 00 ;make-obj JSR2 D #13 LIT2 "ab LIT2 "c 00 ;make-obj JSR2 D
#23 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 #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 ;emit/short JSR2 NL
STH2kr D STH2kr D
STH2kr ;len JSR2 D STH2kr ;len JSR2 D
@ -342,11 +378,13 @@
( shared by strings/symbols ) ( shared by strings/symbols )
@display0-sym ( addr* -> ) @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+1 )
INC2 LDAk ,display0-char JSR ( addr+2 ) INC2 LDAk ,display0-char JSR ( addr+2 )
INC2 LDA2 ;obj-to-addr JSR2 ,display0-sym JMP INC2 LDA2 ;obj-to-addr JSR2 ,display0-sym JMP
&short &short ( addr* sz^ )
#00 SWP SUB STH INC2 ( addr+1 [-len] ) #00 SWP SUB STH INC2 ( addr+1 [-len] )
&loop ( pos [-i] ) &loop ( pos [-i] )
LDAk ,display0-char JSR ( pos [-i] ) LDAk ,display0-char JSR ( pos [-i] )