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

cleanup

This commit is contained in:
~d6 2022-12-08 00:55:25 -05:00
parent 0acfb26e48
commit d570cf9477
1 changed files with 20 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
hoax.tal
View File

@ -104,55 +104,22 @@
|0000 |0000
@objects $2 @objects $2
@buffer [ &pos $2 &input $7f &limit $1 ] ( max symbol size 127 )
( 00 start )
( 01 symbol )
( 02 string )
( 03 escape )
( 04 comment )
@state $1
@stack $2
@buffer [ &pos $2 &input $40 ] ( max symbol size 64 )
|0100 |0100
;init-hoax JSR2 ;init-hoax JSR2
#00 .state STZ
;buf-reset JSR2 ;buf-reset JSR2
;on-key-ready #10 DEO2 ;on-key-ready #10 DEO2
( ;reset-input JSR2 )
;demo JSR2 ;demo JSR2
( DEBUG EXIT ) ( DEBUG EXIT )
BRK BRK
( @reset-input ( -> ) @symbol-from-buf ( -> sym$ )
#0000 #0000 ;cons JSR2 ( pair$ ) ( strategy: )
.stack STZ2 ( ; stack<-pair ) ( 1. read in groups of two )
JMP2r ) ( 2. build recursively, save root )
( 3. when done "fixup" the root )
( @complete-with ( v$ -> ) ( 4. return fixed root )
.stack LDZ2 ( v$ stack$ )
STH2k SWP2 ;car! JSR2 ( [stack] ; car(stack)<-v )
#0000 STH2r ;cons JSR2 ( cell$ )
.stack STZ2 ( stack<- ) )
( @start-list ( -> )
#0000 .stack LDZ2 ( 0000 stack$ )
;cons JSR2 ( pair$ )
DUP2 .stack STZ2 ( pair$ ; stack<-pair )
.stack/pos LDZ ( a^ )
STHk LDZ2 ( base$ [a^] )
#0000 #0000 ;cons JSR2 ( base$ cell$ [a^] )
STH2k ;car! JSR2 ( base$ [a^ cell$] )
POP2 STH2r ( cell$ [a^] )
INCr INCr STHkr ( cell$ a+2^ [a+2^] )
STZ2 STHr .stack/pos STZ ( ; pos<-a+2 )
JMP2r )
( @end-list ( -> )
;stack/pos LDA2k LDA2 ( pos* elem$ )
STH2 #0004 SUB2 ( pos-4* [elem$] ) )
@buf-end ( -> ) @buf-end ( -> )
#00 ;buffer/pos LDA2 STA ( ; addr<-00 ) #00 ;buffer/pos LDA2 STA ( ; addr<-00 )
@ -173,41 +140,34 @@
@start-string ( c -> ) @start-string ( c -> )
;on-key-string #10 DEO2 ;on-key-string #10 DEO2
;echo JSR2 "start 20 "string 0a 00 POP BRK POP BRK
@append-string ( c -> ) @append-string ( c -> )
;echo JSR2 "append 20 "string 20 00
DUP #18 DEO NL
;buf-add JSR2 BRK ;buf-add JSR2 BRK
@end-string ( c -> ) @end-string ( c -> )
;on-key-ready #10 DEO2 ;on-key-ready #10 DEO2
;echo JSR2 "end 20 "string 0a 00 POP ;echo JSR2 "string 20 00
;buf-end JSR2 ;buf-end JSR2
;buffer/input ;print JSR2 NL ;buffer/input ;print JSR2 NL
BRK POP BRK
@start-word ( c -> ) @start-word ( c -> )
;on-key-word #10 DEO2 ;on-key-word #10 DEO2
;echo JSR2 "start 20 "word 20 00
DUP #18 DEO NL
;buf-add JSR2 BRK ;buf-add JSR2 BRK
@append-word ( c -> ) @append-word ( c -> )
;echo JSR2 "append 20 "word 20 00
DUP #18 DEO NL
;buf-add JSR2 BRK ;buf-add JSR2 BRK
@end-word0 ( c -> ) @end-word0 ( c -> )
;on-key-ready #10 DEO2 ;on-key-ready #10 DEO2
;echo JSR2 "end 20 "word 0a 00 POP ;echo JSR2 "word 20 00
;buf-end JSR2 ;buf-end JSR2
;buffer/input ;print JSR2 NL ;buffer/input ;print JSR2 NL
JMP2r POP JMP2r
@start-escape ( c -> ) @start-escape ( c -> )
;on-key-escaped #10 DEO2 ;on-key-escaped #10 DEO2 POP BRK
;echo JSR2 "start 20 "escape 0a 00 POP BRK
( TODO: more sophisticated escapes ) ( TODO: more sophisticated escapes )
@on-key-escaped ( -> ) @on-key-escaped ( -> )
@ -234,10 +194,9 @@
DUP #7e GTH ,&skip JCN ( delete + 8bit ) DUP #7e GTH ,&skip JCN ( delete + 8bit )
;append-word JMP2 ;append-word JMP2
&skip &skip
;echo JSR2 "skipped 0a 00 POP BRK POP BRK
&space &space
;end-word0 JSR2 ;end-word0 JSR2 BRK
;echo JSR2 "whitespace 0a 00 BRK
&end &end
;end-word0 JSR2 ;end-word0 JSR2
#00 ;end-list JMP2 #00 ;end-list JMP2
@ -256,18 +215,9 @@
DUP #7e GTH ,&skip JCN ( delete + 8bit ) DUP #7e GTH ,&skip JCN ( delete + 8bit )
;start-word JMP2 ;start-word JMP2
&space &space
;echo JSR2 "whitespace 0a 00 POP BRK POP BRK
&skip &skip
;echo JSR2 "skipped 0a 00 POP BRK POP BRK
( #12 DEI #0a EQU ,&newline JCN
#12 DEI ;buffer/pos LDA2 STAk ( c pos ; addr<-c )
INC2 ;buffer/pos STA2 POP BRK ( )
&newline
#00 ;buffer/pos LDA2 STA ( ; addr<-00 )
;buffer/input DUP2 ;buffer/pos STA2
;echo JSR2 "read: 20 00 ;print JSR2 #0a18 DEO
BRK )
@demo @demo
null ;null? JSR2 D null ;null? JSR2 D
@ -452,6 +402,9 @@
STH2k STA ( [addr*] ) STH2k STA ( [addr*] )
STH2r JMP2r ( addr* ) STH2r JMP2r ( addr* )
@alloc-obj ( -> addr* )
.objects LDZ2 ;alloc JMP2
@make-obj ( tag^ ohi$ olo$ -> object$ ) @make-obj ( tag^ ohi$ olo$ -> object$ )
.objects LDZ2 ( tag^ ohi$ olo$ arena* ) .objects LDZ2 ( tag^ ohi$ olo$ arena* )
;alloc JSR2 ( tag^ ohi$ olo$ addr* ) ;alloc JSR2 ( tag^ ohi$ olo$ addr* )