* Patterns:
* 1[MBITS][OBITS]	Match
* 0[NBITS]		Literals
* Notes:
* - The bit count for offset is
*   determined by the max possible
*   offset, limited by traversed
*   size.
* - The 1-bit id for matches is
*   unnecessary after a literal
*
ASSEMBLE

sMNEXT	EQU 9	Match expected?
sGARB	EQU 10

NBITS	EQU 4	Literal length
NMASK	EQU 2^(NBITS)-1
NBITS2	EQU 6
NMASK2	EQU 2^(NBITS2)-1
MBITS	EQU 5	Match length
MMASK	EQU 2^(MBITS)-1
MBITS2	EQU 7
MMASK2	EQU 2^(MBITS2)-1

=OffNoBlush	EQU #01D44
=ABORT		EQU #04EA4
=WIPEOUT	EQU #0675C
=GETPTREVALC	EQU #15C77
=aATTNFLG	EQU #4226C
RPL
::
 CK1NOLASTWD
 DUPTYPECSTR? ITE
 :: DUP #1 #2 SUB$ "BZ" EQUAL ;
 FALSE
 case
 CODE
	TITLE	JAZZ Uncompressor

	STITLE	Preparation
	ST=0	sGARB
reungz	GOSBVL	=SAVPTR
	A=DAT1	A
	D1=A
	D1=D1+	10
	A=DAT1	4
	D1=D1+	4
	LCSTR	'BZ'
	P=	3
	?C=A	WP
	GOYES	upkok
	P=	0
	LC(5)	=SETTYPEERR
	GOVLNG	=GETPTREVALC
upkok	P=	0
	C=DAT1	A
	RSTK=C
	GOSBVL	=CREATETEMP
	GONC	ugzmemok
	?ST=1	sGARB
	GOYES	ugzmerr
	GOSUB	PassGC
	CON(5)	=DOCOL
	CON(5)	=GARBAGE
	CON(5)	=COLA
	CON(5)	=DOCODE
	REL(5)	UGZEND
	ST=1	sGARB
	GOTO	reungz
PassGC	C=RSTK
	GOVLNG	=GETPTREVALC
ugzmerr	GOVLNG	=GPMEMERR
ugzmemok
	C=RSTK
	AD0EX
	R0=A	A
	C=C+A	A
	R1=C	A	->obend
	GOSBVL	=D1=DSKTOP
	C=DAT1	A
	D0=C
	D0=D0+	5+5
	D0=D0+	4+5
	C=DAT0	A
	AD0EX
	D0=A
	D0=D0+	5	->pats
	C=C+A	A
	R2=C.F	A	->lits
	
	A=R0	A
	DAT1=A	A	->stk1
	R3=A.F	A	->ob
	D1=A

	STITLE	Uncompress Loop

	ST=0	sMNEXT
	A=0	S
	R3=A.F	S	bits
UPKLOOP	GOSUB	Decod
	?D#0	A
	GOYES	upkpat
* Safety:
*	AD1EX
*	C=R1.F	A
*	C=C-A	A
*	AD1EX
*	?A<=C	A
*	GOYES	blaa
*	A=C	A	
*blaa
	CD0EX
	CR2EX.F	A
	CD0EX
	C=A	A
	GOSBVL	=MOVEDOWN
	CD0EX
	CR2EX.F	A
	CD0EX
upkcont	AD1EX
	D1=A
	C=R1.F	A
	?A<C	A
	GOYES	UPKLOOP
	GOVLNG	=GETPTRLOOP

upkpat
* Safety:
*	AD1EX
*	C=R1.F	A
*	C=C-A	A
*	AD1EX
*	?D<=C	A
*	GOYES	buh
*	D=C	A
*buh
	CD1EX
	D1=C
	C=C-A	A	->src
	CD0EX
	CDEX	A
	A=0	P
	?A=0	A
	GOYES	upslow
	GOSBVL	=MOVEDOWN
uppcnt	C=D	A
	D0=C
	GOTO	upkcont
upslow	C=C-1	A
upkplp	A=DAT0	B
	DAT1=A	1
	D0=D0+	1
	D1=D1+	1
	C=C-1	A
	GONC	upkplp
	GOC	uppcnt

