A2osX/LIB/LIBPAK.S.txt

PR#3
PREFIX /A2OSX.BUILD
NEW
INC 1
AUTO 6
				.LIST OFF	
				.OP	65C02
				.OR	$2000
				.TF /A2OSX.BUILD/LIB/LIBPAK.O
*--------------------------------------
* File Header :
* SFX : 
*  - BIN must begin with CLD (QCODE)
*  - BIN must be relocatable
*  - BIN must overwrite itself
* (well, best way is moving CODE to $200)
*--------------------------------------
* Shunk Header : 
*  WORD : !Target Length
*   USED TO STOP UNPACK 
*    !!!NO EOF TOKEN!!!
* Short4 : [0..15]
* Short3 : [0..7]
*--------------------------------------
S.PAKHDR.LEN	.EQ 0
S.PAKHDR.SHORT4	.EQ 2
S.PAKHDR.SHORT3	.EQ 18
*
S.PAKHDR		.EQ 26
*--------------------------------------
S.PAKSTAT.BL	.EQ 0
S.PAKSTAT.REP	.EQ 2
S.PAKSTAT.S3	.EQ 4
S.PAKSTAT.S4	.EQ 6
S.PAKSTAT.STORE	.EQ 8
*
S.PAKSTAT		.EQ 10
*--------------------------------------
PIPELEN			.EQ 18
*--------------------------------------
* BITSTREAM :
*  0 = STORE : 1 byte follow (9 bits)
*--------------
*  1 = CMD :
*---SHORT4 --- (3)+4=7 bits --------
*  100 : SHORT4
*   xxxx = index in Short4 Table
*---SHORT3 --- (3)+3=6 bits --------
*  101 : SHORT3
*   xxx = index in Short3 Table
*--- BACKLINK : (3)+9+4=16 bits ----
*  110 : BackLink
*    9 bits : Offset (LO8,HI1)
*    4 bits : 3 + n (4 bits count) (18 max)
*--- REP : (3)+1, (3)+1+4 =4/8 bits ----
*  111 : REP
*     0 : repeat last byte
*     1 : repeat  2 + n (4 bits count)
*--------------------------------------
				.INB /A2OSX.BUILD/INC/MACROS.I
				.INB /A2OSX.BUILD/INC/A2OSX.I
*--------------------------------------
Pak.SrcPtr		.EQ ZPLIB
Pak.SrcBlPtr	.EQ ZPLIB+2
Pak.SrcBlPtrT	.EQ ZPLIB+4
Pak.DstPtr		.EQ ZPLIB+6
*--------------------------------------
*			File Header (16 Bytes)
*--------------------------------------
CS.START		cld
				jmp (.1,x)
				.DA #$61				6502,Level 1 (65c02)
				.DA #1					BIN Layout Version 1
				.DA 0
				.DA CS.END-CS.START
				.DA 0
				.DA 0
				.DA 0
*--------------------------------------
* Relocation Table
*--------------------------------------
.1				.DA LIB.LOAD
				.DA LIB.UNLOAD
				.DA Pak
				.DA Unpak
				.DA 0
*--------------------------------------
LIB.LOAD
LIB.UNLOAD		clc
				rts
*--------------------------------------
* In : 
*  PULLW = Src PTR 
*  PULLW = Src LEN 
*  PULLW = Dst PTR Compressed Buffer
*--------------------------------------
Pak				>PULLYA
				>STYA Pak.Src			Init for pass #1
				>STYA Pak.SrcPtr
				>PULLA					Get Src Len LO
				eor #$ff
				sta Pak.SrcCnt
				sta Pak.Cnt				Init for pass #1
				tax

				>PULLA					Get Src Len HI
				eor #$ff
				sta Pak.SrcCnt+1
				sta Pak.Cnt+1			Init for pass #1
				tay
				
				>PULLW Pak.DstPtr
				txa
				jsr Pak.PutByte
				tya
				jsr Pak.PutByte				
				
				ldx #S.PAKSTAT-1
.1				stz PakStat,x			Reset Stats
				dex
				bpl .1
				
* PASS #1 : Count occurence for each value...

Pak.1			ldx #0
.1				stz	Pak.CntL,x
				stz Pak.CntH,x
				inx
				bne .1
				
				ldy #0
				
.2				inc Pak.Cnt
				bne .3
				inc Pak.Cnt+1
				beq .5
				
.3				lda (Pak.SrcPtr),y
				tax
				inc Pak.CntL,x
				bne .4
				inc Pak.CntH,x
.4				iny
				bne .2
				inc Pak.SrcPtr+1
				bra .2

* ...Search for Top 24
.5				ldy #23

