uxn-utils/cli/lz/ulzenc.tal

( ulz encoder )

|10 @Console &vector $2 &read $1 &pad $5 &write $1 &err $1
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|0000

	@src $30
	@dst $30
	@ptr $1
	@match-len $2

|0100

@ready-src ( -> )
	;&await .Console/vector DEO2
	BRK
	&await ( -> )
		.Console/read DEI .src skey ?ready-dst
		BRK

@ready-dst ( -> )
	;&await .Console/vector DEO2
	BRK
	&await ( -> )
		.Console/read DEI .dst skey ?on-ready
		BRK

@on-ready ( -> )
	( | load raw )
	;src .File/name DEO2
	#4000 .File/length DEO2
	;raw .File/read DEO2
	;raw .File/success DEI2 uxn_lz_compress
	( halt ) #800f DEO
	BRK

@<append-byte> ( byte -- )
	.output-ptr LDZ2 INC2k .output-ptr STZ2 STA
	JMP2r

@op-cpy ( in* -- )
	( More numeric range: treat 0 as 4, 1 as 5, etc. )
	.match-len LDZ2 #0004 SUB2 .match-ctl STZ2
	( CPY2 )
	.match-ctl LDZ2 #003f GTH2 ?&cpy2
		( CPY1 )
		( *output_ptr++ = match_ctl | 0x80; )
		.match-ctl LDZ2 #0080 ORA2 <append-byte>
		!&cpy-resume
		&cpy2
		( TODO )
	&cpy-resume
	( *output_ptr++ = in - dict_best - 1; )
	DUP2 .dict-best LDZ2 #0001 SUB2 SUB2 <append-byte>
	( in += match_len; Advance input by size of the match )
	.match-len LDZ2 ADD2
	( Disable combining previous literal, if any )
	#0000 .combine STZ2
	!uxn_lz_compress/w

@op-lit ( in* -- )
	.combine LDZ2 ORA ?&combine
	( start a new literal )
	( Store this address, and later use it to increment the literal size. )
	( combine = output_ptr++; )
	.output-ptr LDZ2
		INC2k .output-ptr STZ2
		.combine STZ2
	( *combine = 0; )
	#00 .combine LDZ2 LDA2 STA
	( *output_ptr++ = *in++; )
	LDAk <append-byte>
	INC2 !uxn_lz_compress/w
&combine ( -- )
	( if ++*combine == 127 )
	.combine LDZ2 LDA INC DUP #7f NEQ ?{ POP #00 }
		.combine LDZ2 STA
	LDAk <append-byte>
	INC2 !uxn_lz_compress/w

@uxn_lz_compress ( input* length* -- )
	ADD2k NIP2 SWP2
	&w ( -- )
		( | get available dictionary size )
		DUP2 ;raw SUB2 #0100 LTH2k ?{ SWP2 }
		POP2 ,&dict-len STR2
		( | size of the string to search for )
		SUB2k #3fff #0004 ADD2 LTH2k ?{ SWP2 }
		POP2 ,&string-len STR2
		( | itterate through the dictionary )
		#0000 .match-len STZ2
		[ LIT2 &dict-len $2 ] SUB2k .dict STZ2
		( | create a few inlines )
		DUP2 ,&in STR2
		&for1 ( dict-len != 0 )
			( Find common prefix length with the string )
			#0000
			&for2 ( i != 0 )
				( If we reach the end of the string, it's the best possible match. )
				DUP2 [ LIT2 &string-len $2 ] NEQ2 ?{
					DUP2 .match-len STZ2
					.dict LDZ2 .dict-best STZ2
					POP2 POP2 !&done-search }
				( Dictionary repeats if we hit the end )
				( in[i] != dict[i % dict_len] break; )
				DUP2 [ LIT2 &in $2 ] ADD2 LDA2
				OVR2 ,&dict-len LDR2 DIV2k MUL2 SUB2
					.dict LDZ2 ADD2 LDA2 NEQ2 ?&end
				INC2 ORAk ?&for2
			&end
			( i > match_len )
			DUP2 .match-len LDZ2 GTH2 #00 EQU ?{
				DUP2 .match-len STZ2
				.dict-len LDZ2 .dict STZ2 }
			POP2
			.dict LDZ2 INC2 .dict STZ2
			#0001 SUB2 ORAk ?&for1
		POP2

	&done-search ( -- )
		( CPY ) .match-len LDZ2 #0003 GTH2 ?op-cpy
		( LIT ) op-lit
		NEQ2k ?&w
	JMP2r

(
@|stdlib )

@skey ( key buf -- proc )
	OVR #21 LTH ?&eval
	#00 SWP sput #00 JMP2r
	&eval POP2 #01 JMP2r

@scap ( str* -- end* )
	&w INC2 & LDAk ?&w
	JMP2r

@sput ( chr str* -- )
	scap/ INC2k #00 ROT ROT STA
	STA
	JMP2r

@getc ( -- b )
	#0001 .File/length DEO2
	;&b .File/read DEO2
	[ LIT &b $1 ] JMP2r

@phex ( short* -- )
	SWP phex/b
	&b ( -- )
		DUP #04 SFT phex/c
	&c ( -- )
		#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO
		JMP2r

(
@|memory )

@raw $4000

@compressed $4000