Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ZIP2OBJ.ZIP/XZIP.PAS

Pascal/Delphi Source File | 1991-11-12 | 12.3 KB | 552 lines

{ XZIP.PAS - Explode data to memory routine (c) Wilbert van Leijen, 1991 }

Unit XZip;

Interface

Procedure Explode(Var InBuffer, OutBuffer; CompressedSize : Word);

Implementation

{$S-
   USAGE NOTES:
     -  Do not call Explode direct.  It is called by an linked in .OBJ
        file, generated by ZIP2OBJ.
     -  Maximum size of the uncompressed image is 64 kB
     -  Memory requirements:  3k data, 10 k stack                       }

Const
  MaxDictSize  = 8192;
  BufSize      = 65520;                { Size of buffers for I/O }
  MaxSFTreeSize = (1 shl 9)-1;
  LitTreeRoot  = (1 shl 9)-1;
  DistTreeRoot = (1 shl 7)-1;
  LenTreeRoot  = (1 shl 7)-1;
  CodeValue    : Array[1..8] of Byte = (
    $01, $03, $07, $0F, $1F, $3F, $7F, $FF);

Type
  BufType      = Array[0..BufSize] of Byte;
  SFNode       = Record
                   lChild        : Integer;
                   rChild        : Integer;
                 end;
  SFBuildRec   = Record
                   Len, Val    : Byte;
                   Code        : Word;
                 end;
  SFBuildArray = Array[0..255] of SFBuildRec;

Var
  SFLiteral    : Array[0..LitTreeRoot] of SFNode;
  SFDist       : Array[0..DistTreeRoot] of SFNode;
  SFLength     : Array[0..LenTreeRoot] of SFNode;
  InfileBuf    : ^BufType;
  DictSize     : Integer;
  InBufPtr,
  SFNextFree   : Word;
  BitsLeft,                            { Unprocessed bits in input code buffer }
  SaveByte,                            { Input code buffer - 1 byte long }
  SFBuildIdx,                          { Index var for SFBuild array }
  NumOfTrees   : Byte;                 { SF trees needed (2 or 3) }

Const
  SFTreeRec    : Array[0..2] of Pointer = (
                   @SFLiteral, @SFLength, @SFDist);
  SFFreeRoot   : Array[0..2] of Word = (
                   LitTreeRoot, LenTreeRoot, DistTreeRoot);

Function GetCode : Byte; Assembler;

ASM
        PUSH   BX
        PUSH   CX
        PUSH   DX
        MOV    DH, AL
        MOV    AH, [BitsLeft]
        MOV    DL, DH
        XOR    CH, CH
        XOR    BH, BH

@1:     CMP    DL, AH
        JB     @2

        MOV    BL, AH
        JMP    @3

@2:     MOV    BL, DL
@3:     MOV    CL, DH
        SUB    CL, DL
        MOV    AL, Byte Ptr [BX+CodeValue-1]
        AND    AL, [SaveByte]
        SHL    AL, CL
        OR     CH, AL
        MOV    CL, BL
        SHR    [SaveByte], CL
        SUB    DL, BL
        SUB    AH, BL
        OR     AH, AH
        JNE    @4

        LES    DI, [InfileBuf]
        ADD    DI, [InBufPtr]
        MOV    AL, ES:[DI]
        MOV    [SaveByte], AL
        INC    [InBufPtr]
        MOV    AH, 8

@4:     OR     DL, DL
        JNZ    @1

        MOV    [BitsLeft], AH
        MOV    AL, CH
        POP    DX
        POP    CX
        POP    BX
end;  { GetCode }

Procedure AddSFSubTree(SFB : SFBuildRec; SFRoot : Word; Var SFTree);
  Assembler;

ASM
        MOV    DI, [SFNextFree]
        PUSH   DS
        PUSH   BX
        PUSH   CX
        PUSH   DX
        MOV    BX, SFRoot
        MOV    CL, SFB.Len
        XOR    CH, CH
        DEC    CX

@1:     JCXZ   @6
        LDS    SI, SFTree
        SHL    BX, 1
        SHL    BX, 1
        ADD    SI, BX
        MOV    AX, SFB.Code
        SHR    AX, CL
        TEST   AX, 1
        JZ     @3

        CMP    [SI+SFNode.rChild], -1
        JNE    @2
        MOV    [SI+SFNode.rChild], DI
        DEC    DI

@2:     MOV    BX, [SI+SFNode.rChild]
        JMP    @5

@3:     CMP    [SI+SFNode.lChild], -1
        JNE    @4

        MOV    [SI.SFNode.lChild], DI
        DEC    DI

@4:     MOV    BX, [SI+SFNode.lChild]
@5:     DEC    CX
        JMP    @1

@6:     LDS    SI, SFTree
        SHL    BX, 1
        SHL    BX, 1
        ADD    SI, BX

        MOV    AL, SFB.Val
        XOR    AH, AH
        TEST   SFB.Code, 1
        JZ     @7

        MOV    [SI+SFNode.rChild], AX
        JMP    @8

@7:     MOV    [SI+SFNode.lChild], AX

