A2osX/LIB/LIBPAK.S.txt
2019-09-27 16:53:44 +02:00

524 lines
9.0 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
*--------------------------------------
ZPSrcPtr .EQ ZPLIB
ZPSrcWPtr .EQ ZPLIB+2
ZPCnt .EQ ZPLIB+4
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 0
*--------------------------------------
LIB.LOAD
LIB.UNLOAD clc
rts
*/--------------------------------------
* # Pak
* **In:**
* ##ASM
* PUSHW = S.PAKSTAT Ptr
* PUSHW = Output Buffer Ptr
* PUSHW = Input Buffer Len
* PUSHW = Input Buffer Ptr
*\--------------------------------------
Pak >PULLW Pak.SrcPtr
>PULLW Pak.SrcLen
>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.InitPass
jsr Pak.Run
bcs .9
jsr Pak.BuildTOPTable
* PASS #2 : store with TOP bytes
dec Pak.bPass2
jsr Pak.InitPass
jsr Pak.Out.Init Initialize properly for first "PutBit" Call
stz Pak.StringLen
jsr Pak.Run
bcs .9
ldy #S.PAKSHNK-1
.2 lda Pak.Shnk,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.SrcLen
eor #$ff
sta Pak.SrcCnt
lda Pak.SrcLen+1
eor #$ff
sta Pak.SrcCnt+1
stz 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
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.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.Cnt
ora Pak.Cnt+1
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.In.Byte 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.In.Byte
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.TopCnt
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.REPN
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.REPN
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 #S.PAKSHNK.TOPCNT
.1 cmp Pak.Shnk+S.PAKSHNK.TOPBYTES-1,y
beq .3
dey
bpl .1
ldx #S.PAKSTAT.BYTE8
jsr Pak.UpdateStats
clc
jmp Pak.Out.PutCA
.3 tya Range 0-23
lsr
lsr
lsr
tax
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.STOREn
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.UpdateStats inc Pak.Stat,x
bne .8
inc Pak.Stat+1,x
.8 rts
*--------------------------------------
* .INB USR/SRC/LIB/LIBPAK.S.IN
.INB USR/SRC/LIB/LIBPAK.S.OUT
*--------------------------------------
CS.END
*--------------------------------------
TOP.Bits .DA #%10000,#%110000,#%1110000
TOP.BitCnt .DA #5,#6,#7
TOP.Stat .DA #S.PAKSTAT.TOP8,S.PAKSTAT.TOP16,S.PAKSTAT.TOP24
*--------------------------------------
Pak.SrcPtr .BS 2
Pak.SrcLen .BS 2
Pak.SrcCnt .BS 2
Pak.DstCnt .BS 2
Pak.RepCnt .BS 1
Pak.LastByte .BS 1
Pak.StringLen .BS 1
Pak.StringBuf .BS STRINGMAX
Pak.TopCnt .BS 1
Pak.Cnt .BS 2
Pak.bStop .BS 1
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.Shnk .BS S.PAKSHNK
Pak.Stat .BS S.PAKSTAT
*--------------------------------------
Pak.In.BitMask .HS 8040201008040201
MAN
SAVE USR/SRC/LIB/LIBPAK.S
ASM