Bload Compressor/5

 BBS: Inland Empire Archive
Date: 12-28-92 (06:12)             Number: 357
From: RICH GELDREICH               Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Bload Compressor/5             Conf: (2) Quik_Bas

'Page 5 of ENCODE13.BAS begins here.
SUB InitLZ77
    FOR a = 0 TO (BufferSize + 1 + HashSize) - 1
        NextCell(a) = Null: LastCell(a) = Null
    NEXT
END SUB

'Initializes the ring buffer.
SUB InitRingBuffer
    FOR a = 0 TO BufferSize - MaxMatch - 1: RingBuffer(a) = 0: NEXT
END SUB

'Stores the string at R into its linked list without scanning for a
'match.
SUB MakeString (BYVAL R)
    LinkHead = (BufferSize + 1) + ((RingBuffer(R) * 14096& XOR _
RingBuffer(R + 1) * 77 XOR RingBuffer(R + 2)) MOD HashSize)
    a = NextCell(LinkHead): NextCell(LinkHead) = R: LastCell(a) = R
    LastCell(R) = LinkHead: NextCell(R) = a
END SUB

'Stores an uncompressed character and its flag to the output code
'buffer.
SUB OutputChar (BYVAL a)
    OrMask = OrMask * 2 'send a binary 0
    CodeBuffer(CodePointer) = a     'store the character
    CodeCounter = CodeCounter + 1
    IF CodeCounter = 16 THEN        'if 16 codes the write 'em out
        'write the bit flags
        WriteByte BitAccum AND 255: WriteByte BitAccum \ 256
        'write the codes
        FOR a = 0 TO CodePointer: WriteByte CodeBuffer(a): NEXT
        CodePointer = 0: CodeCounter = 0: OrMask = 1: BitAccum = 0
    ELSE
        CodePointer = CodePointer + 1
    END IF
END SUB

'Writes an EOF code to the output code buffer
SUB OutputEOF
    BitAccum = BitAccum OR OrMask
    CodeBuffer(CodePointer) = 15
    CodeBuffer(CodePointer + 1) = 0: CodeBuffer(CodePointer + 2) = 255
    WriteByte BitAccum AND 255: WriteByte BitAccum \ 256
    FOR a = 0 TO CodePointer + 2: WriteByte CodeBuffer(a): NEXT
END SUB

'Outputs a match and its flag to the output code buffer.
SUB OutputMatch
    BitAccum = BitAccum OR OrMask: OrMask = OrMask * 2
    'Favor short matches(3-17 characters).
    IF Match.Length < 18 THEN
        CodeBuffer(CodePointer) = (Match.Length - (Threshold + 1)) OR _
(Match.Distance AND &HF) * 16
        CodeBuffer(CodePointer + 1) = Match.Distance \ 16
        CodePointer = CodePointer + 2
    ELSE
        CodeBuffer(CodePointer) = 15 OR (Match.Distance AND &HF) * 16
        CodeBuffer(CodePointer + 1) = Match.Distance \ 16
        CodeBuffer(CodePointer + 2) = Match.Length - 18
        CodePointer = CodePointer + 3
    END IF
    CodeCounter = CodeCounter + 1
    IF CodeCounter = 16 THEN
        WriteByte BitAccum AND 255: WriteByte BitAccum \ 256
        FOR a = 0 TO CodePointer - 1: WriteByte CodeBuffer(a): NEXT
        CodePointer = 0: CodeCounter = 0: OrMask = 1: BitAccum = 0
    END IF
END SUB

'Stores one byte into the disk output buffer, and flushes it when it
'is full.
SUB WriteByte (BYVAL a)
    MID$(IOBuffer$, IOPointer, 1) = CHR$(a)
    IOPointer = IOPointer + 1
    IF IOPointer = 4097 THEN 'if buffer full then flush
        PUT #1, , IOBuffer$: IOPointer = 1
    END IF
END SUB

'Flushes the disk output buffer.
SUB WriteFlush
    IOBuffer$ = LEFT$(IOBuffer$, IOPointer - 1): PUT #1, , IOBuffer$
END SUB

The source and OBJ for the assembly decompressor follows.

--- MsgToss 2.0b
 * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)