@8:     POP    DX
        POP    CX
        POP    BX
        POP    DS
        MOV    [SFNextFree], DI
end;  { AddSFSubTree }

Procedure ShellSort(Var SFB; n : Integer); Assembler;

Var
  gap          : Integer;

ASM
        PUSH   DS
        PUSH   BX
        LDS    DI, SFB
        MOV    AX, n
        SHR    AX, 1
        MOV    gap, AX

@1:     CMP    gap, 0
        JNG    @8

        MOV    DX, gap
        INC    DX

@2:     MOV    AX, DX
        SUB    AX, gap
        MOV    CX, AX

@3:     CMP    CX, 0
        JNG    @7

        MOV    SI, CX
        ADD    SI, gap
        MOV    BX, CX
        DEC    BX
        SHL    BX, 1
        SHL    BX, 1
        ADD    BX, DI
        DEC    SI
        SHL    SI, 1
        SHL    SI, 1
        ADD    SI, DI
        MOV    AL, [BX+SFBuildRec.Len]
        CMP    AL, [SI+SFBuildRec.Len]
        JA     @5
        MOV    AL, [BX+SFBuildRec.Len]
        CMP    AL, [SI+SFBuildRec.Len]
        JNE    @4
        MOV    AL, [BX+SFBuildRec.Val]
        CMP    AL, [SI+SFBuildRec.Val]
        JA     @5

@4:     XOR    CX, CX
        JMP    @6

@5:     MOV    AX, [BX]
        PUSH   AX
        MOV    AX, [SI]
        MOV    [BX], AX
        POP    AX
        MOV    [SI], AX

@6:     MOV    AX, gap
        SUB    CX, AX
        JMP    @3

@7:     INC    DX
        CMP    DX, n
        JBE    @2

        MOV    AX, gap
        SHR    AX, 1
        MOV    gap, AX
        JMP    @1

@8:     POP    BX
        POP    DS
end;  { ShellSort }

Procedure BuildSFTree(WhichTree : Byte; Var SFBuild : SFBuildArray);
  Assembler;

Var
  Code         : Word;

ASM
        CMP     [NumOfTrees], 2
        JNE     @1
        INC     WhichTree

@1:     MOV     AL, WhichTree
        XOR     AH, AH
        MOV     DI, AX
        SHL     DI, 1
        MOV     AX, Word Ptr [DI+SFFreeRoot]
        DEC     AX
        MOV     [SFNextFree], AX
        XOR     BL, BL
        MOV     AL, 8
        CALL    GetCode
        MOV     BH, AL
        XOR     CH, CH

@3:     MOV     AL, 8
        CALL    GetCode
        MOV     DL, AL
        AND     AL, 15
        INC     AL
        MOV     DH, AL
        MOV     CL, 4
        SHR     DL, CL
        XOR     CL, CL

@2:     MOV     AL, BL
        XOR     AH, AH
        SHL     AX, 1
        SHL     AX, 1
        LES     DI, SFBuild
        ADD     DI, AX
        MOV     ES:[DI+SFBuildRec.Len], DH
        MOV     ES:[DI+SFBuildRec.Val], BL
        INC     BL
        INC     CL
        CMP     DL, CL
        JNB     @2

        INC     CH
        CMP     CH, BH
        JBE     @3

        LES     DI, SFBuild
        PUSH    ES
        PUSH    DI
        MOV     AL, BL
        DEC     AL
        XOR     AH, AH
        INC     AX
        PUSH    AX
        CALL    ShellSort
        XOR     AX, AX
        MOV     Code, AX
        XOR     CH, CH
        XOR     DX, DX
        DEC     BL
        XOR     BH, BH
        OR      BX, BX
        JB      @5
        JMP     @6

@8:     DEC     BX

@6:     ADD     Code, DX
        MOV     AX, BX
        SHL     AX, 1
        SHL     AX, 1
        LES     DI, SFBuild
        ADD     DI, AX
        MOV     AL, ES:[DI+SFBuildRec.Len]
        CMP     AL, CH
        JE      @7
        MOV     CH, ES:[DI+SFBuildRec.Len]
        MOV     CL, 16
        SUB     CL, CH
        MOV     DX, 1
        SHL     DX, CL

@7:     MOV     CL, 16
        SUB     CL, ES:[DI+SFBuildRec.Len]
        MOV     AX, Code
        SHR     AX, CL
        MOV     ES:[DI+SFBuildRec.Code], AX
        PUSH    Word Ptr ES:[DI+SFBuildRec.Code]
        PUSH    Word Ptr ES:[DI+SFBuildRec.Len]
        MOV     AL, WhichTree
        XOR     AH, AH
        MOV     DI, AX
        SHL     DI, 1
        PUSH    Word Ptr [DI+SFFreeRoot]
        SHL     DI, 1
        LES     DI, DWord Ptr [DI+SFTreeRec]
        PUSH    ES
        PUSH    DI
        CALL    AddSFSubTree
        OR      BX, BX
        JNZ     @8
@5:
end;  { BuildSFTree }

Function DecodeSFData : Byte; Assembler;

