A2osX/LIB/LIBPAK.S.txt

NEW 
  AUTO 3,1
				.LIST OFF	
				.OP	65C02
				.OR	$2000
				.TF LIB/LIBPAK
*--------------------------------------
				.INB INC/MACROS.I
				.INB INC/A2OSX.I
				.INB INC/LIBPAK.I
*--------------------------------------
ZPSrcPtr		.EQ ZPLIB
ZPDstPtr		.EQ ZPLIB+2
ZPStatPtr		.EQ ZPLIB+4

ZPSrcBLPtr		.EQ ZPLIB+8
ZPCnt			.EQ ZPLIB+10
ZPBLCnt			.EQ ZPLIB+12


*--------------------------------------
*			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
L.MSG.Stats		.DA MSG.Stats
L.MSG.Top24		.DA MSG.Top24
				.DA 0
*--------------------------------------
LIB.LOAD
LIB.UNLOAD		clc
				rts
*/--------------------------------------
* # Pak
* ##ASM 
* `>PUSHW StatPtr`
* `>PUSHW DstPtr`
* `>PUSHW SrcLen`
* `>PUSHW SrcPtr`
* `>LIBCALL hLIBPAK,Pak`
* ## RETURN VALUE 
* CC, Y,A = CLEN
* CS, Pak failure
*\--------------------------------------
Pak				>PULLW Pak.SrcPtr
				>PULLW Pak.Shnk+S.PAKSHNK.ULEN
				>PULLW ZPDstPtr
				>PULLW ZPStatPtr

* Reset Byte counters

				ldx #0

.1				stz	Pak.CntL,x
				stz Pak.CntH,x
				inx
				bne .1

* PASS #1 : no store, update byte counters

				stz Pak.bPass2
								
				jsr Pak.Run
				bcs .9

				jsr Pak.ComputeBLBits
				jsr Pak.BuildTOPTable

				jsr Pak.PrintStats
				
* PASS #2 : store with TOP bytes

				dec Pak.bPass2
				
				jsr Pak.Out.Init		Initialize properly for first "PutBit" Call

				jsr Pak.Run
				bcs .9

				jsr Pak.PrintStats
				
				ldy #S.PAKSTAT-1
				
.7				lda Pak.Stat,y
				sta (ZPStatPtr),y
				dey
				bpl .7
				
				>LDYA Pak.Stat+S.PAKSTAT.PASS2
				clc

.9				rts		
*--------------------------------------
Pak.Run			>LDYA Pak.SrcPtr
				>STYA ZPSrcPtr
				
				stz Pak.BL.Longest
				stz Pak.BL.Farest
				stz Pak.BL.Farest+1

				lda Pak.Shnk+S.PAKSHNK.ULEN
				eor #$ff
				sta Pak.SrcCnt
				sta Pak.DstCnt
				
				lda Pak.Shnk+S.PAKSHNK.ULEN+1
				eor #$ff
				sta Pak.SrcCnt+1
				sta Pak.DstCnt+1
				
				sec
				ror Pak.RepCnt
				stz Pak.LastByte
				
				ldx #S.PAKSTAT.PASS1
				bit Pak.bPass2
				bpl .1
				
				inx
				inx
				
.1				stz Pak.Stat,x			Reset Stats
				inx
				cpx #S.PAKSTAT
				bne .1

Pak.Run.1		inc Pak.SrcCnt
				bne .1
				
				inc Pak.SrcCnt+1
				beq .8					0 byte left...
				
.1				jsr Pak.ScanBL
				bcc .2

				lda (ZPSrcPtr)			Not found...
				jsr Pak.PutA
				bcs .9
				
				inc ZPSrcPtr
				bne Pak.Run.1
				inc ZPSrcPtr+1
				bra Pak.Run.1				

.2				jsr Pak.PutBL
				bcs .9
				
				lda Pak.BestBLLen
				clc
				adc ZPSrcPtr
				sta ZPSrcPtr
				bcc .3
				inc ZPSrcPtr+1
				
.3				lda Pak.BestBLLen
				clc
				adc Pak.SrcCnt
				sta Pak.SrcCnt
				bcc .1
				inc Pak.SrcCnt+1
				bmi .1
			
.8				clc				
.9				rts
*--------------------------------------
Pak.ComputeBLBits
				ldx #8
				lda Pak.BL.Longest

				dec
				dec
				dec
				
.1				asl
				bcs .10
				dex
				bra .1
				
.10				stx Pak.BL.LenBits

				ldx #8
				ldy #0
				
				lda Pak.BL.Farest+1
				beq .22
					
				ldy #8
					
