* QL World DIY Toolkit 'PACKBITS' data compression extensions * Copyright 1994 Simon N Goodwin, version 1.4, 15th April 1994 * start lea.l define,a1 Point at extension table movea.w $110.w,a2 Read BP.INIT vector jmp (a2) Link extensions to SuperBASIC * * new_bytes = COMPRESS(old_bytes,source TO target) * squash moveq #1,d7 Flag for COMPRESS bra.s getints * bad_par moveq #-15,d0 Bad parameter error code give_up rts Return error code in D0 * * new_bytes = EXPAND(old_bytes,source TO target) * * SOURCE & TARGET are full 32 bit byte addresses, unchecked. * BYTES is treated as a 32 bit unsigned value (i.e. 4 Gb+). * Reports END OF FILE unless BYTES matches the end of a pack. * expand moveq #0,d7 Flag for EXPAND getints movea.w $118.w,a2 Vector to get long integers jsr (a2) bne.s give_up subq.w #3,d3 Check number of parameters bne.s bad_par move.l 0(a1,a6.l),d2 Byte count movea.l 8(a1,a6.l),a2 Target Address, anywhere move.l a2,d6 Save it for later movea.l 4(a1,a6.l),a4 Source address, unchecked tst.l d7 beq inflate * * PACKBITS compression routine * squeeze move.l d2,d3 Copy length beq result Do nothing, quickly add.l a4,d3 D3 points past last byte move.l a4,d5 Remember where we've got to move.b (a4)+,d2 Pick up first data byte cmp.b (a4),d2 Do we start with a group? beq.s next1 clr.b (a2)+ Start with an lone byte move.b d2,(a2)+ Bodge to include first byte * next1 cmp.l a4,d3 Have we finished yet? beq.s group_n Output the last group move.b (a4)+,d1 Check in the next byte cmp.b d1,d2 A match, perchance? beq.s next1 Keep looking good * * Bytes from (D5) to -2(A4) match, all D2; -1(A4) is D1 * lea.l -2(a4),a0 Point at last match exg a0,d5 Get biggest into D5 sub.l a0,d5 D5 := number of matches-1 beq.s group0 * * Compress the run of matching bytes into packed groups * do_lots cmp.l #128,d5 Can we do it in one? bcs.s in_one D5 is 1..127 for 2..128 bytes move.b #-127,(a2)+ Full group size move.b d2,(a2)+ Pattern subi.l #128,d5 bne.s do_lots * * One byte is left over, treat it specially as a literal * odd_one subq.l #1,a4 Move back over the odd one bra.s group1 * * Pack the last group of D5+1 bytes into one byte pair * in_one neg.l d5 move.b d5,(a2)+ move.b d2,(a2)+ * * D1 is first mismatch and D3 points past the last byte encoded * group0 cmp.l a4,d3 Have we finished yet? beq.s last1 group1 move.l a4,d5 subq.l #1,d5 move.b (a4)+,d2 Is this a new run of D1 bytes? cmp.b d1,d2 beq.s next1 Yes, there's no literal group * * D1 (D5) & D2 1(D5) differ from the previous run, up to -1(D5) * scan cmp.l a4,d3 Have we reached the end? beq.s last_n move.b d2,d1 Slide patterns along one byte move.b (a4)+,d2 cmp.b d1,d2 Is this still a literal group? bne.s scan * * D1 & D2, last two bytes scanned, match; (D5)..-2(A4) don't * lea.l -2(a4),a0 The literals stopped here suba.l d5,a0 exg d5,a0 A0 -> First, D5 is >0 count bsr.s litpack move.l a0,d5 Remember where we got to bra.s next1 * * Process any last group left at the end of the input data * group_n exg a4,d5 D5 -> Last, A4 -> First sub.l a4,d5 D5 := run length, >0 lastset cmp.l #128,d5 bls.s nearly D5 <= 128 if C or Z flagged move.b #-127,(a2)+ move.b d2,(a2)+ 128 of these, please subi.l #128,d5 bra.s lastset * nearly subq.l #1,d5 Adjust copy count to 0..127 neg.l d5 Make negative control code move.b d5,(a2)+ move.b d2,(a2)+ bra.s count * * Process one or more literal bytes at the end of the input * last1 clr.b (a2)+ One lonely literal left over move.b d1,(a2)+ bra.s count * last_n movea.l d5,a0 Where did we reach, earlier? suba.l a0,a4 Where are we now? move.l a4,d5 Work out count of bytes left pea.l count Return to COUNT from LITPACK * * Subroutine to copy any number of literals to output buffer * litpack cmp.l #128,d5 Will it fit in one group? bls.s out_one * * Copy a 128 byte group of literals, relatively quickly * move.b #127,(a2)+ moveq #31,d1 DBRA count, (128 DIV 4) - 1 move128 move.b (a0)+,(a2)+ move.b (a0)+,(a2)+ Move several bytes each time move.b (a0)+,(a2)+ move.b (a0)+,(a2)+ dbra d1,move128 Keep on moving sub.l #128,d5 bra.s litpack * out_one subq.l #1,d5 D5 := 0 to 127 move.b d5,(a2)+ move_n move.b (a0)+,(a2)+ Copy the remaining literals dbra d5,move_n rts * * PACKBITS expansion; literal sequence copier * literal move.b (a4)+,(a2)+ Copy a literal byte subq.l #1,d2 One less to do beq.s run_out subq.b #1,d0 Count down literals bpl.s literal Self-limiting at 128 * * PACKBITS expansion routine; D2 is 32 bit length, >1 * inflate subq.l #1,d2 We need >1 byte left beq.s abrupt * bloater move.b (a4)+,d0 Get a control byte bpl.s literal neg.b d0 Convert negative count bmi.s bloater Skip a 'filler' 128 byte ext.w d0 move.b (a4)+,d1 Get the byte to repeat repeat move.b d1,(a2)+ Store one copy dbra d0,repeat Tight loop suits 68010+ subq.l #1,d2 Any more? bne.s inflate bra.s count * abrupt moveq #-10,d0 Unexpected END OF FILE rts * run_out tst.b d0 Check the control count bne.s abrupt There should be none left count move.l a2,d3 Point at the end * * Return (D3 - D6.L) to SuperBASIC as a floating-point value * result sub.l d6,d3 Where did we start? move.w d3,d4 D4 will be the exponent move.l d3,d5 D5 will be the mantissa beq.s normal Zero is a trivial case move.w #2079,d4 First guess at the exponent add.l d3,d3 Already normalised? bvs.s normal If so, no need for shift work subq.w #1,d4 Otherwise halve exponent weight move.l d3,d5 Double mantissa to match moveq #16,d0 Try a 16 bit shift first * shifter move.l d5,d1 Take copy of mantissa asl.l d0,d1 Shift mantissa D0 places bvs.s too_far Overflow; must shift less sub.w d0,d4 Correct exponent for shift move.l d1,d5 New mantissa is more normal too_far asr.w #1,d0 Halve shift distance bne.s shifter Try shifts of 8, 4, 2 and 1 * normal addq.l #6,a1 Free 6 of the 12 stack bytes move.l a1,$58(a6) Set BV.RIP for 6 byte result move.l d5,2(a1,a6.l) Stack mantissa move.w d4,0(a1,a6.l) Stack exponent moveq #2,d4 Floating point result code moveq #0,d0 rts * define dc.w 0 No procedures dc.w 0 dc.w 2 Two functions dc.w squash-* dc.b 8,'COMPRESS' even dc.w expand-* dc.b 6,'EXPAND' even dc.w 0 * end