.6				stz Pak.Cnt				Init best score to 0
				stz Pak.Cnt+1
				
				stz Pak.Byte
				ldx #0
				
.7				lda Pak.CntL,x			is it better at X
				cmp Pak.Cnt
				lda Pak.CntH,x
				sbc Pak.Cnt+1
				bcs .8					not better
				
				stx Pak.Byte
				lda Pak.CntL,x
				sta Pak.Cnt
				lda Pak.CntH,x
				sta Pak.Cnt+1
				
.8				inx
				bne .7
				
				lda Pak.Byte
				sta PakHdr+S.PAKHDR.SHORT4,y		
				stz Pak.CntL,x			Discard this entry
				stz Pak.CntH,x
				dey
				bpl .6
				
				ldx #15
				
.9				lda PakHdr+S.PAKHDR.SHORT4,x		Store SHORT4 in reverse order
				jsr Pak.PutByte
				dex
				bpl .9

				ldx #7

.10				lda PakHdr+S.PAKHDR.SHORT3,x		Store SHORT3 in reverse order
				jsr Pak.PutByte
				dex
				bpl .10
				
				>LDYAI S.PAKHDR			Total Header Size				
				>STYA PakHdr+S.PAKHDR.LEN
* PASS #2 : 	
Pak.2			>LDYA Pak.Src			Init for pass #2
				>STYA Pak.SrcPtr
				>STYA Pak.SrcBlPtr
				
				>LDYA Pak.SrcCnt
				>STYA Pak.Cnt						

				lda #8
				sta Pak.PutBit+1		Initialize properly for first "PutBit" Call
				stz Pak.Byte
				
				stz Pak.PipeLen
				
Pak.2.LOOP		ldx Pak.PipeLen			Always fill Bytes in the PIPE until full
				
.1				jsr Pak.GetByte			Load PIPE....
				bcs .2					end of Buffer ?
				sta Pak.Pipe,x
				inx
				cpx #PIPELEN			PIPE Full ?
				bne .1
				
.2				stx Pak.PipeLen

				txa
				beq Pak.2.EXIT			PIPE empty ....exit
				dex
				bne Pak.2.REP			more than one char in PIPE...REP?
				
				jmp	Pak.2.Store			only one....store it
				
Pak.2.EXIT		clc
				rts

* try finding REPeating same bytes.....
Pak.2.REP		ldx #0
				lda Pak.Pipe
				
.1				cmp Pak.Pipe+1,x
				bne .2
				inx
				cpx Pak.PipeLen
				bne .1

.2				dex						if one char.....no REP
				beq Pak.2.BL
				dex						if 2, -> REP ONE (not 2)
				phx						REP 1 + 0 or more....save REP count for later....
				
				jsr Pak.PutA			a = byte to store
				
				lda #%11100000
				plx
				phx
				beq .3
				
				ora #%00010000
				
.3				ldy #4
				jsr Pak.PutYBits
				txa
				beq .4					if not REP 2 or more no extra count
				ldy #4
				jsr Pak.PutYBits
				
.4				pla
				clc
				adc #2
				tay
				jsr Pak.StripPipe		Remove REP bytes from PIPE
				
				ldx #S.PAKSTAT.REP
				jsr Pak.UpdateStats
				jmp Pak.2.LOOP				
Pak.2.BL				
* Try finding best matching BackLink between SrcBlPtr and SrcPtr (max 512)			
.4				lda Pak.SrcPtr
				sec
				sbc Pak.PipeLen
				sta Pak.Limit			setup Limit to SrcPtr-PIPE
				lda Pak.SrcPtr+1
				sbc #0
				sta Pak.Limit+1
				
.40				lda Pak.SrcBlPtr
				sta Pak.SrcBlPtrT
				lda Pak.SrcBlPtr+1
				sta Pak.SrcBlPtrT+1

.5				txa						Get PIPE Len
				
				clc						make sure SrcBlPtrT+PIPE < Limit
				adc Pak.SrcBlPtrT
				tay
				lda Pak.SrcBlPtrT+1
				adc #0
				cpy Pak.Limit
				sbc Pak.Limit+1
				bcc .10					not enough room
				
				txa
				dec
				tay
.8				lda (Pak.SrcBlPtrT),y
				cmp Pak.Pipe,y
				bne .9
				dey
				bpl .8
				
