The Grapevine 14

home *** CD-ROM | disk | FTP | other *** search

/ The Grapevine 14 / Grapevine_14_1995-02_TDR_Side_B.d64 / asm.packer < prev next >

Wrap

Text File | 2023-02-26 | 10KB | 530 lines

;*** SIX-PACK *** ;MULTIPLE & SIX BIT COMPRESSOR ;Code and algorithm by Reiner Richter. ;Started on the 28/8/94 extra = $4c ;Extra byte is most ; common byte outside ; a six bit range. pointer = $4d ;6-bit pack ptr. range = $4e ;Current Range. lastone = $4f temp = $4f get = $50 put = $52 check = $54 loarea = $0400 ;Used for scanning for hiarea = $0500 ; 'Extra" byte. memstart = $fa memend = $fc memtop = $fe buffer = $58 ;CODE MEANING (RANGE) ;0-57 Range Offset ; 58 Extra byte ; 59 Set to Range 0 0-57 ; 60 Set to Range 1 48-105 ; 61 Set to Range 2 97-154 ; 62 Set to Range 3 140-197 ; 63 Set to Range 4 198-255 *= $080d jmp main getbyte ldy #0 lda (get),y inc get bne getex inc get+1 getex rts putbyte ldy #0 sta (put),y inc put bne getex inc put+1 rts rgetbyte ldy #0 lda get bne skip1 dec get+1 skip1 dec get lda (get),y rts rputbyte ldy put bne skip2 dec put+1 skip2 dec put ldy #0 sta (put),y rts getcheck ldy #0 lda (check),y inc check bne getchkex inc check+1 getchkex rts eqpack ;Pack area from top. ;Equal byte pack only. ldy memend+1 ldx memend stx get sty get+1 ldy memtop+1 ldx memtop stx put sty put+1 ldy #$ff ;Ensure endbyte dec get+1 ; is not same as lda (get),y ; end+1 byte. inc get+1 eor #$0f ldy #0 sta (put),y movehilp jsr rgetbyte jsr rputbyte lda get cmp memstart beq skip5 bcs movehilp skip5 lda get+1 cmp memstart+1 bcs movehilp lda memtop sec sbc memend tax lda memtop+1 sbc memend+1 tay txa clc adc memstart tax tya adc memstart+1 tay stx get sty get+1 ldx memstart ldy memstart+1 stx put sty put+1 eqmain jsr getbyte sta lastone eqloop jsr putbyte ldx #1 multloop ldy #$00 lda lastone cmp (get),y bne store jsr getbyte inx bne multloop multstor jsr putbyte txa jmp eqloop store cpx #1 bne multstor lda get+1 cmp memtop+1 bne eqmain lda get cmp memtop bne eqmain ldx put ldy put+1 rts lorange .byte 0,48,97,140,198 hirange .byte 57,105,154,197,255 inrange ;Check if byte (A) is in ; current range (X). ;OUT: CLC=Yes, SEC=Y=New Range ldx range cmp hirange,x beq skip05 bcs outside skip05 cmp lorange,x bcc outside inside sec sbc lorange,x clc rts outside ;Byte is outside required range ; so need to calculate new. ldx #0 newrloop cmp hirange,x bcc newrange inx cpx #4 bcc newrloop newrange sec sbc lorange,x pha txa clc adc #59 tay pla sec rts extrachk ;Check memory for 'extra'. lda #0 sta range tax clrloop sta loarea,x sta hiarea,x inx bne clrloop chkloop jsr getcheck pha jsr inrange pla bcc samerng stx range tax inc loarea,x bne samerng inc hiarea,x samerng lda check cmp get bne chkloop lda check+1 cmp get+1 bne chkloop ;Counted bytes. ldx #0 newloop lda loarea,x ldy hiarea,x sta check sty check+1 stx lastone toosmall inx beq extrafnd ldy hiarea,x cmp check+1 bcc toosmall lda loarea,x cmp check bcc toosmall bcs newloop extrafnd lda lastone ldx put ldy put+1 rts alstore ;Store a byte according to ; the algorithm. ldx pointer sta loarea,x inc pointer cpx #3 bcc alstorex packloop ldy #6 sixpaklp lsr loarea,x ;Pack four bytes ror hiarea ; into three. ror hiarea+1 ror hiarea+2 dey bne sixpaklp dex bpl packloop lda hiarea jsr rputbyte lda hiarea+1 jsr rputbyte lda hiarea+2 jsr rputbyte lda #0 sta pointer alstorex rts compress jsr eqpack ;X&Y =end+1 stx get sty get+1 ldx memstart ldy memstart+1 stx check sty check+1 ldx memtop ldy memtop+1 stx put sty put+1 lda #0 sta pointer jsr extrachk sta extra jsr rputbyte ;1st byte is xtra lda #0 sta range mainloop jsr rgetbyte jsr inrange pha bcc skip3 txa sta range tya jsr alstore skip3 pla jsr alstore lda get+1 cmp memstart+1 bne mainloop lda get cmp memstart bne mainloop compex lda #63 jsr alstore lda #63 jsr alstore lda #63 jsr alstore ldx put ldy put+1 stx get sty get+1 ldx memstart ldy memstart+1 stx put sty put+1 movelolp jsr getbyte jsr putbyte lda get cmp memtop bne movelolp lda get+1 cmp memtop+1 bne movelolp ldx put ldy put+1 rts ;--------------------------------------- dgetbyte ldy #0 lda (get),y inc get bne skipd1 inc get+1 skipd1 rts dputbyte ldy #0 sta (put),y inc put bne skipd2 inc put+1 skipd2 rts drget ldy #0 lda get bne skipd4 dec get+1 skipd4 dec get lda (get),y rts drput ldy put bne skipd5 dec put+1 skipd5 dec put ldy #0 sta (put),y rts decomp ldx memend ldy memend+1 stx get sty get+1 jsr drget sta extra ldx memtop ldy memtop+1 stx put sty put+1 lda #0 sta range maindlp ldx #0 dgetloop jsr drget sta buffer,x inx cpx #3 bcc dgetloop ldx #4 byteloop ldy #6 roloop asl buffer+2 rol buffer+1 rol buffer rol temp dey bne roloop lda temp and #%00111111 cmp #58 bcc databyte bne setrange lda extra clc bcc storeit setrange sec sbc #59 sta range bpl nextbyte databyte ldy range clc adc lorange,y storeit jsr drput nextbyte dex bne byteloop lda get+1 cmp memstart+1 bne maindlp lda get cmp memstart bne maindlp ldx put ldy put+1 stx get sty get+1 ldx memstart ldy memstart+1 stx put sty put+1 jsr dgetbyte sta lastone jsr dputbyte dmltloop ldx #2 jsr dgetbyte cmp lastone bne mstore jsr dgetbyte tax lda lastone mstore sta lastone mstorelp dex beq dloopex jsr dputbyte jmp mstorelp dloopex lda get+1 cmp memtop+1 bne dmltloop ldx put ldy put+1 rts startxt .byte 147,5,14 .text " " .text "*** SIX-PACK ***" .byte 13,13,159 .text "Code & 6-bit algorithm" .text " developed by " .text "Reiner Richter." .byte 13,13,158 .text "Enter name of file " .text "to pack:" .byte 13,5,0 newtxt .byte 158,147,14,13 .text "Enter name to SAVE" .text "packed file as:" .byte 13,5,0 main lda #$36 sta $01 cli jsr $ffe7 jsr $ff81 lda #0 sta $d020 sta $d021 ldx #0 startlp lda startxt,x beq startex jsr $ffd2 inx bne startlp startex jsr getname ldx #0 ldy #$10 stx memstart sty memstart+1 lda #0 jsr $ffd5 stx memend sty memend+1 bcs main ;Check if error. ldx #0 ldy #$d0 stx memtop sty memtop+1 jsr compress stx memend sty memend+1 ldx #0 newtloop lda newtxt,x beq newex jsr $ffd2 inx bne newtloop newex jsr getname lda #memstart ldx memend ldy memend+1 jsr $ffd8 jmp main getname ;Get filename and SETLFS. ldy #0 jsr $ffcf getnamlp sta $0200,y cmp #13 beq getnamex iny bne getnamlp getnamex tya ldx #0 ldy #2 jsr $ffbd lda #8 tax ldy #0 jmp $ffba