cleanup
This commit is contained in:
parent
0acfb26e48
commit
d570cf9477
87
hoax.tal
87
hoax.tal
|
@ -104,55 +104,22 @@
|
|||
|
||||
|0000
|
||||
@objects $2
|
||||
|
||||
( 00 start )
|
||||
( 01 symbol )
|
||||
( 02 string )
|
||||
( 03 escape )
|
||||
( 04 comment )
|
||||
@state $1
|
||||
@stack $2
|
||||
@buffer [ &pos $2 &input $40 ] ( max symbol size 64 )
|
||||
@buffer [ &pos $2 &input $7f &limit $1 ] ( max symbol size 127 )
|
||||
|
||||
|0100
|
||||
;init-hoax JSR2
|
||||
#00 .state STZ
|
||||
;buf-reset JSR2
|
||||
;on-key-ready #10 DEO2
|
||||
( ;reset-input JSR2 )
|
||||
;demo JSR2
|
||||
( DEBUG EXIT )
|
||||
BRK
|
||||
|
||||
( @reset-input ( -> )
|
||||
#0000 #0000 ;cons JSR2 ( pair$ )
|
||||
.stack STZ2 ( ; stack<-pair )
|
||||
JMP2r )
|
||||
|
||||
( @complete-with ( v$ -> )
|
||||
.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$] ) )
|
||||
|
||||
@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 )
|
||||
|
||||
@buf-end ( -> )
|
||||
#00 ;buffer/pos LDA2 STA ( ; addr<-00 )
|
||||
|
@ -173,41 +140,34 @@
|
|||
|
||||
@start-string ( c -> )
|
||||
;on-key-string #10 DEO2
|
||||
;echo JSR2 "start 20 "string 0a 00 POP BRK
|
||||
POP BRK
|
||||
|
||||
@append-string ( c -> )
|
||||
;echo JSR2 "append 20 "string 20 00
|
||||
DUP #18 DEO NL
|
||||
;buf-add JSR2 BRK
|
||||
|
||||
@end-string ( c -> )
|
||||
;on-key-ready #10 DEO2
|
||||
;echo JSR2 "end 20 "string 0a 00 POP
|
||||
;echo JSR2 "string 20 00
|
||||
;buf-end JSR2
|
||||
;buffer/input ;print JSR2 NL
|
||||
BRK
|
||||
POP BRK
|
||||
|
||||
@start-word ( c -> )
|
||||
;on-key-word #10 DEO2
|
||||
;echo JSR2 "start 20 "word 20 00
|
||||
DUP #18 DEO NL
|
||||
;buf-add JSR2 BRK
|
||||
|
||||
@append-word ( c -> )
|
||||
;echo JSR2 "append 20 "word 20 00
|
||||
DUP #18 DEO NL
|
||||
;buf-add JSR2 BRK
|
||||
|
||||
@end-word0 ( c -> )
|
||||
;on-key-ready #10 DEO2
|
||||
;echo JSR2 "end 20 "word 0a 00 POP
|
||||
;echo JSR2 "word 20 00
|
||||
;buf-end JSR2
|
||||
;buffer/input ;print JSR2 NL
|
||||
JMP2r
|
||||
POP JMP2r
|
||||
|
||||
@start-escape ( c -> )
|
||||
;on-key-escaped #10 DEO2
|
||||
;echo JSR2 "start 20 "escape 0a 00 POP BRK
|
||||
;on-key-escaped #10 DEO2 POP BRK
|
||||
|
||||
( TODO: more sophisticated escapes )
|
||||
@on-key-escaped ( -> )
|
||||
|
@ -234,10 +194,9 @@
|
|||
DUP #7e GTH ,&skip JCN ( delete + 8bit )
|
||||
;append-word JMP2
|
||||
&skip
|
||||
;echo JSR2 "skipped 0a 00 POP BRK
|
||||
POP BRK
|
||||
&space
|
||||
;end-word0 JSR2
|
||||
;echo JSR2 "whitespace 0a 00 BRK
|
||||
;end-word0 JSR2 BRK
|
||||
&end
|
||||
;end-word0 JSR2
|
||||
#00 ;end-list JMP2
|
||||
|
@ -256,18 +215,9 @@
|
|||
DUP #7e GTH ,&skip JCN ( delete + 8bit )
|
||||
;start-word JMP2
|
||||
&space
|
||||
;echo JSR2 "whitespace 0a 00 POP BRK
|
||||
POP BRK
|
||||
&skip
|
||||
;echo JSR2 "skipped 0a 00 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 )
|
||||
POP BRK
|
||||
|
||||
@demo
|
||||
null ;null? JSR2 D
|
||||
|
@ -452,6 +402,9 @@
|
|||
STH2k STA ( [addr*] )
|
||||
STH2r JMP2r ( addr* )
|
||||
|
||||
@alloc-obj ( -> addr* )
|
||||
.objects LDZ2 ;alloc JMP2
|
||||
|
||||
@make-obj ( tag^ ohi$ olo$ -> object$ )
|
||||
.objects LDZ2 ( tag^ ohi$ olo$ arena* )
|
||||
;alloc JSR2 ( tag^ ohi$ olo$ addr* )
|
||||
|
|
Loading…
Reference in New Issue