M gif.tal => gif.tal +3 -3
@@ 44,14 44,14 @@
INC2 !puts
-@gif/chunk &magic $ff
+@Gif/chunk &magic $ff
&screen &wid $2 &hei $2 &pack $1 &bg $1 &aspect $1
&colortab $300
-@gif/init ( -- )
+@Gif/init ( -- )
#06 /read
/magic-ok? ?{ ;errs/corrupt die }
-@gif/read ( len* -- )
+@Gif/read ( len* -- )
#00 SWP .File1/length DEO2
;/chunk .File1/read
JMP2r
A lzw.tal => lzw.tal +93 -0
@@ 0,0 1,93 @@
+|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
+ ;putc-visitor LUT/visit
+ BRK
+
+@putc-visitor ( addr* sym -- )
+ .Console/write DEO POP2
+ JMP2r
+
+( @LUT )
+
+( visitor is a pointer to a routine of the form ( addr* sym -- ) )
+@LUT/visit ( addr* visitor* -- first-byte )
+ ,/visitor STR2 /walk-up DUP ,/visitret STR
+ &visitloop
+ [ LIT2 &visitor $2 ] JSR2
+ ,/buf-prev LDR2
+ INC2k ORA ?{ POP2 [ LIT &visitret $1 ] JMP2r }
+ /get STH POP2 ,/buf-parent LDR2 STHr ( addr* sym )
+ !/visitloop
+
+@LUT/cpybuf
+ &buf-prev $2 &buf-parent $2 &buf-sym $1
+
+@LUT/walk-up ( addr* -- addr* sym ) ( routine leaves root node metadata in /cpybuf )
+ #ffff SWP2 ( -1* node* )
+ &walkloop
+ DUP2 />getaddr DUP2 />setaddr
+ ;/getext .System/expansion DEO2 ( load node info )
+ SWP2 ,/buf-prev STR2
+ ;/setext .System/expansion DEO2 ( save child ptr )
+
+ ,/buf-parent LDR2 ( node* new-node* )
+ INC2k ORA ?/walkloop
+ POP2 ,/buf-sym LDR JMP2r
+
+
+@LUT/insert ( parent* sym -- addr* )
+ ,/size LDR2 DUP2 />setaddr
+ INC2k ,/size STR2 STH2
+
+ ,/buf-sym STR ,/buf-parent STR2
+ ;/setext .System/expansion DEO2
+ STH2r JMP2r
+
+@LUT/get ( addr* -- parent* sym )
+ />getaddr
+ ;/getext .System/expansion DEO2
+
+ ,/buf-parent LDR2 ,/buf-sym LDR
+ JMP2r
+
+@LUT/lookup ( parent* sym -- addr* )
+ [ 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/>getaddr ( addr* -- )
+ DUP2 #3334 DIV2 INC2
+ ,/getbank STR2
+ #0005 MUL2
+ ,/getaddr STR2
+ JMP2r
+
+@LUT/>setaddr ( addr* -- )
+ DUP2 #3334 DIV2 INC2
+ ,/setbank STR2
+ #0005 MUL2
+ ,/setaddr STR2
+ JMP2r
+
+@LUT/setext
+ 01 0005 0000 =/cpybuf &setbank $2 &setaddr $2
+@LUT/getext
+ 01 0005 &getbank $2 &getaddr $2 0000 =/cpybuf
M mkfile => mkfile +1 -1
@@ 2,7 2,7 @@ roms=\
arvelie.rom\
nanpa.rom\
bfc.rom\
- gif.rom
+ lzw.rom
all:VQ: $roms