|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