{$AlignCode+,AlignData+,AlignRec+,B-,Cdecl-,D+,Delphi-,Frame+,G3+,I+}
{$L+,Optimize+,OrgName-,P-,Q-,R-,Speed+,T-,V-,X+,ZD-,Use32+}

Unit UnPack;

Interface

Type
  BufferType    = Array[0..MaxLongInt-1] of Byte;
  pBuffer       = ^BufferType;
  IOFunc        = Function(Addr : Pointer; Count : Word ) : Integer;

Procedure MakeTbl;
Procedure CreateEncTbl( UnpMem : Pointer );
Function DoUnPack( UnpMem : pBuffer; UnpRead, UnpWrite : IOFunc; Solid : Boolean ) : Integer;

Type
  Words255 = Array[0..255] of Word;
  SmallWords255 = Array[0..255] of SmallWord;
  SmallWords    = Array[0..MaxLongInt div Sizeof( SmallWord ) ] of SmallWord;
  pSmallWords255 = ^SmallWords255;
  pSmallWords   = ^SmallWords;
  pWords255 = ^Words255;
  Bytes255 = Array[0..255] of Byte;
  pBytes255 = ^Bytes255;
  MakeHuffTabs = Record
    Table         : Pointer;
    HuffCodeCount : Array[0..11] of Byte;
  end;

  UnpData = Record
    ChSet       : Array[0..255] of SmallWord;
    Place       : Array[0..255] of Byte;
    NToPl       : Words255;

    ChSetA      : Array[0..255] of Byte;
    PlaceA      : Array[0..255] of Byte;

    ChSetB      : Array[0..255] of SmallWord;
    PlaceB      : Array[0..255] of Byte;
    NToPlB      : Words255;

    ChSetC      : Array[0..255] of SmallWord;
    PlaceC      : Array[0..255] of Byte;
    NToPlC      : Words255;

    AvrPlc      : SmallWord;
    AvrPlcB     : SmallWord;
    AvrLn1      : SmallWord;
    AvrLn2      : SmallWord;
    AvrLn3      : SmallWord;

    NumHuf      : Word;
    StMode      : Boolean;

    Nhfb        : Word;
    Nlzb        : Word;

    MaxDist3    : Word;
    Buf60       : Word;
    WrAddr      : Word;
    SomeRd      : Word;
    UnpAllBuf   : Word;

    LastDist    : Word;
    LastLen     : Word;
    OldDist     : Array[0..3] of Word;
    OldDistNum  : Word;
  end;

  DecodeTables = Record
    ECDSH1      : Array[0..255] of Byte;
    ECDSH2      : Array[0..255] of Byte;
    ECDSH3      : Array[0..255] of Byte;
    ECDSH4      : Array[0..255] of Byte;

    ECDLN0      : Array[0..255] of Byte;
    ECDLN1      : Array[0..4095] of Byte;
    ECDLN2      : Array[0..4095] of Byte;
    ECODE0      : Array[0..4095] of Byte;
    ECODE1      : Array[0..4095] of Byte;
    ECODE2      : Array[0..1023] of Byte;
    ECODE3      : Array[0..1023] of Byte;
    ECODE4      : Array[0..1023] of Byte;
    NCDSH1      : Array[0..15] of Byte;
    NCDSH2      : Array[0..15] of Byte;
    NCDSH3      : Array[0..15] of Byte;
    NCDSH4      : Array[0..15] of Byte;
    NCDLN0      : Array[0..255] of Byte;
    NCDLN1      : Array[0..255] of Byte;
    NCDLN2      : Array[0..255] of Byte;
    NCODE0      : Array[0..256] of Byte;
    NCODE1      : Array[0..256] of Byte;
    NCODE2      : Array[0..256] of Byte;
    NCODE3      : Array[0..256] of Byte;
    NCODE4      : Array[0..256] of Byte;
  end;

  Words258 = Array[0..257] of Word;
  Small258Words = Array[0..257] of SmallWord;
  SmallWords10  = Array[0..9] of SmallWord;
  SmallWords15  = Array[0..14] of SmallWord;
  SmallWords16  = Array[0..15] of SmallWord;