UGZEND
ENDCODE

  ZERO FOURTEEN BLANKIT
  ABUFF #42 #7
  "BZ V1.2 (400)" MINUSONE
  CENTER$3x5 DROP  

  DUP OSIZE SWAP
  SysTime 1LAMBIND
  GARBAGE
  SysTime 1PUTLAM

CODE
	TITLE JAZZ Compressor

*	Effect of HSHSIZE:	(sample file was an earlier BZ.S )
*
*	HSHSIZE	Time	MemNeed:
*	#1000	14.54	26624
*	 #800	15.77	16384
*	 #400	17.56	11264 !!
*	 #200	21.26	 8704
*	 #100	28.59	 7424
*	  #80	42.78	 6784
*	  #40	69.97	 6464

HSHSIZE	EQU #400	See source before changing!
WINSIZE	EQU #1000

RINGMEM	EQU 3*(WINSIZE)
HASHMEM	EQU 10*(HSHSIZE)
ALLMEM	EQU (RINGMEM)+(HASHMEM)
MINMEM	EQU 200+(ALLMEM)
MINADD	EQU 100+(ALLMEM)

MINMAT	EQU 6	Minimum match lenght

	STITLE	Startup
*********************************
* For speed following registers
* have priority over anything else
* R0[A]	->out
* R2[A] ->buffer
* R3[A] ->ob
* Assiging other improtant variables
* to [A] fields we get:
* R0	->out	->$start
* R1	free
* R2	->buffer
* R3	->ob		bits
* R4	->obend	->obsave
* D0	->obptr
* bits determines how many bits
* are valid in current ->out
* eg 0 <= bits <= 2
*********************************

	GOSBVL	=SAVPTR
*	GOSBVL	=GARBAGECOL
	CLRST
*	ST=0	sMNEXT
	A=0	W
	R0=A
	R1=A
	R2=A
	R3=A		R3[S]=0!
	R4=A

	GOSBVL	=D1=DSKTOP
	A=DAT1	A
	R3=A.F	A	->ob	(temporary)
	D0=A
	GOSBVL	=SKIPOB
	AD0EX
	R4=A.F	A	->obend
	C=R3.F	A	->ob
	A=A-C	A	obsize
	GOC	argerr
	LC(5)	10
	?A>=C	A
	GOYES	argok
argerr	LC(5)	=SETTYPEERR
gpevalc	GOVLNG	=GETPTREVALC

memerr	GOSBVL	=DispOn
	GOVLNG	=GPMEMERR

argok	GOSBVL	=ROOM
	A=C	A
	LC(5)	MINMEM
	A=A-C	A
	GOC	memerr
	LC(5)	MINADD
	C=C+A	A
	R1=C.F	A	free
	GOSBVL	=MAKE$N
	A=R0.F	A
	GOSBVL	=ASLW5
	AD0EX
	R0=A
	D1=A		->out
	C=R1.F	A	free
	GOSBVL	=WIPEOUT
	AD1EX
	LC(5)	HASHMEM
	A=A-C	A
	R2=A.F	A	->buffer
	A=R1.F	A	free
	LC(5)	ALLMEM	THIS WAS BUGGED! (only HASHMEM substracted)
	A=A-C	A
	A=A-CON	A,16	buffering safety!
	R1=A.F	A
	GOSBVL	=DisableIntr
	GOSBVL	=OffNoBlush
	GOSBVL	=AllowIntr	
	GOTO	packnow

*********************************
* R0	->out	->$start
* R1	free	(adjusted for buffer)
* R2	->buffer
* R3	->ob		bits
* R4	->obend	(->obsave)
*********************************
packnow	C=R1.F	A
	C=C-CON	A,4+5+5	"BZ" and oblen
	R1=C.F	A
*	GOC	memerr	Never
	C=R0.F	A
	D0=C
	LCSTR	'BZ'
	DAT0=C	4
	D0=D0+	4
	A=R4.F	A	->obend
	C=R3.F	A	->ob
	A=A-C	A	obsize
	DAT0=A	A
	D0=D0+	10
	CD0EX		D0 = ->ob
	R0=C.F	A	->out

	STITLE	Compressor Loop
*********************************
* R0	->out	->$start
* R1	free
* R2	->buffer
* R3	->ob		bits
* R4	->obend	(->obsave)
*********************************

