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