~aleteoryx/uxn

fecde3e896101f20ed3ece0b43938aabda4d3b1d — Aleteoryx 7 months ago d1c1ecc
rewritten for 4096 codes
1 files changed, 31 insertions(+), 48 deletions(-)

M lzw.tal
M lzw.tal => lzw.tal +31 -48
@@ 11,58 11,51 @@
	#ffff LIT "A LUT/insert
	LIT "B LUT/insert LIT "C LUT/insert POP2

	#0002 LIT "C LUT/lookup
	#0002 LIT "C LUT/lookup dbg
	;putc-visitor LUT/visit
	BRK

@putc-visitor ( addr* sym -- )
	.Console/write DEO POP2
@putc-visitor ( id* -- )
	LUT/get .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
( 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
		[ LIT2 &visitor $2 ] JSR2
		,/buf-prev LDR2
		INC2k ORA ?{ POP2 [ LIT &visitret $1 ] JMP2r }
		/get STH POP2 ,/buf-parent LDR2 STHr ( addr* sym )
		DUP2 [ LIT2 &visitor $2 ] JSR2
		/toaddr LDA2 INC2k ORA
		?{ POP2 [ LIT &visitret $1 ] JMP2r }
		!/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 )
@LUT/walk-up ( id* -- root-id* )
	#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* )
		STH2k /toaddr STA2k ( save child ptr )
		NIP2 INC2 INC2 LDA2 ( new-node* `node* )
		STH2r SWP2 ( node* new-node* )
		INC2k ORA ?/walkloop
	POP2 ,/buf-sym LDR JMP2r

	POP2 JMP2r

@LUT/insert ( parent* sym -- addr* )
	,/size LDR2 DUP2 />setaddr
	INC2k ,/size STR2 STH2

	,/buf-sym STR ,/buf-parent STR2
	;/setext .System/expansion DEO2
@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 ( addr* -- parent* sym )
	/>getaddr
	;/getext .System/expansion DEO2

	,/buf-parent LDR2 ,/buf-sym LDR
@LUT/get ( id* -- parent* sym )
	/toaddr INC2 INC2 LDA2k ( parent* )
	SWP2 INC2 INC2 LDA ( sym )
	JMP2r

@LUT/lookup ( parent* sym -- addr* )
@LUT/lookup ( parent* sym -- id* )
	[ LIT2r 0000 ]
	&lookuploop
		dup3


@@ 73,21 66,11 @@
		INC2r ?/lookuploop
	POP2 POP STH2r #0001 SUB2 JMP2r

@LUT/>getaddr ( addr* -- )
	DUP2 #3334 DIV2 INC2
	,/getbank STR2
	#0005 MUL2
	,/getaddr STR2
@LUT/toaddr ( id* -- addr* )
	#0005 MUL2 ;/workspace ADD2
	JMP2r

@LUT/>setaddr ( addr* -- )
	DUP2 #3334 DIV2 INC2
	,/setbank STR2
	#0005 MUL2
	,/setaddr STR2
	JMP2r
@LUT/id-ok? ( id* -- id* ok? )
	DUP2 #5000 LTH2 JMP2r

@LUT/setext
	01  0005  0000 =/cpybuf  &setbank $2 &setaddr $2
@LUT/getext
	01  0005  &getbank $2 &getaddr $2  0000 =/cpybuf
@LUT/workspace $5000