.2				asl
				bcs .4
				dey
				bra .2
				
.22				lda Pak.BL.Farest

.3				asl
				bcs .4
				dex
				bra .3

.4				stx Pak.BL.OfsBitsL
				sty Pak.BL.OfsBitsH
				rts
*--------------------------------------
Pak.BuildTOPTable
				ldy #0

.1				stz Pak.Cnt				Init best score to 0
				stz Pak.Cnt+1
				
				sec
				ror Pak.bStop
				
				ldx #0
				
.2				lda Pak.CntL,x
				ora Pak.CntH,x
				beq .3

				stz Pak.bStop

				lda Pak.Cnt
				cmp Pak.CntL,x			is it better at X
				lda Pak.Cnt+1
				sbc Pak.CntH,x
				bcs .3					not better or equal...
				
				stx Pak.LastByte		save new score index...
				
				lda Pak.CntL,x
				sta Pak.Cnt				...and value
				lda Pak.CntH,x
				sta Pak.Cnt+1
				
.3				inx
				bne .2
				
				bit Pak.bStop
				bmi .8
				
				lda Pak.LastByte
				sta Pak.Shnk+S.PAKSHNK.TOPBYTES,y
				tax
				stz Pak.CntL,x			Discard this entry
				stz Pak.CntH,x
				iny
				cpy #24
				bne .1
				
.8				sty Pak.Shnk+S.PAKSHNK.TOPCNT
				
				rts
*--------------------------------------
Pak.ScanBL		>LDYA Pak.SrcPtr		Start at beginning of Src buf
				>STYA ZPSrcBLPtr

				lda #$ff
				sta Pak.bBLFound
				stz Pak.BestBLLen
				
.1				lda ZPSrcBLPtr
				sec
				sbc ZPSrcPtr
				sta ZPBLCnt
				
				lda ZPSrcBLPtr+1
				sbc ZPSrcPtr+1
				sta ZPBLCnt+1			ZPSrcBLPtr < !BlCnt < ZPSrcPtr 
				bcs .8					ZPSrcBLPtr = ZPSrcPtr, exit
				
				>LDYA Pak.SrcCnt		make sure not going past End Buffer
				>STYA ZPCnt				while reading ahead
				
				ldy #0					...or Y = BL.MAX
				
.2				inc ZPBLCnt
				bne .3
				
				inc ZPBLCnt+1
				beq .6					ZPSrcBLPtr = ZPSrcPtr	
				
.3				inc ZPCnt
				bne .4

				inc ZPCnt+1
				beq .6					Last Src Data
				
.4				lda (ZPSrcPtr),y
				cmp (ZPSrcBLPtr),y
				bne .6					End of string matching
				
.5				iny
				cpy #BL.MAX
				bne .2					Max BL len
				
.6				cpy #4
				bcc .7					not long enough

				cpy Pak.BestBLLen
				bcc .7					not better ...
*				beq .7					!!! same...but closer !!!
				
				sty Pak.BestBLLen

				lda ZPSrcPtr
				sec
				sbc ZPSrcBLPtr
				sta Pak.BestBL

				lda ZPSrcPtr+1
				sbc ZPSrcBLPtr+1
				sta Pak.BestBL+1

				stz Pak.bBLFound
	
.7				inc ZPSrcBLPtr
				bne .1
				inc ZPSrcBLPtr+1
				bra .1

.8				rol Pak.bBLFound

				rts
*--------------------------------------
Pak.PutBL		ldx #S.PAKSTAT.BL
				jsr Pak.UpdateStats
				
*				jsr PrintBL

				lda Pak.BestBLLen
				cmp Pak.BL.Longest
				bcc .10
				
				sta Pak.BL.Longest
				
.10				ldy Pak.BestBL
				cpy Pak.BL.Farest
				
				lda Pak.BestBL+1
				pha
				sbc Pak.BL.Farest+1
				pla
				bcc .11
	
				>STYA Pak.BL.Farest
				
.11				bit Pak.bPass2
				bmi .20
	
				ldx #S.PAKSTAT.PASS1	Assume 1 BL worse case is 3 bytes
				jsr Pak.UpdateStats
				jsr Pak.UpdateStats
				jsr Pak.UpdateStats
				clc
				rts
				
.20				sec
				lda Pak.Out.PutBitC
				
				ldy Pak.BL.OfsBitsH
				beq .2
				
				lda Pak.BestBL+1
				jsr Pak.Out.PutYBits
				bcs .9
				
