A2osX/LIB/LIBPAK.S.txt
2019-10-17 12:36:45 +02:00

693 lines
12 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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
*--------------------------------------
STATS .EQ 0
*--------------------------------------
ZPSrcPtr .EQ ZPLIB
ZPDstPtr .EQ ZPLIB+2
ZPStatPtr .EQ ZPLIB+4
ZPSrcBLPtr .EQ ZPLIB+6
ZPCnt .EQ ZPLIB+8
ZPBLCnt .EQ ZPLIB+10
*--------------------------------------
* 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
.DO STATS=1
L.MSG.Stats .DA MSG.Stats
L.MSG.TopBytes .DA MSG.TopBytes
.FIN
L.MSG.BL .DA MSG.BL
.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
ldx #S.PAKSTAT.PASS2+1
.2 stz Pak.Stat,x Reset Stats
dex
bpl .2
* PASS #1 : no store, update byte counters
stz Pak.bPass2
jsr Pak.Run
* bcs .9
jsr Pak.ComputeLenBits
jsr Pak.BuildTOPTable
.DO STATS=1
jsr Pak.PrintStats
.FIN
* PASS #2 : store with TOP bytes
dec Pak.bPass2
jsr Pak.Out.Init Initialize properly for first "PutBit" Call
bcs .9
jsr Pak.Run
bcs .9
jsr Pak.Out.Close
bcs .9
.DO STATS=1
jsr Pak.PrintStats
.FIN
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
ldx #S.PAKSTAT.TOP8
.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
bcs .20
jsr Pak.PutBL
bcs .9
ldy Pak.BestBLLen
.6 tya
clc
adc ZPSrcPtr
sta ZPSrcPtr
bcc .7
inc ZPSrcPtr+1
.7 tya
clc
adc Pak.SrcCnt
sta Pak.SrcCnt
bcc .1
inc Pak.SrcCnt+1
bmi .1
.8 clc
.9 rts
.20 lda (ZPSrcPtr) Not found...
jsr Pak.PutByte8
bcs .9
inc ZPSrcPtr
bne Pak.Run.1
inc ZPSrcPtr+1
bra Pak.Run.1
*--------------------------------------
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 #BL.MIN
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.ComputeLenBits
ldx #0
lda Pak.BL.Longest
beq .10
ldx #3
dec
dec
dec
beq .10
ldx #8
.1 asl
bcs .10
dex
bra .1
.10 stx Pak.BL.LenBits
ldx #0
ldy #0
lda Pak.BL.Farest+1
beq .22
ldy #8
ldx #8
.2 asl
bcs .4
dey
bra .2
.22 lda Pak.BL.Farest
beq .4
ldx #8
.3 asl
bcs .4
dex
bra .3
.4 stx Pak.BL.OfsBitsL
sty Pak.BL.OfsBitsH
lda Pak.BL.LenBits
asl
asl
asl
asl
adc Pak.BL.OfsBitsL
adc Pak.BL.OfsBitsH
ora #$80
sta Pak.Shnk+S.PAKSHNK.BLBITS
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.Top.Best 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.Top.Best
sta Pak.Shnk+S.PAKSHNK.TOPBYTES,y
tax
stz Pak.CntL,x Discard this entry
stz Pak.CntH,x
iny
cpy #TOP.MAX
bne .1
.8 sty Pak.Shnk+S.PAKSHNK.TOPCNT
Pak.BuildTOPTable.RTS
rts
*--------------------------------------
Pak.PutBL ldx #S.PAKSTAT.BL
jsr Pak.UpdateStats
lda Pak.BestBLLen
cmp Pak.BL.Longest
bcc .1
sta Pak.BL.Longest
.1 ldy Pak.BestBL
cpy Pak.BL.Farest
lda Pak.BestBL+1
pha
sbc Pak.BL.Farest+1
pla
bcc .2
>STYA Pak.BL.Farest
.2 bit Pak.bPass2
bmi .3
ldx #S.PAKSTAT.PASS1 Assume 1 BL worse case is 3 bytes
jsr Pak.UpdateStats
jsr Pak.UpdateStats
jsr Pak.UpdateStats
clc
rts
.3 ldy #PAK.B.BL.W
lda #PAK.B.BL
jsr Pak.Out.PutYBits
bcs Pak.BuildTOPTable.RTS
ldy Pak.BL.OfsBitsL
lda Pak.BestBL
jsr Pak.Out.PutYBits
bcs Pak.BuildTOPTable.RTS
ldy Pak.BL.OfsBitsH
beq .4
lda Pak.BestBL+1
jsr Pak.Out.PutYBits
bcs Pak.BuildTOPTable.RTS
.4 ldy Pak.BL.LenBits
lda Pak.BestBLLen
dec
dec
dec
jmp Pak.Out.PutYBits
*--------------------------------------
Pak.PutByte8 bit Pak.bPass2
bmi Pak.PutByte8.2
.5 tax
inc Pak.CntL,x
bne .6
inc Pak.CntH,x
.6 ldx #S.PAKSTAT.BYTE8
jsr Pak.UpdateStats
ldx #S.PAKSTAT.PASS1
jsr Pak.UpdateStats
clc
rts
Pak.PutByte8.2 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
pha
ldy #PAK.B.BYTE8.W
lda #PAK.B.BYTE8
jsr Pak.Out.PutYBits
pla
bcs .9
ldy #8
jmp Pak.Out.PutYBits
.3 dey Range 0-31
tya
lsr
lsr
lsr
tax Range 0-3
tya
and #7
ora TOP.Bits,x
ldy TOP.BitCnt,x
.4 pha
lda TOP.Stat,x
tax
jsr Pak.UpdateStats
pla
jmp Pak.Out.PutYBits
.9 rts
*--------------------------------------
Pak.Out.Init lda Pak.Shnk+S.PAKSHNK.BLBITS
jsr Pak.Out.PutByte
bcs .9
lda Pak.Shnk+S.PAKSHNK.ULEN
jsr Pak.Out.PutByte
bcs .9
lda Pak.Shnk+S.PAKSHNK.ULEN+1
jsr Pak.Out.PutByte
bcs .9
lda Pak.Shnk+S.PAKSHNK.TOPCNT
jsr Pak.Out.PutByte
bcs .9
tax
ldy #0
.1 lda Pak.Shnk+S.PAKSHNK.TOPBYTES,y
jsr Pak.Out.PutByte
bcs .9
iny
dex
bne .1
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
bra Pak.Out.PutByte
.8 clc
rts
*--------------------------------------
Pak.Out.PutYBits
phy
.1 cpy #8
beq .2
asl
iny
bra .1
.2 ply
.3 asl
pha
bcc .4
lda Pak.Out.Mask
tsb Pak.Out.Byte
.4 lsr Pak.Out.Mask
bcc .5
ror Pak.Out.Mask
lda Pak.Out.Byte
stz Pak.Out.Byte
jsr Pak.Out.PutByte
.5 pla
bcs .9
dey
bne .3
* clc
.9 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
*--------------------------------------
.DO STATS=1
Pak.PrintStats lda Pak.BL.OfsBitsL
clc
adc Pak.BL.OfsBitsH
>PUSHA
>PUSHW Pak.BL.Farest
>PUSHB Pak.BL.LenBits
>PUSHB Pak.BL.Longest
>PUSHW Pak.Stat+S.PAKSTAT.BL
ldx #S.PAKSTAT.BYTE8
.1 >PUSHW Pak.Stat,x
dex
dex
bpl .1
>PUSHW Pak.Shnk+S.PAKSHNK.ULEN
>PUSHBI 23
>LDYA L.MSG.Stats
>SYSCALL printf
ldx #TOP.MAX-1
.2 >PUSHB Pak.Shnk+S.PAKSHNK.TOPBYTES,x
dex
bpl .2
>PUSHB Pak.Shnk+S.PAKSHNK.TOPCNT
>PUSHBI TOP.MAX+1
>LDYA L.MSG.TopBytes
>SYSCALL printf
rts
.FIN
*--------------------------------------
CS.END
*--------------------------------------
.DO STATS=1
MSG.Stats .AS "\r\nLength : %5D\r\n"
.AS "Pass 1 : %5D\r\n"
.AS "Pass 2 : %5D\r\n"
.AS "Top 8 : %5D\r\n"
.AS "Top 16 : %5D\r\n"
.AS "Top 24 : %5D\r\n"
.AS "Top 32 : %5D\r\n"
.AS "Byte 8 : %5D\r\n"
.AZ "BL : %5D, Longest : %d (%d bits), Farest : %D (%d bits)\r\n"
MSG.TopBytes .AS "Top : (%2d) %h.%h.%h.%h.%h.%h.%h.%h %h.%h.%h.%h.%h.%h.%h.%h\r\n"
.AZ " %h.%h.%h.%h.%h.%h.%h.%h %h.%h.%h.%h.%h.%h.%h.%h\r\n"
.FIN
TOP.Bits .DA #PAK.B.TOP8,#PAK.B.TOP16,#PAK.B.TOP24,#PAK.B.TOP32
TOP.BitCnt .DA #PAK.B.TOP8.W,#PAK.B.TOP16.W,#PAK.B.TOP24.W,#PAK.B.TOP32.W
TOP.Stat .DA #S.PAKSTAT.TOP8,#S.PAKSTAT.TOP16,#S.PAKSTAT.TOP24,#S.PAKSTAT.TOP32
MSG.BL .AZ "o=%D,l=%d,d=%D:"
*--------------------------------------
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.Top.Best .BS 1
Pak.Cnt .BS 2
Pak.bStop .BS 1
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