Var
  hcdln1 : Small258Words;
  hcdln2 : Small258Words;
  hcode0 : Small258Words;
  hcode1 : Small258Words;
  hcode2 : Small258Words;
  hcode3 : Small258Words;
  hcode4 : Small258Words;

  FlagBuf : Byte;
  InAdr,OutAdr : Word;
  NumBit : Word;
  LCount : Word; { 1 }
  FlagsCnt : Integer;
  UnpBuf : pBuffer;
  PackBuf : pBuffer;
  UnpReadFn : IOFunc;
  UnpWriteFn : IOFunc;
  D : ^UnpData;
  T : ^DecodeTables;

Const
  DestUnpSize : LongInt = 0;
  Suspend : Boolean = False;

Const
 MakeTab : Array[1..7] of MakeHuffTabs =
 ( (Table : @hcdln1;
    HuffCodeCount: ( 0  ,2  ,1  ,2  ,2  ,4   ,5   ,4   ,4   ,8   ,0   ,224 )),
   (Table : @hcdln2;
    HuffCodeCount: ( 0  ,0  ,5  ,2  ,2  ,4   ,5   ,4   ,4   ,8   ,2   ,220 )),
   (Table : @hcode0;
    HuffCodeCount: ( 0  ,0  ,0  ,8  ,8  ,8   ,9   ,0   ,0   ,0   ,0   ,224 )),
   (Table : @hcode1;
    HuffCodeCount: ( 0  ,0  ,0  ,0  ,4  ,40  ,16  ,16  ,4   ,0   ,47  ,130 )),
   (Table : @hcode2;
    HuffCodeCount: ( 0  ,0  ,0  ,0  ,2  ,5   ,46  ,64  ,116 ,24  ,0   ,0   )),
   (Table : @hcode3;
    HuffCodeCount: ( 0  ,0  ,0  ,0  ,0  ,2   ,14  ,202 ,33  ,6   ,0   ,0   )),
   (Table : @hcode4;
    HuffCodeCount: ( 0  ,0  ,0  ,0  ,0  ,0   ,0   ,255 ,2   ,0   ,0   ,0   )));

  hcdsh1 : SmallWords15
         = ( $0001,$a003,$d004,$e004,$f005,$f806,$fc07,$fe08,
             $ff08,$c004,$8004,$9005,$9806,$9c06,0 );

  hcdsh2 : SmallWords15
         = ( $0002,$4003,$6003,$a003,$d004,$e004,$f005,$f806,
             $fc06,$c004,$8004,$9005,$9806,$9c06,0 );

  hcdsh3 : SmallWords16
         = ( $0001,$a004,$d004,$e004,$f005,$f806,$fc07,$fe08,
             $ff08,$c004,$8004,$9005,$9806,$9c06,$b004,0 );

  hcdsh4 : SmallWords16
         = ( $0002,$4003,$6003,$a004,$d004,$e004,$f005,$f806,
             $fc06,$c004,$8004,$9005,$9806,$9c06,$b004,0 );

  hcdln0 : SmallWords10
         = ( $8001,$4002,$2003,$1004,$0805,$0406,$0207,$0108,
             $0008,0 );

  _Suspend    = 1;
  Size_pBuf  = $2000;
  First      = 1;
  Next       = 2;

  Unp_Memory = $10010 + Sizeof( UnpData ) + Sizeof( DecodeTables ) + Size_PBuf;

Implementation

{#define GetField() ((UWORD)((((UDWORD)PackBuf[InAdr] shl 16) |         \
                   ((UWORD)PackBuf[InAdr+1] shl 8) | PackBuf[InAdr+2]) \
                    >> (8-NumBit)))}

{$FRAME-} {$USES None}
Function GetField : SmallWord; assembler;
asm
  mov   ecx,InAdr
  mov   edx,PackBuf
  mov   eax,[edx+ecx]

 {$IFOPT G3+}
  xchg    al,ah
  rol     eax,16
  xchg    al,ah
 {$ELSE}
  bswap   eax             { 486 & Pentium only }
 {$ENDIF}

  mov   ecx,16
  sub   ecx,numbit
  shr   eax,cl
end;

Procedure AddBit( NBits : Word ); inline;
begin
  Inc( InAdr, (NumBit+NBits) shr 3 );
  InAdr := SmallWord( InAdr );
  NumBit := (NumBit+NBits) and 7;
end;

Function Min( a,b : Word ) : Word; inline;
begin
  If a < b then
    Min := a
  else
    Min := b;
end;