ASM
        PUSH   BX
        PUSH   CX
        PUSH   DX
        MOV    CX, AX
        INC    AX
        SHR    AX, 1
        DEC    AX
        MOV    DX, AX

@1:     MOV    AL, 1
        CALL   GetCode
        MOV    DI, SI

        MOV    BX, CX
        SHL    BX, 1
        SHL    BX, 1
        ADD    DI, BX
        TEST   AL, 1
        JZ     @2

        INC    DI
        INC    DI
@2:     MOV    CX, [DI]
        CMP    CX, DX
        JA     @1

        XCHG   AX, CX
        POP    DX
        POP    CX
        POP    BX
end;  { DecodeSFData }

Procedure Explode(Var InBuffer, OutBuffer; CompressedSize : Word);
  Assembler;

Var
  Dictionary   : Array[0..MaxDictSize-1] of Byte;
  SFBuild      : SFBuildArray;

ASM
        DEC    CompressedSize
        MOV    [InBufPtr], 1
        LES    DI, InBuffer
        MOV    Word Ptr [InfileBuf], DI
        MOV    Word Ptr [InfileBuf+2], ES
        MOV    AL, ES:[DI]
        MOV    [SaveByte], AL
        MOV    [BitsLeft], 8
        MOV    AX, ES:[DI-2]
        MOV    CX, 4096
        TEST   AX, 2
        JZ     @1
        SHL    CX, 1

@1:     DEC    CX
        MOV    [DictSize], CX
        MOV    CL, 2
        TEST   AX, 4
        JZ     @2
        INC    CL

@2:     MOV    [NumOfTrees], CL
        CLD
        XOR    AX, AX
        PUSH   SS
        POP    ES
        LEA    DI, Word Ptr Dictionary
        MOV    CX, (MaxDictSize / 2)
        REP    STOSW
        DEC    AX
        PUSH   DS
        POP    ES
        MOV    DI, Offset SFLength
        MOV    CX, 2*(LenTreeRoot+1)
        REP    STOSW
        MOV    DI, Offset SFDist
        MOV    CX, 2*(DistTreeRoot+1)
        REP    STOSW
        MOV    DI, Offset SFLiteral
        MOV    CX, 2*(LitTreeRoot+1)
        REP    STOSW

        XOR    AX, AX
        LEA    DI, SFBuild
        PUSH   AX
        PUSH   SS
        PUSH   DI
        CALL   BuildSFTree
        MOV    AL, 1
        LEA    DI, SFBuild
        PUSH   AX
        PUSH   SS
        PUSH   DI
        CALL   BuildSFTree
        CMP    [NumOfTrees], 3
        JNE    @3
        MOV    AL, 2
        LEA    DI, SFBuild
        PUSH   AX
        PUSH   SS
        PUSH   DI
        CALL   BuildSFTree

@3:     XOR    BX, BX
        XOR    DX, DX
@4:     MOV    AL, 1
        CALL   GetCode
        OR     AL, AL
        JZ     @7

        CMP    [NumOfTrees], 3
        JNE    @5

        MOV    SI, Offset SFLiteral
        MOV    AX, LitTreeRoot
        CALL   DecodeSFData
        JMP    @6

@5:     MOV    AL, 8
        CALL   GetCode

@6:     LES    DI, OutBuffer
        ADD    DI, DX
        STOSB
        INC    DX
        MOV    SI, BX
        MOV    Byte Ptr [SI+Dictionary], AL
        INC    BX
        AND    BX, [DictSize]
        JMP    @11

@7:     MOV    CX, 6
        CMP    [NumOfTrees], 3
        JNE    @8

        INC    CX
@8:     MOV    AL, CL
        CALL   GetCode
        XOR    AH, AH
        PUSH   AX
        MOV    SI, Offset SFDist
        MOV    AX, DistTreeRoot
        CALL   DecodeSFData
        XOR    AH, AH
        SHL    AX, CL
        POP    CX
        OR     AX, CX
        PUSH   AX
        MOV    SI, Offset SFLength
        MOV    AX, LenTreeRoot
        CALL   DecodeSFData
        XOR    AH, AH
        MOV    CX, AX
        CMP    CX, 63
        JNE    @9

        MOV    AL, 8
        CALL   GetCode
        XOR    AH, AH
        ADD    CX, AX

@9:     MOV    AL, [NumOfTrees]
        XOR    AH, AH
        ADD    CX, AX
        POP    AX
        MOV    SI, BX
        SUB    SI, AX
        DEC    SI
        CMP    SI, 0
        JGE    @10

        ADD    SI, [DictSize]
        INC    SI

@10:    MOV    AL, Byte Ptr [SI+Dictionary]
        LES    DI, OutBuffer
        ADD    DI, DX
        STOSB
        INC    DX
        MOV    DI, BX
        MOV    Byte Ptr [DI+Dictionary], AL
        INC    BX
        AND    BX, [DictSize]
        INC    SI
        AND    SI, [DictSize]
        DEC    CX
        OR     CX, CX
        JNZ    @10

@11:    MOV    AX, [InBufPtr]
        CMP    AX, CompressedSize
        JBE    @4
end;  { Explode }

end.  { XZip }