PackLoop
	GOSUB	PackInfo
	GOSUB	PackAbort?
* Save start address of scan
	AD0EX
	D0=A
	GOSBVL	=ASLW5
	A=R4.F	A
	R4=A
	GOSUB	FindMax
	C=R4
	GOSBVL	=CSRW5	->obsave
	AD0EX		->match
	D0=A
	A=A-C	A	skipped nibbles
	GOSUB	Encod
* Pattern is out, update history
	?D=0	A
	GOYES	packcont
	D0=D0+	1	1st one is in already
	D=D-1	A	1st not included
	D=D-1	A	GONC test
patadd	GOSUB	RemoveOld
	GOSUB	AddNew
	D0=D0+	1
	D=D-1	A
	GONC	patadd
* Prepare next loop
packcont
	AD0EX
	D0=A
	C=R4.F	A	->obend
	?A>=C	A
	GOYES	PackNibs
	GOTO	PackLoop

*********************************
* Append literal nibbles
* according to packed directives
*********************************
PackNibs
	C=R0
	A=R3.F	S
	?A=0	S
	GOYES	outok!
	C=C+1	A
	R0=C
outok!	GOSBVL	=CSRW5
	D0=C
	D0=D0+	5+5
	D0=D0+	4+5
	C=R0.F	A	->out
	AD0EX
	D0=A
	C=C-A	A	off to lit
	DAT0=C	A
	D0=D0+	5	->pats
	
	C=R3.F	A	->ob
	D1=C
	A=R1.F	A	free++
	LC(5)	ALLMEM
	A=A+C	A
	R1=A.F	A
	ST=0	sMNEXT
	A=0	S
	R3=A.F	S	bits
NibsLoop
	GOSUB	Decod
	?D#0	A
	GOYES	apppat
	CR1EX.F	A
	C=C-A	A
	CR1EX.F	A
	GOC	apperr
	C=R0.F	A
	CD1EX
	CD0EX
	R0=C.F	A
	C=A	A
	GOSBVL	=MOVEDOWN
	C=R0.F	A
	CD0EX
	CD1EX
	R0=C.F	A
	GONC	appcont
apperr	GOTO	memerr
apppat	CD1EX
	C=C+D	A
	CD1EX

appcont	C=R4.F	A	->obend
	AD1EX
	D1=A
	?A<C	A
	GOYES	NibsLoop
* Exit compressor
PackDone
	GOSBVL	=DispOn
	C=R0
	D0=C
	GOSBVL	=CSRW5
	R0=C
	GOSBVL	=Shrink$
	GOVLNG	=GPOverWrR0Lp

	STITLE	Match Encoder
*********************************
* Output match
*	D[A]  = length
*	D[A1] = match loc
*	D0    = ->match
*	R0[A] = ->out
*	R3[A] = ->ob
*	R3[S] = bits
*	R1[A] = free
*	A[A]  = skipped
*********************************
Encod	?A#0	A
	GOYES	outlit
	GOTO	outmat?

outlit	ST=1	sMNEXT
	LC(5)	NMASK
	?A>C	A
	GOYES	outlit2
	A=A+A	A
	P=	(NBITS)+1
	GOSUB	OutBits
	GOTO	outmat?
outlit2	A=A-C	A
	B=A	A
	A=0	A
	P=	(NBITS)+1
	GOSUB	OutBits
	LC(5)	NMASK2
	?B>C	A
	GOYES	outlit5
	A=B	A
	P=	NBITS2
	GOSUB	OutBits
	GOTO	outmat?
outlit5	A=0	A
	P=	NBITS2
	GOSUB	OutBits
	A=B	A
	GOSUB	OutA[A]
********
outmat?	?D=0	A
	RTNYES
	D=D-CON	A,(MINMAT)-1
	LC(5)	MMASK
	?D>C	A
	GOYES	outmat2
	C=D	A
	A=C	A
	P=	MBITS
	?ST=1	sMNEXT
	GOYES	otm1
	A=A+A	A
	A=A+1	A
	P=	(MBITS)+1
otm1	GOSUB	OutBits
	GOTO	outoff
outmat2	D=D-C	A
	A=0	A
	P=	MBITS
	?ST=1	sMNEXT
	GOYES	otm3
	A=A+1	A
	P=	(MBITS)+1