Procedure CopyString( Distance : Word; Length : Word );
begin
  Dec( DestUnpSize, Length );
  while Length > 0 do
    begin
      Dec( Length );
      UnpBuf^[OutAdr] := UnpBuf^[ SmallWord( OutAdr-Distance ) ];
      Inc( OutAdr );
      OutAdr := SmallWord(OutAdr);
    end;
end;

Procedure UnpInitData(Solid : Boolean);
begin
  if not Solid then
  begin
    FillChar( D^, sizeof(D^), 0 );
    D^.AvrPlc := $3500;
    D^.MaxDist3 := $2001;
    D^.Nhfb := $80;
    D^.Nlzb := $80;
  end;
  FlagsCnt := 0;
  FlagBuf := 0;
  InAdr := 0;
  NumBit := 0;
  D^.StMode := False;
  LCount := 0;
end;

Procedure CorrHuff(CharSet : pSmallWords255;NumToPlace : pWords255);
Var
  i, j : Integer;
begin
  for i := 7 downto 0 do
    for j := 0 to 31 do
      begin
        pSmallWord(CharSet)^ := (pSmallWord(CharSet)^ and not $FF ) or I;
        Inc( Word( CharSet ), 2 );
      end;
  FillChar( NumToPlace^, sizeof(D^.NToPl), 0 );
  for i := 6 downto 0 do
    NumToPlace^[I] := (7-I)*32;
end;

Procedure InitHuff;
Var
  i : Word;
begin
  for i := 0 to 255 do
    With D^ do
      begin
        Place[I]  := byte(I);
        PlaceA[I] := byte(I);
        PlaceB[I] := byte(I);
        PlaceC[I] := byte(not I+1);
        ChSet[I]  := SmallWord( I shl 8 );
        ChSetB[I] := SmallWord( I shl 8 );
        ChSetA[I] := byte(I);
        ChSetC[I] := SmallWord( (not I+1) shl 8 );
      end;
  FillChar( D^.NToPl,  sizeof(D^.NToPl), 0 );
  FillChar( D^.NToPlB, sizeof(D^.NToPlB), 0 );
  FillChar( D^.NToPlC, sizeof(D^.NToPlC), 0 );
  CorrHuff(@D^.ChSetB,@D^.NToPlB);
end;

Function UnpReadBuf( NumBuf : Integer ) : Integer;
Var
  ReadCode : Integer;
begin
  if (NumBuf = FIRST) then
    ReadCode := UnpReadFn( PackBuf, SIZE_PBUF )
  else
    begin
      Move(Ptr(Word(PackBuf)+InAdr)^, PackBuf^, SIZE_PBUF-InAdr);
      ReadCode := UnpReadFn( Ptr(Word(PackBuf)+SIZE_PBUF-InAdr),InAdr);
    end;
  InAdr := 0;
  if (ReadCode = -1) then
    UnpReadBuf := -1
  else
    UnpReadBuf := 0;
end;

Procedure GetFlagsBuf;
Var
  Flags : SmallWord;
  FlagsPlace,NewFlagsPlace : Word;

begin
  FlagsPlace := T^.ECODE2[GetField shr 6];
  AddBit(T^.NCODE2[FlagsPlace]);

  while true do
    begin
      Flags := D^.ChSetC[FlagsPlace];
      FlagBuf := Flags shr 8;
      NewFlagsPlace := D^.NToPlC[Flags AND $ff];
      Inc( D^.NToPlC[Flags AND $ff] );
      Inc( Flags );
      if ((Flags AND $ff)  =  0) then
        begin
          Dec( Flags, $100 ); //??? remove line???
          CorrHuff( @D^.ChSetC, @D^.NToPlC );
        end
      else
        break;
    end;

  D^.ChSetC[FlagsPlace] := D^.ChSetC[NewFlagsPlace];
  D^.ChSetC[NewFlagsPlace] := Flags;
end;

Function UnpWriteBuf : Integer;
begin
  if (OutAdr<D^.WrAddr) then
    begin
      if ( UnpWriteFn( Ptr(Word(UnpBuf)+D^.WrAddr),SmallWord(-D^.WrAddr)) = -1 ) or
         ( UnpWriteFn( UnpBuf, OutAdr) = -1 ) then
        begin
          UnpWriteBuf := -1;
          Exit;
        end;
    end
  else
    if (UnpWriteFn( Ptr(Word(UnpBuf)+D^.WrAddr), OutAdr-D^.WrAddr) = -1) then
      begin
        UnpWriteBuf := -1;
        Exit;
      end;

  D^.WrAddr := OutAdr;
  UnpWriteBuf := 0;
