*
* BSI Bitstream Pack-Depacker...
* 
* Header Format:
* "LZBS"			; identifier
* (8 bits)			; crunch depth (2-13) in bits...
* (24 bits)			; decompressed length then data...
*
* Data format:
* %0 %xxxxxxxx			; take %xxxxxxxx literally...
* %1 %xxxxxxxx %yyyyyyyyyyyy	; go back %yyy... bytes and copy
*				; %xxx... bytes+2...
* %1 %00000000 %yyyyyyyyyyyy	; take %yyy... bytes literally...
*
* NOTE: The %yyy... value length depends on the crunch depth and
* position in decrunched data.  If 255 bytes from start, %yyy...
* will be 8 bits.  If 4096 bytes from start (and depth is 12),
* %yyy... will max out at 12 bits. -BSI
*

*** Change the following values as you require ***
pack:	move.l #$80000,pst	; data start
	move.l #$80547,pend	; data end+1
	move.l #$c0000,out	; output buffer... yields eop...
	move.w #12,depth	; crunch depth 2-13...
	bra dopack

depack:	move.l #$c0000,in	; data start
	move.l #$80000,buffer	; depack to...
	bra dodepak		; a3 will equal end+1

********** Cruncher Algorithm... **********
dopack:	move.w depth,d0		; crunch depth from 2-13...
	moveq #1,d4
	lsl.l d0,d4
	subq.l #1,d4

	move.w #7,bptr		; bitpointer...

	move.l out(pc),a0
	move.l #"LZBS",(a0)+	; header...
	move.l a0,a2		; save depack hdr val...

	move.l pst(pc),a5	; 1st byte is noncompressed...
	move.l pend,a3

	move.l a3,d0		; write len of file...
	sub.l a5,d0
	move.l d0,(a0)+
	move.l a0,out

	move.w #7,bptr
	move.b (a5)+,d0
	bsr outsing
	clr.w nopack

main:	move.l pst,a4
	move.l a5,d6
	sub.l a4,d6
	cmpi.l d4,d6
	ble speedok
	move.w d4,d6

speedok:lea bittab(pc),a0
	moveq #13,d5
speedck:cmp.w (a0)+,d6
	bge fixd6
	dbra d5,speedck
	moveq #2,d5		; absolute min # bits...

fixd6:	neg.w d6		; now a neg lookback!
	clr.w blen

srch:	move.b (a5),d0		; 1st char...
sloop:	cmp.b (a5,d6.w),d0	; any similar?
	beq scout		

	addq.w #1,d6		; keep going till collision...
	bne sloop

outpack:move.w blen,d1
	cmpi.w #3,d1
	blt regchar

packit:	tst.w nopack
	beq packit2
	bsr regflush
	clr.w nopack

packit2:moveq #1,d1		; packer flag...
	move.b d1,d0
	bsr emit

	move.w blen,d0
	subq.w #2,d0
	moveq #8,d1
	bsr emit

	neg.w best
	move.w best,d0		; write packback with few bits...
	move.w d5,d1
	bsr emit

	move.w blen,d0
endchk:	lea (a5,d0.w),a5
	cmp.l a3,a5
	blt main
	tst.w nopack
	beq outfix
	bsr regflush

outfix:	cmpi.w #7,bptr		; if nxtbit is 7, don't inc!
	beq mbv
	addq.l #1,out
mbv:	move.b d5,(a2)		; maxbits value
	rts

regchar:addi.w #1,nopack
	cmpi.w #4095,nopack
	bne regfl2
	bsr regflush
	move.w nopack,d0
	bra endchk
regfl2:	moveq #1,d0
	bra endchk	

regflush:			; flush the buffer...
	cmpi.w #21,nopack
	blt normch

	moveq #1,d1		; emit pack flag...
	move.b d1,d0
	bsr emit

	moveq #0,d0		; emit zero flag...
	moveq #8,d1
	bsr emit

	move.w nopack,d0	; emit skip length...
	moveq #12,d1
	bsr emit

	move.w nopack,d3
	neg.w d3
xfim:	move.b (a5,d3.w),d0
	moveq #8,d1
	bsr emit
	addq.w #1,d3
	bne xfim
	rts

normch:	move.w nopack,d3
	neg.w d3
xfch:	move.b (a5,d3.w),d0
	bsr outsing
	addq.w #1,d3
	bne xfch
	rts

