A2osX/LIB/LIBPAK.S.txt
2017-03-30 08:31:12 +02:00

654 lines
13 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.

PR#3
PREFIX /A2OSX.BUILD
NEW
INC 1
AUTO 6
.LIST OFF
.OP 65C02
.OR $2000
.TF /A2OSX.BUILD/LIB/LIBPAK.O
*--------------------------------------
* File Header :
* SFX :
* - BIN must begin with CLD (QCODE)
* - BIN must be relocatable
* - BIN must overwrite itself
* (well, best way is moving CODE to $200)
*--------------------------------------
* Shunk Header :
* WORD : !Target Length
* USED TO STOP UNPACK
* !!!NO EOF TOKEN!!!
* Short4 : [0..15]
* Short3 : [0..7]
*--------------------------------------
S.PAKHDR.LEN .EQ 0
S.PAKHDR.SHORT4 .EQ 2
S.PAKHDR.SHORT3 .EQ 18
*
S.PAKHDR .EQ 26
*--------------------------------------
S.PAKSTAT.BL .EQ 0
S.PAKSTAT.REP .EQ 2
S.PAKSTAT.S3 .EQ 4
S.PAKSTAT.S4 .EQ 6
S.PAKSTAT.STORE .EQ 8
*
S.PAKSTAT .EQ 10
*--------------------------------------
PIPELEN .EQ 18
*--------------------------------------
* BITSTREAM :
* 0 = STORE : 1 byte follow (9 bits)
*--------------
* 1 = CMD :
*---SHORT4 --- (3)+4=7 bits --------
* 100 : SHORT4
* xxxx = index in Short4 Table
*---SHORT3 --- (3)+3=6 bits --------
* 101 : SHORT3
* xxx = index in Short3 Table
*--- BACKLINK : (3)+9+4=16 bits ----
* 110 : BackLink
* 9 bits : Offset (LO8,HI1)
* 4 bits : 3 + n (4 bits count) (18 max)
*--- REP : (3)+1, (3)+1+4 =4/8 bits ----
* 111 : REP
* 0 : repeat last byte
* 1 : repeat 2 + n (4 bits count)
*--------------------------------------
.INB /A2OSX.BUILD/INC/MACROS.I
.INB /A2OSX.BUILD/INC/A2OSX.I
*--------------------------------------
Pak.SrcPtr .EQ ZPLIB
Pak.SrcBlPtr .EQ ZPLIB+2
Pak.SrcBlPtrT .EQ ZPLIB+4
Pak.DstPtr .EQ ZPLIB+6
*--------------------------------------
* 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
*--------------------------------------
* In :
* PULLW = Src PTR
* PULLW = Src LEN
* PULLW = Dst PTR Compressed Buffer
*--------------------------------------
Pak >PULLYA
>STYA Pak.Src Init for pass #1
>STYA Pak.SrcPtr
>PULLA Get Src Len LO
eor #$ff
sta Pak.SrcCnt
sta Pak.Cnt Init for pass #1
tax
>PULLA Get Src Len HI
eor #$ff
sta Pak.SrcCnt+1
sta Pak.Cnt+1 Init for pass #1
tay
>PULLW Pak.DstPtr
txa
jsr Pak.PutByte
tya
jsr Pak.PutByte
ldx #S.PAKSTAT-1
.1 stz PakStat,x Reset Stats
dex
bpl .1
* PASS #1 : Count occurence for each value...
Pak.1 ldx #0
.1 stz Pak.CntL,x
stz Pak.CntH,x
inx
bne .1
ldy #0
.2 inc Pak.Cnt
bne .3
inc Pak.Cnt+1
beq .5
.3 lda (Pak.SrcPtr),y
tax
inc Pak.CntL,x
bne .4
inc Pak.CntH,x
.4 iny
bne .2
inc Pak.SrcPtr+1
bra .2
* ...Search for Top 24
.5 ldy #23
.6 stz Pak.Cnt Init best score to 0
stz Pak.Cnt+1
stz Pak.Byte
ldx #0
.7 lda Pak.CntL,x is it better at X
cmp Pak.Cnt
lda Pak.CntH,x
sbc Pak.Cnt+1
bcs .8 not better
stx Pak.Byte
lda Pak.CntL,x
sta Pak.Cnt
lda Pak.CntH,x
sta Pak.Cnt+1
.8 inx
bne .7
lda Pak.Byte
sta PakHdr+S.PAKHDR.SHORT4,y
stz Pak.CntL,x Discard this entry
stz Pak.CntH,x
dey
bpl .6
ldx #15
.9 lda PakHdr+S.PAKHDR.SHORT4,x Store SHORT4 in reverse order
jsr Pak.PutByte
dex
bpl .9
ldx #7
.10 lda PakHdr+S.PAKHDR.SHORT3,x Store SHORT3 in reverse order
jsr Pak.PutByte
dex
bpl .10
>LDYAI S.PAKHDR Total Header Size
>STYA PakHdr+S.PAKHDR.LEN
* PASS #2 :
Pak.2 >LDYA Pak.Src Init for pass #2
>STYA Pak.SrcPtr
>STYA Pak.SrcBlPtr
>LDYA Pak.SrcCnt
>STYA Pak.Cnt
lda #8
sta Pak.PutBit+1 Initialize properly for first "PutBit" Call
stz Pak.Byte
stz Pak.PipeLen
Pak.2.LOOP ldx Pak.PipeLen Always fill Bytes in the PIPE until full
.1 jsr Pak.GetByte Load PIPE....
bcs .2 end of Buffer ?
sta Pak.Pipe,x
inx
cpx #PIPELEN PIPE Full ?
bne .1
.2 stx Pak.PipeLen
txa
beq Pak.2.EXIT PIPE empty ....exit
dex
bne Pak.2.REP more than one char in PIPE...REP?
jmp Pak.2.Store only one....store it
Pak.2.EXIT clc
rts
* try finding REPeating same bytes.....
Pak.2.REP ldx #0
lda Pak.Pipe
.1 cmp Pak.Pipe+1,x
bne .2
inx
cpx Pak.PipeLen
bne .1
.2 dex if one char.....no REP
beq Pak.2.BL
dex if 2, -> REP ONE (not 2)
phx REP 1 + 0 or more....save REP count for later....
jsr Pak.PutA a = byte to store
lda #%11100000
plx
phx
beq .3
ora #%00010000
.3 ldy #4
jsr Pak.PutYBits
txa
beq .4 if not REP 2 or more no extra count
ldy #4
jsr Pak.PutYBits
.4 pla
clc
adc #2
tay
jsr Pak.StripPipe Remove REP bytes from PIPE
ldx #S.PAKSTAT.REP
jsr Pak.UpdateStats
jmp Pak.2.LOOP
Pak.2.BL
* Try finding best matching BackLink between SrcBlPtr and SrcPtr (max 512)
.4 lda Pak.SrcPtr
sec
sbc Pak.PipeLen
sta Pak.Limit setup Limit to SrcPtr-PIPE
lda Pak.SrcPtr+1
sbc #0
sta Pak.Limit+1
.40 lda Pak.SrcBlPtr
sta Pak.SrcBlPtrT
lda Pak.SrcBlPtr+1
sta Pak.SrcBlPtrT+1
.5 txa Get PIPE Len
clc make sure SrcBlPtrT+PIPE < Limit
adc Pak.SrcBlPtrT
tay
lda Pak.SrcBlPtrT+1
adc #0
cpy Pak.Limit
sbc Pak.Limit+1
bcc .10 not enough room
txa
dec
tay
.8 lda (Pak.SrcBlPtrT),y
cmp Pak.Pipe,y
bne .9
dey
bpl .8
* Found a BL at Pak.SrcBlPtrT, Store it and remove X bytes from PIPE
phx save BL length
lda #%1100000
ldy #3
jsr Pak.PutYBits
lda Pak.Limit
sec
sbc Pak.SrcBlPtrT
php save C
ldy #8
jsr Pak.PutYBits
plp
lda Pak.Limit+1
sec
sbc Pak.SrcBlPtrT+1
jsr Pak.PutBit
ply Get back BL len
phy
jsr Pak.StripPipe Remove LEN bytes from PIPE
pla Get back BL len
sec
sbc #3 Adjust Range..3-18 to 0->15
asl
asl
asl
asl
ldy #4 store 4 bits len
jsr Pak.PutYBits
ldx #S.PAKSTAT.BL
jsr Pak.UpdateStats
jmp Pak.2.LOOP
* No match...try starting at next byte
.9 inc Pak.SrcBlPtrT
bne .5
inc Pak.SrcBlPtrT+1
bra .5
.10 dex reduce PIPE
cpx #2 2 bytes remaining? no need to BL, a BL is 16bits wide.....
bne .40 and start over from BLPtr
* NO Bl Found, STORE
Pak.2.Store lda Pak.Pipe
ldx #23
.1 cmp PakHdr+S.PAKHDR.SHORT4,x
beq .2
dex
bpl .1
lda #0
ldy #1
jsr Pak.PutYBits write 0
lda Pak.Pipe ...and byte
jsr Pak.PutA
ldy #1
jsr Pak.StripPipe
jmp Pak.2.LOOP
.2 cpx #16 16-23 -> SHORT3
bcs .3
txa 0-15, SHORT4
asl move to BIT 000xxxx0
ora #10000000 SHORT4
ldy #7
bra .8
.3 txa
and #7 make it xxx
asl
asl and 000xxx00
ora #10100000 SHORT3
ldy #6
.8 jsr Pak.PutYBits write 100xxxx
ldy #1
jsr Pak.StripPipe
jmp Pak.2.LOOP
*--------------------------------------
Pak.PutA ldy #8
*--------------------------------------
Pak.PutYBits asl
jsr Pak.PutBit
dey
bne Pak.PutYBits
rts
*--------------------------------------
* Pak.PutBit (bit in C)
*--------------------------------------
Pak.PutBit ldx #$ff
pha
bne .1
lda Pak.Byte
jsr Pak.PutByte
stz Pak.Byte
ldx #8
.1 dex
stx Pak.PutBit+1
bcc .8 Nothing to "light up"
lda Pak.Byte
lda Pak.BitMask,x
sta Pak.Byte
.8 pla
rts
*--------------------------------------
Pak.PutByte sta (Pak.DstPtr)
inc Pak.DstPtr
bne .1
inc Pak.DstPtr+1
.1 inc PakHdr+S.PAKHDR.LEN
bne .2
inc PakHdr+S.PAKHDR.LEN+1
.2
rts
*--------------------------------------
* Y = count to remove from PIPE
*--------------------------------------
Pak.StripPipe ldx Pak.PipeLen
beq .9
ldx #0
.1 lda Pak.Pipe+1,x
sta Pak.Pipe,x
inx
cpx Pak.PipeLen
bne .1
dec Pak.PipeLen
dey
bne Pak.StripPipe
.9 rts
*--------------------------------------
Pak.UpdateStats inc PakStat,x
bne .8
inc PakStat+1,x
.8 rts
*--------------------------------------
Pak.GetByte inc UnPak.Cnt
bne .1
inc UnPak.Cnt+1
beq .9
.1 lda (Pak.SrcPtr)
inc Pak.SrcPtr
bne .2
inc Pak.SrcPtr+1
.2 clc
rts
.9 sec
rts
*--------------------------------------
* UNPACK code as short as possible
* For Self Extract
*--------------------------------------
* UnPak
* In :
* PULLW = Src PTR Compressed Buffer
* PULLW = Dst PTR
*--------------------------------------
UnPak.SrcPtr .EQ ZPLIB
UnPak.DstPtr .EQ ZPLIB+2
UnPak.ShrtTbl .EQ ZPLIB+4
UnPak.Cnt .EQ ZPLIB+6
*--------------------------------------
UnPak >PULLW UnPak.SrcPtr
>PULLA Get Dst PTR LO
sec
sbc #1
sta UnPak.DstPtr
>PULLA Get Dst PTR HI
sbc #0
sta UnPak.DstPtr+1 setup Dst PTR-1
jsr UnPak.GetByte Get !LEN for counting up to $0000
sta UnPak.Cnt
jsr UnPak.GetByte
sta UnPak.Cnt+1
>LDYA UnPak.SrcPtr 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 UnPak.DstPtr equiv. SUB offset
sta .7+1 PTR to Backlink LO
lda UnPak.DstPtr+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 (UnPak.DstPtr) 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 (UnPak.SrcPtr)
and UnPak.BitMask,x
cmp #1 if 0:CC, i>0 CS
pla
rts Bit is in C
*--------------------------------------
UnPak.GetByte lda (UnPak.SrcPtr)
UnPak.NxtByte inc UnPak.SrcPtr
bne .8
inc UnPak.SrcPtr+1
.8 rts
*--------------------------------------
UnPak.PutByte inc UnPak.DstPtr
bne .8
inc UnPak.DstPtr+1
.8 sta (UnPak.DstPtr)
rts
*--------------------------------------
CS.END
Pak.Src .BS 2
Pak.SrcCnt .BS 2
Pak.Cnt .BS 2
Pak.CntL .BS 256
Pak.CntH .BS 256
Pak.Byte .BS 1
Pak.Limit .BS 2
Pak.PipeLen .BS 1
Pak.Pipe .BS 18
Pak.BitMask .HS 0102040810204080
*--------------------------------------
PakHdr .BS S.PAKHDR
PakStat .BS S.PAKSTAT
*--------------------------------------
UnPak.BitMask .HS 8040201008040201
MAN
SAVE /A2OSX.SRC/LIB/LIBPAK.S
ASM