otm3	GOSUB	OutBits
	LC(5)	MMASK2
	?D>C	A
	GOYES	outmat5
	C=D	A
	A=C	A
	P=	MBITS2
	GOSUB	OutBits
	GOTO	outfxm
outmat5	A=0	A
	P=	MBITS2
	GOSUB	OutBits
	C=D	A
	A=C	A
	GOSUB	OutA[A]
outfxm	LC(5)	MMASK
	D=D+C	A

outoff	D=D+CON	A,(MINMAT)-1
	ST=0	sMNEXT
	C=D	W
	GOSBVL	=CSRW5	->matchloc
	AD0EX
	D0=A
	A=A-C	A	offset

	C=R3.F	A	->ob
	AD0EX
	C=A-C	A	maxoff
	AD0EX
	B=C	A	maxoff
	LC(5)	#7FF
	P=	12
otoflp	?B>C	A
	GOYES	OutBits
	CSRB.F	A
	P=P-1
	GONC	otoflp	BET

*********************************
OutA[A]	B=A	A
	P=	8
	GOSUB	OutBits
	A=B	A
	ASR	A
	ASR	A
	P=	12
*********************************
OutBits	A=R3.F	S
	C=P	15
	C=C+A	S
	A=C	S
	C=0	A
	P=	3
	CPEX	15
	CPEX	0
	A=A&C	S
	AR3EX.F	S
	P=	0
	CSRB.F	P
	CSRB.F	P
	AR1EX.F	A
	A=A-C	A
	AR1EX.F	A
	GOC	outerr
	AR0EX.F	A
	D1=A
	A=A+C	A
	AR0EX.F	A
	A=A-1	S
	GOC	noshf
shflp	A=A+A	A
	A=A-1	S
	GONC	shflp
noshf	C=0	A
	C=DAT1	P
	C=C!A	A
	DAT1=C	A
	RTN
outerr	GOTO	memerr
*********************************

	STITLE	Match Decoder
*********************************
* Decode directive from stream
* In:	D0	= ->in
*	D1	= ->obptr
*	R3[S]	= bits (used)
*	R3[A]	= ->ob
* Out:	A[A]=nlen D[A]=0
*	A[A]=offs D[A]=mlen
*********************************
Decod	?ST=1	sMNEXT
	GOYES	dcmat
	P=	1
	GOSUB	GetBits
	?ABIT=1	0
	GOYES	dcmat
	ST=1	sMNEXT
	P=	NBITS
	GOSUB	GetBits
	D=0	A
	?A#0	A
	RTNYES
	P=	NBITS2
	GOSUB	GetBits
	?A#0	A
	GOYES	fxlit
	GOSUB	GetA[A]
fxlit	LC(5)	NMASK
	A=A+C	A
	RTN
	
dcmat	ST=0	sMNEXT
	P=	MBITS
	GOSUB	GetBits
	?A#0	A
	GOYES	dcoff
	P=	MBITS2
	GOSUB	GetBits
	?A#0	A
	GOYES	fxmat
	GOSUB	GetA[A]
fxmat	LC(5)	MMASK
	A=A+C	A
dcoff	C=A	A
	D=C	A	mlen
	D=D+CON	A,(MINMAT)-1
	AD1EX
	D1=A
	C=R3.F	A	->ob
	A=A-C	A	maxoff
	LC(5)	#7FF
	P=	12
dcoflp	?A>C	A
	GOYES	GetBits
	CSRB.F	A
	P=P-1
	GONC	dcoflp	BET

*********************************
GetA[A]	P=	12
	GOSUB	GetBits
	B=A	X
	P=	8
	GOSUB	GetBits
	ASL	A
	ASL	A
	ASL	A
	A=B	X
	RTN
*********************************
* Get P bits
*********************************
GetBits	A=DAT0	A
	A=R3.F	S
	A=A-1	S
	GOC	gb0
gbshf	ASRB.F	A
	A=A-1	S
	GONC	gbshf
gb0	C=P	15
	C=C-1	S
	C=0	A
gbmlp	C=C+C	A
	C=C+1	A
	C=C-1	S
	GONC	gbmlp
	A=A&C	A

	A=R3.F	S
	C=P	15
	C=C+A	S
	A=C	S
	C=0	A
	P=	3
	CPEX	15
	CPEX	0
	A=A&C	S
	R3=A.F	S
	P=	0
	CSRB.F	P
	CSRB.F	P
	AD0EX
	A=A+C	A
	AD0EX
	RTN

