|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10 @Console/vector $2 &read $5 &type $1 &write $1 &error $1
%dup3 ( a b c -- a b c a b c ) { ROTk ROT ROT }
%dbg ( -- ) { [ LIT2 01 -System/debug ] DEO }
|100
@on-reset ( -> )
#ffff #00 LUT/insert POP2
#ffff LIT "A LUT/insert
LIT "B LUT/insert LIT "C LUT/insert POP2
#0002 LIT "C LUT/lookup dbg
;putc-visitor LUT/visit
BRK
@putc-visitor ( id* -- )
LUT/get .Console/write DEO POP2
JMP2r
( @LUT )
( visitor is a pointer to a routine of the form ( id* -- ) )
@LUT/visit ( id* visitor* -- first-sym )
,/visitor STR2
/walk-up DUP2 /get ,/visitret STR POP2
&visitloop
DUP2 [ LIT2 &visitor $2 ] JSR2
/toaddr LDA2 INC2k ORA
?{ POP2 [ LIT &visitret $1 ] JMP2r }
!/visitloop
@LUT/walk-up ( id* -- root-id* )
#ffff SWP2 ( -1* node* )
&walkloop
STH2k /toaddr STA2k ( save child ptr )
NIP2 INC2 INC2 LDA2 ( new-node* `node* )
STH2r SWP2 ( node* new-node* )
INC2k ORA ?/walkloop
POP2 JMP2r
@LUT/insert ( parent* sym -- id* )
ROT ROT
,/size LDR2 /id-ok? ?{ POP2 POP2 POP #ffff JMP2r }
STH2k /toaddr
INC2 INC2 STA2k ( parent* )
NIP2 INC2 INC2 STA ( sym )
STH2rk INC2 ,/size STR2
STH2r JMP2r
@LUT/get ( id* -- parent* sym )
/toaddr INC2 INC2 LDA2k ( parent* )
SWP2 INC2 INC2 LDA ( sym )
JMP2r
@LUT/lookup ( parent* sym -- id* )
[ LIT2r 0000 ]
&lookuploop
dup3
STH2rk [ LIT2 &size 0000 ]
LTH2 ?{ POP2r POP2 POP2 POP2 #ffff JMP2r }
STH2rk /get ( parent1* sym1 parent2* sym2 )
STH ROT STH NEQ2 NEQr STHr ORA ( parent1 != parent2 || sym1 != sym2 )
INC2r ?/lookuploop
POP2 POP STH2r #0001 SUB2 JMP2r
@LUT/toaddr ( id* -- addr* )
#0005 MUL2 ;/workspace ADD2
JMP2r
@LUT/id-ok? ( id* -- id* ok? )
DUP2 #5000 LTH2 JMP2r
@LUT/workspace $5000