end;

Procedure HuffDecode;
Var
  CurByte,BytePlace,NewBytePlace : SmallWord;
  Length,Distance,Code : SmallWord;

begin
  Code := GetField;

  if (D^.AvrPlc > $75ff) then
    begin
      BytePlace := T^.ECODE4[Code shr 6];
      if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
        BytePlace := $100;
      AddBit( T^.NCODE4[BytePlace] );
    end
  else
    if (D^.AvrPlc > $5dff) then
      begin
        BytePlace := T^.ECODE3[Code shr 6];
        if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
          BytePlace := $100;
        AddBit(T^.NCODE3[BytePlace]);
      end
    else
      if (D^.AvrPlc > $35ff) then
        begin
          BytePlace := T^.ECODE2[Code shr 6];
          if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
            BytePlace := $100;
          AddBit(T^.NCODE2[BytePlace]);
        end
      else
        if (D^.AvrPlc > $0dff) then
          begin
            BytePlace := T^.ECODE1[Code shr 4];
            if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
              BytePlace := $100;
            AddBit(T^.NCODE1[BytePlace]);
          end
        else
          begin
            BytePlace := T^.ECODE0[Code shr 4];
            if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
              BytePlace := $100;
            AddBit(T^.NCODE0[BytePlace]);
          end;

  if D^.StMode then
    begin
      Dec( BytePlace );
      if (BytePlace = $FFFF) then
        begin
          Code := GetField;
          AddBit(1);
          if (Code >= $8000) then
            begin
              D^.NumHuf := 0;
              D^.StMode := False;
              exit;
            end
          else
            begin
              If (Code AND $4000) <> 0 then
                Length := 4
              else
                Length := 3;
              Distance := T^.ECODE2[(Code shr 4) AND $3ff];
              AddBit(T^.NCODE2[Distance]+1);
              Distance := (Distance shl 5) OR (GetField shr 11);
              AddBit(5);
              CopyString(Distance,Length);
              exit;
            end
        end
    end
  else
    begin
      if (D^.NumHuf >= 16 ) and ( FlagsCnt = 0 ) then
        D^.StMode := True;
      Inc( D^.NumHuf );
    end;
  Inc( D^.AvrPlc, BytePlace );
  Dec( D^.AvrPlc, D^.AvrPlc shr 8 );
  Inc( D^.Nhfb, 16 );
  if (D^.Nhfb > $ff) then
    begin
      D^.Nhfb := $90;
      D^.Nlzb := D^.Nlzb shr 1;
    end;

  UnpBuf^[ OutAdr ] := D^.ChSet[BytePlace] shr 8;
  Inc( OutAdr );
  OutAdr := SmallWord( OutAdr );
  Dec( DestUnpSize );

  while true do
    begin
      CurByte := D^.ChSet[BytePlace];
      NewBytePlace := D^.NToPl[CurByte AND $ff];
      Inc( D^.NToPl[CurByte AND $ff] );
      Inc( CurByte );
      if ((CurByte AND $ff) > $a1) then
        CorrHuff(@D^.ChSet,@D^.NToPl)
      else
        break;
    end;

  D^.ChSet[BytePlace] := D^.ChSet[NewBytePlace];
  D^.ChSet[NewBytePlace] := CurByte;
end;

procedure LongLZ;
Var
  LengthCode,Length : SmallWord;
  Distance,DistancePlace,NewDistancePlace : SmallWord;
  oldav2,oldav3 : SmallWord;

