A2osX/LIB/LIBPAK.S.txt
2019-10-04 17:47:26 +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
*--------------------------------------
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
* Select best BL.BitCnt
ldx #8
ldy #0
lda Pak.Shnk+S.PAKSHNK.ULEN+1
beq .22
ldy #8
.2 asl
bcs .4
dey
bra .2
.22 lda Pak.Shnk+S.PAKSHNK.ULEN
.3 asl
bcs .4
dex
bra .3
.4 stx Pak.BL.BitCntL
sty Pak.BL.BitCntH
* PASS #1 : no store, update byte counters
stz Pak.bPass2
jsr Pak.Run
bcs .9
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
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
stz Pak.BL.Longest
stz Pak.BL.Farest
stz Pak.BL.Farest+1
Pak.Run.1 inc Pak.SrcCnt
bne .1
inc Pak.SrcCnt+1
beq .8 0 byte left...
.1 jsr Pak.ScanBL
bcs .4
ldx #S.PAKSTAT.BL
jsr Pak.UpdateStats
* jsr PrintBL
lda Pak.BestBLLen
cmp Pak.BL.Longest
bcc .10
sta Pak.BL.Longest
.10 bit Pak.bPass2
bmi .11
ldx #S.PAKSTAT.PASS1 Assume 1 BL worse case is 3 bytes
jsr Pak.UpdateStats
jsr Pak.UpdateStats
jsr Pak.UpdateStats
bra .3
.11 sec
lda Pak.Out.PutBitC
ldy Pak.BL.BitCntH
beq .2
lda Pak.BestBL+1
jsr Pak.Out.PutYBits
.2 ldy Pak.BL.BitCntL
lda Pak.BestBL
jsr Pak.Out.PutYBits
ldy #6
lda Pak.BestBLLen
jsr Pak.Out.PutYBits
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
.4 lda (ZPSrcPtr)
jsr Pak.PutA
inc ZPSrcPtr
bne Pak.Run.1
inc ZPSrcPtr+1
bra Pak.Run.1
*--------------------------------------
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
sec
ror 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 .4 ZPSrcBLPtr = ZPSrcPtr
.3 lda (ZPSrcPtr),y
cmp (ZPSrcBLPtr),y
bne .4 End of string matching
iny
cpy #BL.MAX
beq .4 Max BL len
inc ZPCnt
bne .2
inc ZPCnt+1
bne .2 Last Src Data
.4 dey Adjust BL len Range
dey (0 = 3 matching chars...etc..)
dey
bmi .5 not long enough
cpy Pak.BestBLLen
bcc .5 not better ...
beq .5 same...
sty Pak.BestBLLen
>LDYA ZPSrcBLPtr
>STYA Pak.BestBL
stz Pak.bBLFound
.5 inc ZPSrcBLPtr
bne .1
inc ZPSrcBLPtr+1
bra .1
.8 rol Pak.bBLFound
rts
*--------------------------------------
PrintBl >LDYA Pak.BestBL
>STYA ZPSrcBLPtr
lda #'{'
>SYSCALL putchar
ldy #0
ldx Pak.BestBLLen
inx
inx
inx
.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
*--------------------------------------
Pak.PutA bit Pak.bPass2
bmi Pak.PutA.2
tax
inc Pak.CntL,x
bne .1
inc Pak.CntH,x
.1 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.BitCntL
clc
adc Pak.BL.BitCntH
>PUSHA
lda Pak.BL.Longest
>PUSHA
ldx #14
.1 >PUSHW Pak.Stat,x
dex
dex
bpl .1
>PUSHBI 18
>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
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 bytes, ptr witdh : %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.BitCntL .BS 1
Pak.BL.BitCntH .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