*********************************

	STITLE	Match Finder
*********************************
* Find next match causing a pack
* In:
*	D0	->pos
*	R2[A]	->buffer
*	R3[A]	->ob
*	R4[A]	->obend
* Out:
*	D0	->newpos
*	D[A]	matchlen
*	D[A1]	matchpos
* Uses:	A[W] B[A] C[W] D[W]
*********************************
FindMax	GOSUB	RemoveOld
	GOSUB	AddNew
	GOC	nxtmat
	GOSUB	ScanThis
	?D#0	A
	GOYES	gotmax?
nxtmat	AD0EX
	A=A+1	A
	D0=A
	C=R4.F	A
	?C>A	A
	GOYES	FindMax
	D=0	W
	RTNSC
gotmax?	LC(5)	MINMAT
	?D<C	A
	GOYES	nxtmat
	AD0EX
	D0=A
	C=R4.F	A
	C=C-A	A
	?D<=C	A
	RTNYES
	D=C	A
	LC(5)	MINMAT
	?D<C	A
	GOYES	nxtmat
	RTN

	STITLE	Ring Buffer Match Finder
*********************************
* Scan buffer for the longest
* match for D0. Note that no
* obend test is needed
* In:
*	D0	->pos
*	B[A]	->FLlink
*	R2[A]	->buffer
*	R3[A]	->ob
* Out:	D[A,A1]	match
* Uses:	A[W] B[A] C[W] D[W]
*********************************
ScanThis
	D=0	W
	C=B	A
	D1=C		->FLlink
	A=DAT1	A
scanloop
	D1=A
	GOSUB	Count
	?D>C	A
	GOYES	nextmat
*	?C=0	A
*	GOYES	nextmat
	CD1EX
	D=C	A
	CD1EX
	P=	9
	DSL	WP
	DSL	WP
	DSL	WP
	DSL	WP
	DSL	WP
	P=	0
	D=C	A
* Get next loc from buffer
nextmat	AD1EX
	B=0	A
	B=A	X
	C=R2.F	A
	C=C-B	A
	C=C-B	A
	C=C-B	A	->slot
	D1=C
	D1=D1-	3	Nonzero!
	C=A	A
	A=DAT1	X
	?C<A	A
	GOYES	scaok
	LC(5)	WINSIZE
	A=A+C	A
scaok	CD0EX
	D0=C
	?C>A	A
	GOYES	scanloop
	RTN

	STITLE	Match Length Counter
*********************************
* Compare nibbles
* In:	D0 D1
* Out:	C[A] = match length
* Uses:	A[W] B[A] C[A]
*********************************
Count	B=0	A
	A=DAT0	W
	C=DAT1	W
	?C#A	W
	GOYES	cntwp
cntwlp	D0=D0+	16
	D1=D1+	16
	B=B+1	A
	A=DAT0	W
	C=DAT1	W
	?C=A	W
	GOYES	cntwlp
	BSL	A
	CD0EX
	C=C-B	A
	CD0EX
	CD1EX
	C=C-B	A
	CD1EX
cntwp	P=	8-1
	?C=A	WP
	GOYES	cntP8
	P=	4-1
	?C=A	WP
	GOYES	cntPlp
	P=	1-1
	GONC	cnpP+
cntP8	P=	12-1
	?C=A	WP
	GOYES	cntPlp
	P=	8-1
cntPlp	P=P+1
cnpP+	?C=A	P
	GOYES	cntPlp
	C=B	A
	CPEX	0
	RTNCC

	STITLE	Ring Buffer Addition
*********************************
* Add current location to ring
* In:	D0
*	R2[A]	->buffer
* Out:	B[A]	->FLlink
*	CS:	no previous ones
* Uses:	A[A] B[A] C[A] D1
*********************************
AddNew
* Compute hash
	A=DAT0	A
	C=A	A
	CSR	A
	CSR	A
	CSRB.F	X
	CSRB.F	X
	B=A	X
	A=A!C	X
	C=C&B	X
	A=A-C	X	hash