begin
  D^.NumHuf := 0;
  Inc( D^.Nlzb, 16 );
  if (D^.Nlzb > $ff) then
    begin
      D^.Nlzb := $90;
      D^.Nhfb := D^.Nhfb shr 1;
    end;

  oldav2 := D^.AvrLn2;
  if (D^.AvrLn2 >= 122) then
    begin
      Length := T^.ECDLN2[GetField shr 4];
      AddBit(T^.NCDLN2[Length]);
    end
  else
    if (D^.AvrLn2 >= 64) then
      begin
        Length := T^.ECDLN1[GetField shr 4];
        AddBit(T^.NCDLN1[Length]);
      end
    else
      begin
        LengthCode := GetField;
        if (LengthCode < $100) then
          begin
            Length := LengthCode;
            AddBit(16);
          end
        else
          begin
            //??? Different
            Length := T^.ECDLN0[LengthCode shr 8];
            AddBit(T^.NCDLN0[Length]);
          end
      end;

  Inc( D^.AvrLn2, Length );
  Dec( D^.AvrLn2, D^.AvrLn2 shr 5 );

  if (D^.AvrPlcB > $28ff) then
  begin
    DistancePlace := T^.ECODE2[GetField shr 6];
    AddBit(T^.NCODE2[DistancePlace]);
  end
  else
    if (D^.AvrPlcB > $6ff) then
      begin
        DistancePlace := T^.ECODE1[GetField shr 4];
        AddBit(T^.NCODE1[DistancePlace]);
      end
    else
      begin
        DistancePlace := T^.ECODE0[GetField shr 4];
        AddBit(T^.NCODE0[DistancePlace]);
      end;

  Inc( D^.AvrPlcB, DistancePlace );
  Dec( D^.AvrPlcB, D^.AvrPlcB shr 8 );
  while true do
    begin
      Distance := D^.ChSetB[DistancePlace];
      NewDistancePlace := D^.NToPlB[Distance AND $ff];
      Inc( D^.NToPlB[Distance AND $ff] );
      Inc( Distance );
      if (Distance AND $ff) = 0 then
        begin
          Dec( Distance, $100 );  //??? remove this line ???
          CorrHuff( @D^.ChSetB, @D^.NToPlB );
        end
      else
        break;
    end;

  D^.ChSetB[DistancePlace] := D^.ChSetB[NewDistancePlace];
  D^.ChSetB[NewDistancePlace] := Distance;

  Distance := SmallWord ((Distance AND NOT $ff) OR (GetField shr 8)) shr 1;
  AddBit(7);

  oldav3 := D^.AvrLn3;
  if (Length<>1) and (Length<>4) then
    if (Length = 0) and ( Distance <= D^.MaxDist3 ) then
      begin
        Inc( D^.AvrLn3 );
        Dec( D^.AvrLn3, D^.AvrLn3 shr 8 );
      end
    else
      if (D^.AvrLn3 > 0) then
        Dec( D^.AvrLn3 );

  Inc( Length, 3 );
  if (Distance >= D^.MaxDist3) then
    Inc( Length );
  if (Distance <= 256) then
    Inc( Length, 8 );
  if (oldav3 > $b0 ) or ( D^.AvrPlc >= $2a00 ) and (oldav2 < $40) then
    D^.MaxDist3 := $7f00
  else
    D^.MaxDist3 := $2001;
  D^.OldDist[D^.OldDistNum]:=Distance;
  D^.OldDistNum := ( D^.OldDistNum+1 ) AND 3;
  D^.LastLen := Length;
  D^.LastDist := Distance;
  CopyString(Distance,Length);
end;

Procedure ShortLZ;
Var
  LengthCode,SaveLength : Word;
  LastDistance : Word;
  Distance,DistancePlace,Length : SmallWord;

