A2osX/LIB/LIBPAK.S.txt
2018-02-09 07:04:19 +00:00

753 lines
14 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 /A2OSX.BUILD/LIB/LIBPAK.O
*--------------------------------------
* BITSTREAM :
*--------------------------------------
* 0 : SHORT3 (1)+3=4 bits
* 3 bits : index in Short3 Table
*--------------------------------------
* 10 : SHORT4 (2)+4=6 bits
* 4 bits : index in Short4 Table
*--------------------------------------
* 110 : REPn (3)+5=8 bits
* 5 bits count (1+n)
*--------------------------------------
* 1110 = BACKLINK : (4)+12+8=24 bits
* 12 bits : Offset (HI-4,LO-8)
* 8 bits : 4 + n (8 bits count) (259 max)
*--------------------------------------
* 1111 : STOREn (4) + 4 cnt + 8n....
*--------------------------------------
PAK.L.SHORT3 .EQ 1
PAK.B.SHORT3 .EQ %00000000
PAK.L.SHORT4 .EQ 2
PAK.B.SHORT4 .EQ %10000000
PAK.L.REPn .EQ 3
PAK.B.REPn .EQ %11000000
PAK.L.BACKLINK .EQ 4
PAK.B.BACKLINK .EQ %11100000
PAK.L.STOREn .EQ 4
PAK.B.STOREn .EQ %11110000
*--------------------------------------
WSIZE .EQ 4096
REPMAX .EQ 32
*--------------------------------------
.INB /A2OSX.BUILD/INC/MACROS.I
.INB /A2OSX.BUILD/INC/A2OSX.I
.INB /A2OSX.BUILD/INC/LIBPAK.I
*--------------------------------------
ZPSrcWPtr .EQ ZPLIB
ZPSrcPtr .EQ ZPLIB+2
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 :
* 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 Pak.DstPtr
>PULLA
sta ZPHdrPtr+1
adc /S.PAKHDR
sta Pak.DstPtr+1
>PULLW Pak.Hdr+S.PAKHDR.LEN
>PULLW Pak.SrcPtr
* PASS #1 : REP & BL, raw store
jsr Pak.InitPass
stz Pak.StoreMode
jsr Pak.Run
bcs .9
>LDYA Pak.Stat+S.PAKSTAT.PASS2
>STYA Pak.Stat+S.PAKSTAT.PASS1
* PASS #2a : Count occurence for each value...
jsr Pak.BuildShortTable
* PASS #2b : REP & BL, true store with S3,S4
jsr Pak.InitPass
dec Pak.StoreMode
lda #8
sta Pak.PutBit+1 Initialize properly for
stz Pak.Byte first "PutBit" Call
jsr Pak.Run
bcs .9
ldy #S.PAKHDR-1
.1 lda Pak.Hdr,y
sta (ZPHdrPtr),y
dey
bpl .1
ldy #S.PAKSTAT-1
.2 lda Pak.Stat,y
sta (ZPStatPtr),y
dey
bpl .2
clc
rts
.9 lda #K.E.OOM
sec
rts
*--------------------------------------
Pak.InitPass >LDYA Pak.SrcPtr
>STYA ZPSrcPtr
>STYA Pak.WPtr
>LDYA Pak.DstPtr
>STYA ZPDstPtr
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 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
ldx #0
.1 stz Pak.CntL,x
stz Pak.CntH,x
inx
bne .1
lda Pak.Stat+S.PAKSTAT.PASS1
eor #$ff
sta Pak.Cnt
lda Pak.Stat+S.PAKSTAT.PASS1+1
eor #$ff
sta Pak.Cnt+1
>LDYA Pak.SrcPtr
>STYA .3+1
ldy #0
.2 inc Pak.Cnt
bne .3
inc Pak.Cnt+1
beq .5
.3 ldx $FFFF,y SELF MODIFIED
inc Pak.CntL,x
bne .4
inc Pak.CntH,x
.4 iny
bne .2
inc .3+2
bra .2
* ...Search for Top 24
.5 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
bcc .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.StoreMode
bmi .10
ldx #S.PAKSTAT.STORE
jsr Pak.UpdateStats
bra Pak.PutByte
.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 ldy #8
ldx #S.PAKSTAT.STORE
.8 jsr Pak.UpdateStats
*--------------------------------------
Pak.PutYBits asl
jsr Pak.PutBit
bcs .9
dey
bne Pak.PutYBits
.9 rts
*--------------------------------------
* Pak.PutBit (bit in C)
*--------------------------------------
Pak.PutBit ldx #$ff SELF MODIFIED
pha
bne .1
lda Pak.Byte
php
jsr Pak.PutByte
bcs .9
plp
stz Pak.Byte
ldx #8
.1 dex
stx Pak.PutBit+1
bcc .8 Nothing to "light up"
lda Pak.BitMask,x
tsb Pak.Byte
clc
.8 pla
rts
.9 plp
pla
sec
rts
*--------------------------------------
Pak.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
*/--------------------------------------
* UnPak
* 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
*--------------------------------------
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 (UnZPSrcPtr)
and UnPak.BitMask,x
cmp #1 if 0:CC, i>0 CS
pla
rts Bit is in C
*--------------------------------------
UnPak.GetByte lda (UnZPSrcPtr)
UnPak.NxtByte inc UnZPSrcPtr
bne .8
inc UnZPSrcPtr+1
.8 rts
*--------------------------------------
UnPak.PutByte inc UnZPDstPtr
bne .8
inc UnZPDstPtr+1
.8 sta (UnZPDstPtr)
rts
*--------------------------------------
CS.END
Pak.SrcPtr .BS 2
Pak.SrcCnt .BS 2
Pak.DstPtr .BS 2
Pak.DstCnt .BS 2
Pak.RepCnt .BS 1
Pak.LastByte .BS 1
Pak.Byte .BS 1
Pak.Cnt .BS 2
Pak.StoreMode .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.StoreBuf .BS 16
Pak.CntL .BS 256
Pak.CntH .BS 256
Pak.Hdr .BS S.PAKHDR
Pak.Stat .BS S.PAKSTAT
*--------------------------------------
Pak.BitMask .HS 0102040810204080
UnPak.BitMask .HS 8040201008040201
MAN
SAVE /A2OSX.SRC/LIB/LIBPAK.S
ASM