* Found a BL at Pak.SrcBlPtrT, Store it and remove X bytes from PIPE
				phx						save BL length
				
				lda #%1100000
				ldy #3
				jsr Pak.PutYBits
				
				lda Pak.Limit
				sec
				sbc Pak.SrcBlPtrT
				php						save C
				
				ldy #8
				jsr Pak.PutYBits
				
				plp
				lda Pak.Limit+1
				sec
				sbc Pak.SrcBlPtrT+1
				
				jsr Pak.PutBit
				
				ply						Get back BL len
				phy
				
				jsr Pak.StripPipe		Remove LEN bytes from PIPE
				
				pla						Get back BL len
				sec
				sbc #3					Adjust Range..3-18 to 0->15
				asl
				asl
				asl
				asl
				ldy #4					store 4 bits len
				jsr Pak.PutYBits
				ldx #S.PAKSTAT.BL
				jsr Pak.UpdateStats
				jmp Pak.2.LOOP
				
* No match...try starting at next byte
.9				inc	Pak.SrcBlPtrT
				bne .5
				inc	Pak.SrcBlPtrT+1
				bra .5
.10				dex						reduce PIPE
				cpx #2					2 bytes remaining? no need to BL, a BL is 16bits wide.....
				bne .40					and start over from BLPtr
				
* NO Bl Found, STORE
Pak.2.Store		lda Pak.Pipe
				ldx #23
				
.1				cmp PakHdr+S.PAKHDR.SHORT4,x
				beq .2
				dex
				bpl .1
				
				lda #0
				ldy #1
				jsr Pak.PutYBits		write 0
				
				lda Pak.Pipe			...and byte
				jsr Pak.PutA
				
				ldy #1
				jsr Pak.StripPipe
				jmp Pak.2.LOOP
				
.2				cpx #16					16-23 -> SHORT3
				bcs .3 
				
				txa						0-15, SHORT4
				asl						move to BIT 000xxxx0
				
				ora #10000000			SHORT4
				ldy #7
				bra .8
				
.3				txa
				and #7					make it xxx
				asl
				asl						and 000xxx00
				ora #10100000			SHORT3
				ldy #6
				
.8				jsr Pak.PutYBits		write 100xxxx
				
				ldy #1
				jsr Pak.StripPipe
				jmp Pak.2.LOOP
*--------------------------------------
Pak.PutA		ldy #8
*--------------------------------------
Pak.PutYBits	asl
				jsr Pak.PutBit
				dey
				bne Pak.PutYBits
				rts
*--------------------------------------
* Pak.PutBit (bit in C)
*--------------------------------------
Pak.PutBit		ldx #$ff
				pha
				bne .1
				lda Pak.Byte
				jsr Pak.PutByte
				stz Pak.Byte
				ldx #8
				
.1				dex
				stx Pak.PutBit+1
				bcc .8					Nothing to "light up"
				
				lda Pak.Byte
				lda Pak.BitMask,x
				sta Pak.Byte
.8				pla
				rts				
*--------------------------------------
Pak.PutByte		sta (Pak.DstPtr)
				inc Pak.DstPtr
				bne .1
				inc Pak.DstPtr+1
				
.1				inc PakHdr+S.PAKHDR.LEN
				bne .2
				inc PakHdr+S.PAKHDR.LEN+1
.2				
				rts
*--------------------------------------
* Y = count to remove from PIPE
*--------------------------------------
Pak.StripPipe	ldx Pak.PipeLen
				beq .9
				
				ldx #0
				
.1				lda Pak.Pipe+1,x
				sta Pak.Pipe,x
				inx
				cpx Pak.PipeLen
				bne .1
				dec Pak.PipeLen
				dey
				bne Pak.StripPipe
				
.9				rts				
*--------------------------------------
Pak.UpdateStats	inc PakStat,x
				bne .8
				inc PakStat+1,x
.8				rts
*--------------------------------------
Pak.GetByte		inc	UnPak.Cnt
				bne .1
				inc UnPak.Cnt+1
				beq .9

.1				lda (Pak.SrcPtr)

				inc Pak.SrcPtr
				bne .2
				inc Pak.SrcPtr+1
				
.2				clc
				rts
				
.9				sec
				rts
*--------------------------------------
* UNPACK code as short as possible
* For Self Extract 
*--------------------------------------
* UnPak
* In : 
*  PULLW = Src PTR Compressed Buffer
*  PULLW = Dst PTR
*--------------------------------------
UnPak.SrcPtr	.EQ ZPLIB
UnPak.DstPtr	.EQ ZPLIB+2
UnPak.ShrtTbl	.EQ ZPLIB+4
UnPak.Cnt		.EQ ZPLIB+6
*--------------------------------------
UnPak			>PULLW UnPak.SrcPtr
				>PULLA					Get Dst PTR LO
				sec
				sbc #1					
				sta	UnPak.DstPtr
				>PULLA					Get Dst PTR HI
				sbc #0
				sta	UnPak.DstPtr+1		setup Dst PTR-1 
				
				jsr UnPak.GetByte		Get !LEN for counting up to $0000
				sta UnPak.Cnt
				
				jsr UnPak.GetByte
				sta UnPak.Cnt+1
				
				>LDYA UnPak.SrcPtr		Get PTR to Short Table.....
				>STYA UnPak.ShrtTbl		and save it for SHORTx
				
				lda #8
				sta UnPak.GetBit+1		Initialize properly for first "GetBit" Call
				