.2				ldy Pak.BL.OfsBitsL
				lda Pak.BestBL
				jsr Pak.Out.PutYBits
				bcs .9
				
				ldy Pak.BL.LenBits
				lda Pak.BestBLLen
				dec
				dec
				dec
				jsr Pak.Out.PutYBits
				
.9				rts
*--------------------------------------
Pak.PutA		bit Pak.bPass2
				bmi Pak.PutA.2
				
				tax
				inc Pak.CntL,x
				bne .1

				inc Pak.CntH,x

.1				ldx #S.PAKSTAT.PASS1
				jsr Pak.UpdateStats
				
				ldx #S.PAKSTAT.BYTE8
				jsr Pak.UpdateStats
				
				clc
				rts

Pak.PutA.2		bra Pak.PutA.2.Out

				bit Pak.RepCnt
				bpl .1

				stz Pak.RepCnt			LastByte invalid...		
				sta Pak.LastByte
				bra Pak.PutA.2.Out		send first byte.
				
.1				cmp Pak.LastByte
				beq .3
				
				sta Pak.LastByte		save new byte
				lda Pak.RepCnt			do we have a pending REP ?
				beq .2
				
				ora #PAK.B.REPn			yes, send it
				jsr  Pak.PutA.2.Out
				bcs .9

				ldx #S.PAKSTAT.REPN
				jsr Pak.UpdateStats
				stz Pak.RepCnt
				
.2				lda Pak.LastByte
				bra Pak.PutA.2.Out
				
.3				inc Pak.RepCnt
				lda Pak.RepCnt
				cmp #REP.MAX
				bne .8

				dec
				ora #PAK.B.REPn
				jsr Pak.PutA.2.Out
				bcs .9
				
				lda #1
				sta Pak.RepCnt
				
				ldx #S.PAKSTAT.REPN
				jsr Pak.UpdateStats
				
.8				clc
.9				rts

Pak.PutA.2.Out	ldy Pak.Shnk+S.PAKSHNK.TOPCNT

.1				cmp Pak.Shnk+S.PAKSHNK.TOPBYTES-1,y
				beq .3
				dey
				bne .1

				ldx #S.PAKSTAT.BYTE8
				jsr Pak.UpdateStats

				clc
				jmp Pak.Out.PutCA
				
.3				dey						Range 0-23
				
				tya
				lsr
				lsr
				lsr
				tax						Range 0-2
				tya
				and #7
				ora TOP.Bits,x
				ldy TOP.BitCnt,x
				pha
				lda TOP.Stat,x
				tax
				pla
				jsr Pak.UpdateStats
				jmp Pak.Out.PutYBits
*--------------------------------------
Pak.Flush		ldx Pak.StringLen 
				beq .8
				
				lda #PAK.B.STRING
				ldy #4
				jsr Pak.Out.PutYBits
				bcs .9
				
				ldx #0
				
.1				lda Pak.StringBuf,x
				sta Pak.LastByte		update last byte for REP
				ldy #8
				jsr Pak.Out.PutYBits
				bcs .9
				
				inc Pak.Stat+S.PAKSTAT.BYTE8
				bne .2
				inc Pak.Stat+S.PAKSTAT.BYTE8+1
				
.2				inx
				dec Pak.StringLen
				bne .1

				stz Pak.RepCnt			Don't forget to set last byte valid
				
.8				clc				
.9				rts
*--------------------------------------
Pak.Out.Init	lda Pak.Shnk+S.PAKSHNK.TOPCNT
				jsr Pak.Out.PutByte
				bcs .9
				
				ldy #0
				
.1				lda Pak.Shnk+S.PAKSHNK.TOPBYTES
				jsr Pak.Out.PutByte
				bcs .9

				iny
				cpy Pak.Shnk+S.PAKSHNK.TOPCNT
				bne .1
				
				stz Pak.StringLen

				lda #$80
				sta Pak.Out.Mask
				stz Pak.Out.Byte

				clc				
.9				rts
*--------------------------------------
Pak.Out.Close	bit Pak.Out.Mask
				bmi .8
				lda Pak.Out.Byte
				jmp Pak.Out.PutByte
.8				clc
				rts
*--------------------------------------
Pak.Out.PutCA	jsr Pak.Out.PutBitC
				bcs Pak.Out.Put.rts

				ldy #8

.1				asl
				jsr Pak.Out.PutBitC
				bcs Pak.Out.Put.rts
				dey
				bne .1
Pak.Out.Put.rts	rts
*--------------------------------------
Pak.Out.PutYBits
				asl
				jsr Pak.Out.PutBitC
				bcs .9
				dey
				bne Pak.Out.PutYBits
