A2osX/LIB/LIBPAK.S.txt
2018-10-21 22:54:07 +02:00

657 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
PREFIX /A2OSX.BUILD
AUTO 4,1
.LIST OFF
.OP 65C02
.OR $2000
.TF LIB/LIBPAK.O
*--------------------------------------
.INB INC/MACROS.I
.INB INC/A2OSX.I
.INB INC/LIBPAK.I
*--------------------------------------
ZPSrcPtr .EQ ZPLIB
ZPSrcWPtr .EQ ZPLIB+2
ZPCnt .EQ ZPLIB+4
ZPHdrPtr .EQ ZPLIB+14
ZPDstPtr .EQ ZPLIB+16
ZPStatPtr .EQ ZPLIB+18
*--------------------------------------
* 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
*/--------------------------------------
* # Pak
* **In:**
* ##ASM
* PUSHW = Src PTR
* PUSHW = Src Length
* PUSHW = Dst PTR Output Buffer
* PUSHW = Dst PTR S.PAKSTAT
*\--------------------------------------
* PASS #1 : BL+REP dryrun with raw BYTE store (no bit prefix) -> Dst
* if BL stat=0, disable BL in PASS #2
* BuildShortTable with DST
* PASS #2 : BL with store real prefixed S3,S4,REP & STORE -> Dst
*--------------------------------------
Pak >PULLW ZPStatPtr
>PULLA
sta ZPHdrPtr
clc
adc #S.PAKHDR
sta ZPDstPtr
>PULLA
sta ZPHdrPtr+1
adc /S.PAKHDR
sta ZPDstPtr+1
>PULLW Pak.Hdr+S.PAKHDR.LEN
>PULLW Pak.SrcPtr
* Reset Byte counters
ldx #0
.1 stz Pak.CntL,x
stz Pak.CntH,x
inx
bne .1
* PASS #1 : REP & BL, no store, update byte counters
jsr Pak.InitPass
stz Pak.bPass2
jsr Pak.Run
bcs .9
jsr Pak.BuildShortTable
* PASS #2 : REP & BL, store with S3,S4
jsr Pak.InitPass
dec Pak.bPass2
lda #$80
sta Pak.Mask Initialize properly for
stz Pak.Byte first "PutBit" Call
stz Pak.StoreCnt
jsr Pak.Run
bcs .9
ldy #S.PAKHDR-1
.2 lda Pak.Hdr,y
sta (ZPHdrPtr),y
dey
bpl .2
ldy #S.PAKSTAT-1
.3 lda Pak.Stat,y
sta (ZPStatPtr),y
dey
bpl .3
clc
rts
.9 lda #E.OOM
sec
rts
*--------------------------------------
Pak.InitPass >LDYA Pak.SrcPtr
>STYA ZPSrcPtr
>STYA Pak.WPtr
lda Pak.Hdr+S.PAKHDR.LEN
eor #$ff
sta Pak.SrcCnt
lda Pak.Hdr+S.PAKHDR.LEN+1
eor #$ff
sta Pak.SrcCnt+1
lda #$ff RepChar invalid
sta Pak.RepCnt
ldx #S.PAKSTAT.PASS2
.1 stz Pak.Stat,x Reset Stats
inx
cpx #S.PAKSTAT
bne .1
rts
*--------------------------------------
Pak.Run lda #$ff
cmp Pak.SrcCnt+1 return 255 if not $ffxx
bne .1
lda Pak.SrcCnt
eor #$ff return !xx if $ffxx
beq .8 0 byte left...
.1 cmp #4 less than 4 chars, give up BL
bcc .4
sta Pak.MaxReadAhead
stz Pak.BestBLLen
ldx #3
.2 inx
jsr Pak.ScanBL
bcs .3
>STYA Pak.BestBL
stx Pak.BestBLLen
cpx Pak.MaxReadAhead
bne .2
.3 lda Pak.BestBLLen
beq .4 NO BL found....
lda Pak.BestBL+1
ora #PAK.B.BACKLINK %1110 + Ofs.HI
jsr Pak.PutA
bcs .9
lda Pak.BestBL get Ofs.LO
jsr Pak.PutA
bcs .9
lda Pak.BestBLLen get back len
jsr Pak.PutA
bcs .9
lda Pak.BestBLLen
jsr Pak.SrcForward
ldx #S.PAKSTAT.BL
jsr Pak.UpdateStats
bra Pak.Run
.4 lda (ZPSrcPtr)
jsr Pak.PutA
bcs .9
lda #1
jsr Pak.SrcForward
bra Pak.Run
.8 lda Pak.RepCnt do we have a pending REP ?
beq .80
ora #PAK.B.REPn yes, add it
jmp Pak.PutA.1
.80 clc
.9 rts
*--------------------------------------
Pak.SrcForward pha Len
clc
adc ZPSrcPtr
sta ZPSrcPtr
bcc .1
clc
inc ZPSrcPtr+1
.1 pla
adc Pak.SrcCnt
sta Pak.SrcCnt
bcc .2
inc Pak.SrcCnt+1
.2 sec
lda ZPSrcPtr
sbc #WSIZE
tay
lda ZPSrcPtr+1
sbc /WSIZE
tax
cpy Pak.WPtr
sbc Pak.WPtr+1
bcc .8
sty Pak.WPtr
stx Pak.WPtr+1
.8 rts
*--------------------------------------
* Scan between Pak.WPtr & ZPSrcPtr-A
* Byte string at ZPSrcPtr (len A)
* IN : X = Byte string length
* OUT : CC: Y,A=offset to BL
*--------------------------------------
Pak.ScanBL stx Pak.WStrLen
sec
lda ZPSrcPtr WLimit=ZPSrcPtr-WStrLen
sbc Pak.WStrLen
sta Pak.WLimit
lda ZPSrcPtr+1
sbc #0
sta Pak.WLimit+1
lda Pak.WLimit
sec
sbc Pak.WPtr
eor #$ff
sta Pak.Cnt
lda Pak.WLimit+1
sbc Pak.WPtr+1
eor #$ff
sta Pak.Cnt+1
bcc .9 WLimit < Pak.WPtr
lda Pak.WPtr
sta ZPSrcWPtr
lda Pak.WPtr+1
sta ZPSrcWPtr+1
ldy #0
.1 lda (ZPSrcWPtr),y
cmp (ZPSrcPtr),y
bne .6
iny
cpy Pak.WStrLen
bne .1
sec
lda ZPSrcPtr
sbc ZPSrcWPtr
tay
lda ZPSrcPtr+1
sbc ZPSrcWPtr+1
clc
rts
.6 inc ZPSrcWPtr
bne .7
inc ZPSrcWPtr+1
.7 inc Pak.Cnt
bne .1
inc Pak.Cnt+1
bne .1
.9 sec
rts
*--------------------------------------
Pak.BuildShortTable
ldy #0
.6 stz Pak.Cnt Init best score to 0
stz Pak.Cnt+1
ldx #0
.7 lda Pak.Cnt
cmp Pak.CntL,x is it better at X
lda Pak.Cnt+1
sbc Pak.CntH,x
bcs .8 not better or equal...
stx Pak.Byte save new score index...
lda Pak.CntL,x
sta Pak.Cnt ...and value
lda Pak.CntH,x
sta Pak.Cnt+1
.8 inx
bne .7
lda Pak.Byte
sta Pak.Hdr+S.PAKHDR.SHORT3,y
tax
stz Pak.CntL,x Discard this entry
stz Pak.CntH,x
iny
cpy #24
bne .6
rts
*--------------------------------------
Pak.PutA bit Pak.RepCnt
bpl .1
stz Pak.RepCnt LastByte invalid...
sta Pak.LastByte
bra Pak.PutA.1 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.1
bcs .9
ldx #S.PAKSTAT.REP
jsr Pak.UpdateStats
stz Pak.RepCnt
.2 lda Pak.LastByte
bra Pak.PutA.1
.3 inc Pak.RepCnt
lda Pak.RepCnt
cmp #REPMAX
bne .8
dec
ora #PAK.B.REPn
jsr Pak.PutA.1
bcs .9
lda #1
sta Pak.RepCnt
ldx #S.PAKSTAT.REP
jsr Pak.UpdateStats
.8 clc
.9 rts
Pak.PutA.1 bit Pak.bPass2
bmi .10
tax
inc Pak.CntL,x
bne .11
inc Pak.CntH,x
.11 inc Pak.Stat+S.PAKSTAT.PASS1
bne .12
inc Pak.Stat+S.PAKSTAT.PASS1+1
.12 clc
rts
* Pak.PutA.1 PASS #2
.10 ldy #7
.1 cmp Pak.Hdr+S.PAKHDR.SHORT3,y
beq .3
dey
bpl .1
ldy #15
.2 cmp Pak.Hdr+S.PAKHDR.SHORT4,y
beq .4
dey
bpl .2
bra .7
.3 tya
asl
asl
asl
asl
ora #PAK.B.SHORT3
ldy #4
ldx #S.PAKSTAT.S3
bra .8
.4 tya
asl
asl
ora #PAK.B.SHORT4
ldy #6
ldx #S.PAKSTAT.S4
bra .8
.7 ldx Pak.StoreCnt
sta Pak.StoreBuf,x
inx
cpx #STOREMAX
beq Pak.Flush
stx Pak.StoreCnt
clc
rts
.8 jsr Pak.UpdateStats
*--------------------------------------
Pak.PutYBits asl
jsr Pak.PutBit
bcs .9
dey
bne Pak.PutYBits
.9 rts
*--------------------------------------
Pak.Flush ldx Pak.StoreCnt
beq .8
lda #PAK.B.STOREn
ldy #4
jsr Pak.PutYBits
bcs .9
ldx #0
.1 lda Pak.StoreBuf,x
sta Pak.LastByte update last byte for REP
ldy #8
jsr Pak.PutYBits
bcs .9
inc Pak.Stat+S.PAKSTAT.STORE
bne .2
inc Pak.Stat+S.PAKSTAT.STORE+1
.2 inx
dec Pak.StoreCnt
bne .1
stz Pak.RepCnt Don't forget to set last byte valid
.8 clc
.9 rts
*--------------------------------------
Pak.UpdateStats inc Pak.Stat,x
bne .8
inc Pak.Stat+1,x
.8 rts
*/--------------------------------------
* #UnPak
* ##ASM
* **In:**
* PUSHW = Src PTR Compressed Buffer
* PUSHW = Dst PTR
*\--------------------------------------
UnZPSrcPtr .EQ ZPLIB
UnZPDstPtr .EQ ZPLIB+2
UnPak.ShrtTbl .EQ ZPLIB+4
UnPak.Cnt .EQ ZPLIB+6
*--------------------------------------
UnPak >PULLA Get Dst PTR LO
sec
sbc #1
sta UnZPDstPtr
>PULLA Get Dst PTR HI
sbc #0
sta UnZPDstPtr+1 setup Dst PTR-1
>PULLW UnZPSrcPtr
jsr UnPak.GetByte Get !LEN for counting up to $0000
sta UnPak.Cnt
jsr UnPak.GetByte
sta UnPak.Cnt+1
>LDYA UnZPSrcPtr 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 UnZPDstPtr equiv. SUB offset
sta .7+1 PTR to Backlink LO
lda UnZPDstPtr+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 (UnZPDstPtr) Get Last Byte
jsr UnPak.PutByte
dex
bne .9
jmp .1
*--------------------------------------
CS.END
Pak.SrcPtr .BS 2
Pak.SrcCnt .BS 2
Pak.DstCnt .BS 2
Pak.RepCnt .BS 1
Pak.LastByte .BS 1
Pak.StoreCnt .BS 1
Pak.StoreBuf .BS STOREMAX
Pak.Cnt .BS 2
Pak.bPass2 .BS 1
Pak.MaxReadAhead .BS 1
Pak.BestBLLen .BS 1
Pak.BestBL .BS 2
Pak.WPtr .BS 2
Pak.WLimit .BS 2
Pak.WStrLen .BS 1
Pak.In.Byte .BS 1
Pak.In.Mask .BS 1
Pak.Out.Byte .BS 1
Pak.Out.Mask .BS 1
*--------------------------------------
Pak.CntL .BS 256
Pak.CntH .BS 256
Pak.Hdr .BS S.PAKHDR
Pak.Stat .BS S.PAKSTAT
*--------------------------------------
UnPak.BitMask .HS 8040201008040201
MAN
SAVE /A2OSX.SRC/LIB/LIBPAK.S
ASM