.1				inc	UnPak.Cnt
				bne .2
				inc UnPak.Cnt+1
				beq .99
				
.2				jsr UnPak.GetBit
				bcs .4					CMD....
*---- STORE
				jsr UnPak.GetBit
				ldx #1
				bcc	.3					if CC one byte
				jsr UnPak.Get4Bits		CC
				adc #2					range is 2->17
				tax
				
.3				jsr UnPak.Get8Bits
				jsr UnPak.PutByte
				dex
				bne .3
				bra .1
.99				rts				
*---- CMD
.4				jsr UnPak.GetBit
				bcs .6					BACKLINK or REP...
*---- CMD : SHORT		
				lda #0
				ldy #4
								
				jsr UnPak.GetBit		if CS short3
				rol						make offset 00000001
				asl						....00000010
				beq .5
				
				dey						if short3, only 3 bits
				
.5				jsr UnPak.GetBit
				rol
				dey
				bne .5	
				
				tay						if s3, offset is 00010xxx
				lda (UnPak.ShrtTbl),y	if s4, offset is 0000xxxx
				jsr UnPak.PutByte
				bra .1
*---- CMD : BACKLINK or REP
.6				jsr UnPak.GetBit
				bcs .8					if CS -> REP	
*---- CMD : BACKLINK
				jsr UnPak.Get8Bits		get Offset LO, (CC)
				eor #$ff				!offset LO
				adc UnPak.DstPtr		equiv. SUB offset
				sta .7+1				PTR to Backlink LO
				lda UnPak.DstPtr+1
				bcs .61					if ADC sets C, no need to dec HI
				dec
.61				jsr UnPak.GetBit		get Offset HI in C
				bcc .62
				dec
.62				sta .7+2				PTR to Backlink HI
				
				jsr UnPak.Get4Bits		CC
				adc #3					Backlink are ate least 3 bytes...
				tax
				ldy #0
				
.7				lda $ffff,y				Self Modified code : PTR to Backlink			
				jsr UnPak.PutByte
				iny
				dex
				bne .7
				beq .1
*---- CMD : REP				
.8				jsr UnPak.GetBit
				ldx #1
				bcc .9					REP 1
				
				jsr UnPak.Get4Bits		REP xxxx, CC
				adc #2					range is 2->17
				tax
				
.9				lda (UnPak.DstPtr)		Get Last Byte
				jsr UnPak.PutByte
				dex
				bne .9
				jmp .1
*--------------------------------------
UnPak.Get8Bits	ldy #8
				.HS 2C					bit abs
UnPak.Get4Bits	ldy #4
				lda #0					make sure to reset A before reading less than 8 bits only	
.1				jsr UnPak.GetBit		and to exit with CC if even if 8 bits read
				rol
				dey
				bne .1
				rts						always CC
*--------------------------------------
UnPak.GetBit	ldx #$ff				Self Modified code
				bne .1
				jsr UnPak.NxtByte
				
				ldx #8
				
.1				dex				
				stx UnPak.GetBit+1
				
				pha						Don't trash A
				lda (UnPak.SrcPtr)
				and UnPak.BitMask,x
				cmp #1					if 0:CC, i>0 CS
				
				pla
				rts						Bit is in C				
*--------------------------------------
UnPak.GetByte	lda (UnPak.SrcPtr)
UnPak.NxtByte	inc UnPak.SrcPtr
				bne .8
				inc UnPak.SrcPtr+1
.8				rts
*--------------------------------------
UnPak.PutByte	inc UnPak.DstPtr
				bne .8
				inc UnPak.DstPtr+1
.8				sta (UnPak.DstPtr)
				rts
*--------------------------------------
CS.END
Pak.Src			.BS 2
Pak.SrcCnt		.BS 2
Pak.Cnt			.BS 2
Pak.CntL		.BS 256
Pak.CntH		.BS 256
Pak.Byte		.BS 1
Pak.Limit		.BS 2
Pak.PipeLen		.BS 1
Pak.Pipe		.BS 18
Pak.BitMask		.HS 0102040810204080
*--------------------------------------
PakHdr			.BS S.PAKHDR
PakStat			.BS S.PAKSTAT
*--------------------------------------
UnPak.BitMask	.HS 8040201008040201
MAN
SAVE LIB/LIBPAK.S
ASM