.9				rts
*--------------------------------------
Pak.Out.PutBitC	pha

				bcc .1
				lda Pak.Out.Mask
				tsb Pak.Out.Byte

.1				lsr Pak.Out.Mask
				bne .8

				ror Pak.Out.Mask
				
				jsr Pak.Out.PutByte
				bcs .9

				

.8				pla
*				clc
				rts

.9				pla
*				sec
				rts
*--------------------------------------
Pak.Out.PutByte	inc Pak.DstCnt
				bne .1

				inc Pak.DstCnt+1
				beq .9

.1				sta (ZPDstPtr)

				inc ZPDstPtr
				bne .2
				
				inc ZPDstPtr+1

.2				inc Pak.Stat+S.PAKSTAT.PASS2
				bne .8

				inc Pak.Stat+S.PAKSTAT.PASS2+1

.8				clc
				rts

.9				sec
				rts
*--------------------------------------
Pak.UpdateStats	inc Pak.Stat,x
				bne .8
				inc Pak.Stat+1,x
.8				rts
*--------------------------------------
Pak.PrintStats	lda Pak.BL.OfsBitsL
				clc
				adc Pak.BL.OfsBitsH
				>PUSHA

				>PUSHW Pak.BL.Farest
				
				>PUSHB Pak.BL.LenBits
				>PUSHB Pak.BL.Longest

				ldx #14

.1				>PUSHW Pak.Stat,x
				dex
				dex
				bpl .1
				
				>PUSHBI 21
				>LDYA L.MSG.Stats
				>SYSCALL printf
				
				ldx #24
				
.2				>PUSHB Pak.Shnk+S.PAKSHNK.TOPCNT,x
				dex
				bpl .2
				
				>PUSHBI 25
				>LDYA L.MSG.Top24
				>SYSCALL printf
			>DEBUG
				rts
*--------------------------------------
PrintBl			>LDYA Pak.BestBL
				>STYA ZPSrcBLPtr
				
				lda #'{'
				>SYSCALL putchar
				
				ldy #0
				ldx Pak.BestBLLen
				
.40				lda (ZPSrcBLPtr),y
				phy
				phx
				cmp #C.SPACE
				bcs .41
	
				lda #'_'
.41				>SYSCALL putchar
				plx
				ply
				iny
				dex
				bne .40
				
				lda #'}'
				>SYSCALL putchar
				lda #C.CR
				>SYSCALL putchar
				lda #C.LF
				>SYSCALL putchar
				rts
*--------------------------------------
CS.END
*--------------------------------------
MSG.Stats		.AS "\r\nPass 1 : %5D\r\n"
				.AS "Pass 2 : %5D\r\n"
				.AS "Byte 8 : %5D\r\n"
				.AS "Top  8 : %5D\r\n"
				.AS "Top 16 : %5D\r\n"
				.AS "Top 24 : %5D\r\n"
				.AS "Rep  N : %5D\r\n"
				.AZ "BLNK   : %5D, Longest : %d (%d bits), Farest : %D (%d bits)\r\n"
MSG.Top24		.AZ "Top (%2d) : %h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h%h\r\n"
TOP.Bits		.DA #PAK.B.TOP8,PAK.B.TOP16,PAK.B.TOP24
TOP.BitCnt		.DA #5,#6,#7
TOP.Stat		.DA #S.PAKSTAT.TOP8,#S.PAKSTAT.TOP16,#S.PAKSTAT.TOP24
*--------------------------------------
Pak.SrcPtr		.BS 2

Pak.SrcCnt		.BS 2
Pak.DstCnt		.BS 2

Pak.bPass2		.BS 1

Pak.BL.Longest	.BS 1
Pak.BL.Farest	.BS 2

Pak.BL.LenBits	.BS 1
Pak.BL.OfsBitsL	.BS 1
Pak.BL.OfsBitsH	.BS 1

Pak.bBLFound	.BS 1
Pak.BestBLLen	.BS 1
Pak.BestBL		.BS 2

Pak.Cnt			.BS 2
Pak.bStop		.BS 1

Pak.RepCnt		.BS 1
Pak.LastByte	.BS 1

Pak.StringLen	.BS 1
Pak.StringBuf	.BS STRING.MAX

Pak.Out.Byte	.BS 1
Pak.Out.Mask	.BS 1
*--------------------------------------
Pak.CntL		.BS 256
Pak.CntH		.BS 256
Pak.Shnk		.BS S.PAKSHNK
Pak.Stat		.BS S.PAKSTAT
*--------------------------------------
MAN
SAVE USR/SRC/LIB/LIBPAK.S
ASM