2 files changed, 92 insertions(+), 13 deletions(-)

M lzw.tal
A test.gif

@@ 7,26 7,56 @@
 
 |100
 @on-reset ( -> )
-	#ffff #00 LUT/insert POP2
-	#ffff LIT "A LUT/insert
-	LIT "B LUT/insert LIT "C LUT/insert POP2
+	#ffff LIT "W LUT/insert POP2
+	#ffff LIT "A LUT/insert POP2
+	#ffff LIT "X LUT/insert POP2
+	#ffff LIT "X LUT/insert POP2
+	#ffff LIT "C LUT/insert POP2
+	#ffff LIT "E LUT/insert POP2
 
-	#0002 LIT "C LUT/lookup dbg
-	;putc-visitor LUT/visit
+	( LUT/width dbg POP )
+
+	#0c Bitstream/shift-byte
+	LUT/width Bitstream/take-bits POP2 ( ignore the initial clear code )
+
+	;LZW/testdata
+	&decodeloop
+		LDAk LZW/push-byte
+		INC2
+		DUP2 ;LZW/endtestdata LTH2 ?/decodeloop
+	POP2
 	BRK
 
 @putc-visitor ( id* -- )
 	LUT/get .Console/write DEO POP2
 	JMP2r
 
+
+( @LZW )
+
+@LZW/push-byte ( b1 -- )
+	Bitstream/shift-byte
+	&loop
+		LUT/width Bitstream/take-bits
+		INC2k ORA ?{ POP2 JMP2r }
+		LUT/step
+		!/loop
+
+
 ( @LUT )
 
-( visitor is a pointer to a routine of the form ( id* -- ) )
-@LUT/visit ( id* visitor* -- first-sym )
-	,/visitor STR2
+@LUT/toaddr ( id* -- addr* )
+	#0005 MUL2 ;/workspace ADD2
+	JMP2r
+
+@LUT/id-ok? ( id* -- id* ok? )
+	DUP2 #1000 LTH2 JMP2r
+
+( visitor is a pointer to a routine of the form ( sym -- ) )
+@LUT/visit ( id* -- first-sym )
 	/walk-up DUP2 /get ,/visitret STR POP2
 	&visitloop
-		DUP2 [ LIT2 &visitor $2 ] JSR2
+		DUP2 /visitor
 		/toaddr LDA2 INC2k ORA
 		?{ POP2 [ LIT &visitret $1 ] JMP2r }
 		!/visitloop


@@ 66,11 96,60 @@
 		INC2r ?/lookuploop
 	POP2 POP STH2r #0001 SUB2 JMP2r
 
-@LUT/toaddr ( id* -- addr* )
-	#0005 MUL2 ;/workspace ADD2
+@LUT/width ( -- n )
+	,/size LDR2
+	[ LIT2r 1001 ]
+	&widthloop INCr DUP2
+		#0001 MULrk STHr SFT2 #0001 SUB2 ( creates a short with the left N bits set )
+		GTH2 ?/widthloop
+	POP2 NIPr STHr JMP2r
+
+@LUT/step ( c* -- )
+	[ LIT2 &last ffff ]
+	OVR2 ,/size LDR2 LTH2 ?/step-in-dict
+	( >> )
+
+@LUT/step-no-dict ( c* last* -- )
+	NIP2 DUP2 /visit
+	DUP .Console/write DEO
+	/insert ,/last STR2
 	JMP2r
 
-@LUT/id-ok? ( id* -- id* ok? )
-	DUP2 #5000 LTH2 JMP2r
+@LUT/step-in-dict ( c* last* -- )
+	OVR2 /visit ROT ROT
+	INC2k ORA #00 EQU ?{ ROT /insert #00 } POP2 POP
+	,/last STR2
+	JMP2r
+
+@LUT/visitor ( id* -- )
+	/get .Console/write DEO POP2
+	JMP2r
+
+
+( @Bitstream )
+
+@Bitstream/shift-byte ( b -- )
+	#00 SWP
+	[ LIT &offset 00 ] DUP #08 ADD ,/offset STR
+	#40 SFT SFT2
+	[ LIT2 &stream $2 ] ORA2 ,/stream STR2
+	JMP2r
+
+@Bitstream/take-bits ( n -- b* )
+	,/offset LDR SWPk LTH #00 EQU ?{ POP2 #ffff JMP2r }
+	OVR SUB ,/offset STR
+	,/stream LDR2 ROTk SFT2 ,/stream STR2 ( stream = stream>>n )
+	ROT #0f00 ROT SUB AND STHk ( save >>(16-n) )
+	#40 SFT SFT2 ( stream<<(16-n) )
+	STHr SFT2 ( stream>>(16-n) )
+	JMP2r
+
+
+@LZW/testdata
+	8ca7 c9eb f662 9b8f 5a19 f1dd 87fb fc85
+	9d46 5ee5 3989 22ca 222a dbb6 ef17 87f3
+	59a3 3797 7b3b d92b fd4c 4349 9112 dc1c
+	4149 6313 b964 441d 4fe7 1472 3d14 00
+@LZW/endtestdata
 
 @LUT/workspace $5000