begin
  LengthCode := GetField; //??? GetBits
  D^.NumHuf  := 0;
  if (LCount=2) then
    begin
      AddBit(1);
      if (LengthCode >= $8000) then
        begin
          CopyString(D^.LastDist,D^.LastLen);
          exit;
        end;
      LengthCode := LengthCode shl 1;
      LCount := 0;
    end;

  LengthCode := LengthCode shr 8;
  //??? Quite different in new code:
  if (D^.Buf60 = 0) then
    if (D^.AvrLn1<37) then
      begin
        Length := T^.ECDSH1[LengthCode];
        AddBit(T^.NCDSH1[Length]);
      end
    else
      begin
        Length :=T^.ECDSH2[LengthCode];
        AddBit(T^.NCDSH2[Length]);
      end
  else
    if (D^.AvrLn1<37) then
      begin
        Length:=T^.ECDSH3[LengthCode];
        AddBit(T^.NCDSH3[Length]);
      end
    else
      begin
        Length:=T^.ECDSH4[LengthCode];
        AddBit(T^.NCDSH4[Length]);
      end;

  if (Length >= 9) then
    begin
      if (Length = 9) then
        begin
          Inc( LCount );
          CopyString(D^.LastDist,D^.LastLen);
          exit;
        end;

      if (Length = 14) then
        begin
          LCount:=0;
          Length:=T^.ECDLN2[GetField shr 4];
          AddBit(T^.NCDLN2[Length]);
          Inc( Length, 5 );
          Distance:=(GetField shr 1) OR $8000;
          AddBit(15);
          D^.LastLen  := Length;
          D^.LastDist := Distance;
          CopyString(Distance,Length);
          exit;
        end;

      LCount := 0;
      SaveLength := Length;
      Distance := D^.OldDist[(D^.OldDistNum-(Length-9)) AND 3];
      Length := T^.ECDLN1[GetField shr 4];
      AddBit(T^.NCDLN1[Length]);
      Inc( Length, 2 );
      if ( Length = $101 ) and ( SaveLength = 10 ) then
        begin
          { ^=:: x?=a -> x := x?a }
          D^.Buf60 := D^.Buf60 xor 1;
          exit;
        end;

      if (Distance > 256) then
        Inc( Length );
      if (Distance >= D^.MaxDist3) then  // BUG IN OLD CODE WAS HERE
        Inc( Length );

      D^.OldDist[D^.OldDistNum] := Distance;
      D^.OldDistNum := ( D^.OldDistNum+1 ) AND 3;
      D^.LastLen := Length;
      D^.LastDist := Distance;
      CopyString(Distance,Length);
      exit;
    end; { Length >= 9 }

  LCount := 0;
  Inc( D^.AvrLn1, Length );
  D^.AvrLn1 := D^.AvrLn1 - D^.AvrLn1 shr 4;

  //??? Quite different again
  DistancePlace := T^.ECODE2[GetField shr 6];
  AddBit( T^.NCODE2[DistancePlace] );
  Distance := D^.ChSetA[DistancePlace];
  Dec( DistancePlace );
  if (DistancePlace <> $FFFF) then
    begin
      Dec( D^.PlaceA[Distance] );
      LastDistance := D^.ChSetA[DistancePlace];
      Inc( D^.PlaceA[LastDistance] );
      D^.ChSetA[DistancePlace+1] := LastDistance;
      D^.ChSetA[DistancePlace] := Distance;
    end;

  Inc( Length, 2 );
  Inc( Distance );
  D^.OldDist[D^.OldDistNum] := Distance;
  D^.OldDistNum := ( D^.OldDistNum + 1 ) AND 3;
  D^.LastLen := Length;
  D^.LastDist := Distance;
  CopyString(Distance,Length);
end;

Function DoUnPack( UnpMem : pBuffer; UnpRead, UnpWrite : IOFunc; Solid : Boolean ) : Integer;
Var
  DbgCount : Word;
  FullSize : Word;