scout:	move.w d6,d7
	moveq #0,d1
scloop:	move.b (a5,d1.w),d0
	cmp.b (a5,d6.w),d0
	bne scoutex
	addq.w #1,d1
	addq.w #1,d6
	lea (a5,d1.w),a4
	cmp.l a3,a4
	beq scoutex
	cmpi.w #257,d1		
	bne scloop

scoutex:cmpi.w blen,d1
	blt scfail
	move.w d1,blen
	move.w d7,best

	cmpi.w #257,d1
	beq packit
		
scfail:	addq.w #1,d7
	move.w d7,d6
	beq outpack
	bra srch


*
* output d0.b as a noncompressed single char...
*
outsing:move.b d0,d7
	moveq #0,d0
	moveq #1,d1
	bsr emit
	move.b d7,d0
	moveq #8,d1	; emit executes via fallthrough...

*
* emit: d0.w=val, d1.b=numbits...
*
emit:	move.w bptr(pc),d2
	move.l out(pc),a0
	subq.w #1,d1	

emitlp:	lsr.w #1,d0
	bcs emit1

emit0:	bclr.b d2,(a0)
	bra emit1a

emit1:	bset.b d2,(a0)
emit1a:	subq.w #1,d2
	bpl bposok
	moveq #7,d2
	lea 1(a0),a0
bposok:	dbra d1,emitlp

	move.w d2,bptr
	move.l a0,out
	rts

pst:	dc.l 0
pend:	dc.l 0
out:	dc.l 0
depth:	dc.w 0
bptr:	dc.w 0
best:	dc.w 0
blen:	dc.w 0
nopack:	dc.w 0
bittab:	dc.w 4096,2048,1024,512,256,128,64,32,16,8,4,2,1

********** Depack Algorithm **********
dodepak:move.w #7,gptr
	move.l in(pc),a0
	move.l (a0)+,d0
	cmpi.l #"LZBS",d0
	bne depex
	move.l (a0)+,d0
	move.l d0,d1
	swap d1
	lsr.l #8,d1		; crunch depth val find...
	moveq #1,d4
	lsl.l d1,d4
	subq.l #1,d4
	move.l a0,in

	move.l buffer(pc),a5
	move.l a5,a4
	move.l a5,a3
	andi.l #$ffffff,d0	; max len is 16 mb...
	add.l d0,a3

deloop:	cmp.l a3,a5
	bge depex
	moveq #1,d1
	bsr get
	tst.b d0
	bne rollout
	moveq #8,d1
	bsr get
	move.b d0,(a5)+
	bra deloop

rollout:move.l a5,d6
	sub.l a4,d6

	cmpi.l d4,d6
	ble speedo2
	move.w d4,d6

speedo2:lea bittab(pc),a0	; det # bits to extract...
	moveq #13,d5
speedc2:cmp.w (a0)+,d6
	bge fetptr
	dbra d5,speedc2
	moveq #2,d5		; absolute min # bits...

fetptr:	moveq #8,d1
	bsr get
	move.w d0,d6
	beq directde

	move.w d5,d1
	bsr get			; back pointer

	move.l a5,a0
	neg.w d0
	andi.w #$ff,d6
	addq.w #1,d6
copyold:move.b (a0,d0.w),(a5)+	; d0=numch-3
	addq.w #1,d0
	dbra d6,copyold
	bra deloop

depex:	rts

directde:
	moveq #12,d1
	bsr get
	move.w d0,d6
	subq.w #1,d6
didr2:	moveq #8,d1
	bsr get
	move.b d0,(a5)+
	dbra d6,didr2
	bra deloop
*
* get... d0 will = char, d1=# bits to get...
*
get:	moveq #0,d0
	move.w d1,d3
	subq.w #1,d1
	move.l in(pc),a0
	move.w gptr,d2
getloop:lsr.w #1,d0
	btst.b d2,(a0)
	beq nxtbit
	bset #15,d0	
nxtbit:	subq.w #1,d2
	bpl nxtb2
	moveq #7,d2
	lea 1(a0),a0
nxtb2:	dbra d1,getloop
	move.l a0,in
	move.w d2,gptr
	moveq #16,d1
	sub.w d3,d1
	lsr.w d1,d0
	rts

in:	dc.l 0
buffer:	dc.l 0
gptr:	dc.w 0