* Uncomment if less than 12 bits:
	LC(3)	(HSHSIZE)-1
	C=C&A	X

	A=R2.F	A
	C=C+C	A	2*
	A=A+C	A
	C=C+C	A	4*
	C=C+C	A	8*
	A=A+C	A	10*
	B=A	A	->FLlink
	D1=A
	D1=D1+	5
	A=DAT1	A	LastAddr
	CD0EX
	DAT1=C	A	New LastAddr
	D0=C
	?A=0	A
	GOYES	add1st
* Add to end
addok	C=0	A
	C=A	X
	A=R2.F	A
	A=A-C	A
	A=A-C	A
	A=A-C	A	->lastslot
	D1=A
	D1=D1-	3	Nonzero!
	AD0EX
	DAT1=A	X	link it to D0
	D0=A
	RTNCC
* No previous ones
add1st	D1=D1-	5
	DAT1=C	A
	RTNSC

	STITLE	Ring Buffer Remove
*********************************
* Remove old location from buffer
* In:	D0	->obptr
*	R3[A]	->ob
* Uses:	A[A] B[A] C[A] D1
*********************************
RemoveOld
	AD0EX
	D0=A
	LC(5)	WINSIZE
	A=A-C	A
	C=R3.F	A	->ob
	?C>A	A
	RTNYES
* Old one is in ring, remove it
	D1=A
* Compute hash
	A=DAT1	A
	C=A	A
	CSR	A
	CSR	A
	CSRB.F	X
	CSRB.F	X
	B=A	X
	A=A!C	X
	C=C&B	X
	A=A-C	X	hash
* Uncomment if less than 12 bits:
	LC(3)	(HSHSIZE)-1
	C=C&A	X

	A=R2.F	A
	C=C+C	A	2*
	A=A+C	A
	C=C+C	A	4*
	C=C+C	A	8*
	A=A+C	A	10*
	AD1EX
	B=A	A	->oldpos
	A=DAT1	A
	D1=D1+	5
	C=DAT1	A
	?C<=A	A
	GOYES	removeall
	D1=D1-	5
	C=0	A
	C=B	X
	A=R2.F	A	->buffer
	A=A-C	A
	A=A-C	A
	A=A-C	A	->1stslot
	AD1EX
	D1=D1-	3	Nonzero!
	C=B	A
	C=DAT1	X	1stlink
	D1=A
	?B<C	A
	GOYES	remok
	B=C	A
	LC(5)	WINSIZE
	C=C+B	A
remok	DAT1=C	A
	RTNCC
removeall
	C=0	A
	DAT1=C	A
	D1=D1-	5
	DAT1=C	A
	RTN

	STITLE	Annunciator Flash
*********************************
PackInfo
	D1=(5)	=ANNCTRL
	A=DAT1	B
	A=A+A	B
	ABIT=0	6
	?A#0	B
	GOYES	inf00
	A=A+1	B
inf00	ABIT=1	7
	DAT1=A	B
	RTNCC

	STITLE	Abort Check
*********************************
PackAbort?
	D1=(5)	=aATTNFLG
	A=DAT1	A
	D1=A
	A=DAT1	A
	?A=0	A
	RTNYES
	A=R0
	GOSBVL	=ASRW5
	R0=A
	D0=A
	D0=D0+	10
	GOSBVL	=Shrink$
	GOSBVL	=DispOn
	LC(5)	=ABORT
	GOTO	gpevalc
*********************************
ENDCODE

  SysTime 1GETLAM bit-
  SysTime 1PUTLAM
  SysTime 1GETLAM bit- bit-
  ABND
  HXS>% % 8192 %/ %3 RNDXY UNROT
  DUP4UNROLL OSIZE
  ( $bz %time #len1 #len2 )
  UNCOERCE2 2DUP %CH
  %2 RNDXY a%>$
  "%CH: " !insert$
  4ROLL a%>$ "   Time: " !insert$
  !append$
  ZERO FOURTEEN BLANKIT
  ABUFF #42 #A 4ROLL MINUSONE
  CENTER$3x5 DROP  
  %2 %/ a%>$ SWAP %2 %/ a%>$
  "Size: " !insert$
  " \8D " !append$ !insert$
  ABUFF #42 ZERO 4ROLL MINUSONE
  CENTER$3x5 DROP
  SetDA1Temp
;