begin
  dbgCount := 0;
  FullSize := DestUnpSize;

  UnpReadFn  := UnpRead;
  UnpWriteFn := UnpWrite;
  UnpBuf     := UnpMem;
  PackBuf    := Ptr(Word(UnpMem)+$10000+sizeof(UnpData)+sizeof(DecodeTables));
  D := Ptr(Word(UnpMem)+$10000);

  if Suspend then
    OutAdr := D^.WrAddr
  else
    begin
      UnpInitData(Solid);
      if not Solid then
        begin
          InitHuff;
          FillChar( UnpBuf^, $10000, 0 );
          OutAdr := 0;
        end
      else
        OutAdr := D^.WrAddr;

      Dec( DestUnpSize );
      if DestUnpSize < 0 then
        begin
          DoUnpack := 0;
          exit;
        end;

      if UnpReadBuf(FIRST) = -1 then
        begin
          DoUnpack := -1;
          exit;
        end;

      GetFlagsBuf;
      FlagsCnt := 8;
    end;

  while DestUnpSize >= 0 do
    begin
      If DbgCount = 500 then
        begin
          Write(100-(100*DestUnpSize) div FullSize:3,'%'#8#8#8#8);
          DbgCount := 0;
        end;
      Inc( DbgCount );

      if (InAdr >= SIZE_PBUF-30) then
        if (UnpReadBuf(NEXT) = -1) then
          begin
            DoUnpack := -1;
            exit;
          end;

      if ( SmallWord(D^.WrAddr - OutAdr) < $110 ) and
         ( D^.WrAddr <> OutAdr ) then
        begin
          if UnpWriteBuf = -1 then
            begin
              DoUnpack := -1;
              exit;
            end;
          if Suspend then
            begin
              DoUnpack := 0;
              exit;
            end;
        end;

      if (D^.StMode) then
        begin
          HuffDecode;
          continue;
        end;

      Dec( FlagsCnt );
      if FlagsCnt < 0 then
        begin
          GetFlagsBuf;
          FlagsCnt := 7;
        end;

      if ( FlagBuf >= $80 ) then
        begin
          FlagBuf := Byte( FlagBuf shl 1 );
          if (D^.Nlzb > D^.Nhfb) then
            LongLZ
          else
            HuffDecode;
        end
      else
        begin
          FlagBuf := FlagBuf shl 1;
          Dec( FlagsCnt );
          if FlagsCnt < 0 then
            begin
              GetFlagsBuf;
              FlagsCnt := 7;
            end;
          if FlagBuf >= $80 then
            begin
              FlagBuf := Byte( FlagBuf shl 1 );
              if (D^.Nlzb > D^.Nhfb) then
                HuffDecode
              else
                LongLZ;
            end
          else
            begin
              FlagBuf := Byte( FlagBuf shl 1 );
              ShortLZ;
            end;
        end;
  end;

  if UnpWriteBuf = -1 then
    DoUnpack := -1
  else
    DoUnpack := 0;
end; { DoUnpack }

Procedure CreateOneTbl(hcd,ecd,ncd : Pointer;ShiftCount : Byte);
Var
  I,MaxCode,Code : Word;
begin
  i := 0;
  While ( pSmallWords( hcd )^[i] <> 0 ) do
    begin
      pBuffer(ncd)^[I] := Byte(pSmallWords(hcd)^[I] AND $f);
      Code := pSmallWords(hcd)^[I] shr ShiftCount;
      MaxCode := 1 shl (16-ShiftCount-Byte(pSmallWords(hcd)^[I] AND $f));
      while MaxCode > 0 do
        begin
          pBuffer(ecd)^[ Code ] := Byte(I);
          Inc( Code );
          Dec( MaxCode );
        end;

      Inc( i );
    end
end;

Procedure CreateEncTbl( UnpMem : Pointer );
begin
  T := Ptr(Word(UnpMem)+$10000+sizeof(UnpData));
  CreateOneTbl(@hcdsh1,@T^.ECDSH1,@T^.NCDSH1,8);
  CreateOneTbl(@hcdsh2,@T^.ECDSH2,@T^.NCDSH2,8);
  CreateOneTbl(@hcdsh3,@T^.ECDSH3,@T^.NCDSH3,8);
  CreateOneTbl(@hcdsh4,@T^.ECDSH4,@T^.NCDSH4,8);
  CreateOneTbl(@hcdln0,@T^.ECDLN0,@T^.NCDLN0,8);
  CreateOneTbl(@hcdln1,@T^.ECDLN1,@T^.NCDLN1,4);
  CreateOneTbl(@hcdln2,@T^.ECDLN2,@T^.NCDLN2,4);
  CreateOneTbl(@hcode0,@T^.ECODE0,@T^.NCODE0,4);
  CreateOneTbl(@hcode1,@T^.ECODE1,@T^.NCODE1,4);
  CreateOneTbl(@hcode2,@T^.ECODE2,@T^.NCODE2,6);
  CreateOneTbl(@hcode3,@T^.ECODE3,@T^.NCODE3,6);
  CreateOneTbl(@hcode4,@T^.ECODE4,@T^.NCODE4,6);
end;

Procedure MakeTbl;
var
  I,J,K,Code : Word;
  OutTab : pSmallWord;
begin
  for i := 1 to Sizeof(MakeTab) div Sizeof(MakeTab[1]) do
    begin
      OutTab := MakeTab[I].Table;
      Code := 0;
      for j := 0 to 11 do
        begin
          K := 0;
          Code := Code shl 1;
          While ( K < MakeTab[i].HuffCodeCount[j] ) do
            begin
              OutTab^ := Code shl (4+11-j) or (j+1);
              Inc( Word(OutTab), 2 );
              Inc( Code );
              Inc( K );
            end;
        end;
      OutTab^ := 0;
    end
end;

end.

