|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 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

	( 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 )

@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 /visitor
		/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/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/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