home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / AEXMPSRC.RAR / UNRAR / UNPACK.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  23KB  |  891 lines
  1. {$AlignCode+,AlignData+,AlignRec+,B-,Cdecl-,D+,Delphi-,Frame+,G3+,I+}
  2. {$L+,Optimize+,OrgName-,P-,Q-,R-,Speed+,T-,V-,X+,ZD-,Use32+}
  3.  
  4. Unit UnPack;
  5.  
  6. Interface
  7.  
  8. Type
  9.   BufferType    = Array[0..MaxLongInt-1] of Byte;
  10.   pBuffer       = ^BufferType;
  11.   IOFunc        = Function(Addr : Pointer; Count : Word ) : Integer;
  12.  
  13. Procedure MakeTbl;
  14. Procedure CreateEncTbl( UnpMem : Pointer );
  15. Function DoUnPack( UnpMem : pBuffer; UnpRead, UnpWrite : IOFunc; Solid : Boolean ) : Integer;
  16.  
  17. Type
  18.   Words255 = Array[0..255] of Word;
  19.   SmallWords255 = Array[0..255] of SmallWord;
  20.   SmallWords    = Array[0..MaxLongInt div Sizeof( SmallWord ) ] of SmallWord;
  21.   pSmallWords255 = ^SmallWords255;
  22.   pSmallWords   = ^SmallWords;
  23.   pWords255 = ^Words255;
  24.   Bytes255 = Array[0..255] of Byte;
  25.   pBytes255 = ^Bytes255;
  26.   MakeHuffTabs = Record
  27.     Table         : Pointer;
  28.     HuffCodeCount : Array[0..11] of Byte;
  29.   end;
  30.  
  31.   UnpData = Record
  32.     ChSet       : Array[0..255] of SmallWord;
  33.     Place       : Array[0..255] of Byte;
  34.     NToPl       : Words255;
  35.  
  36.     ChSetA      : Array[0..255] of Byte;
  37.     PlaceA      : Array[0..255] of Byte;
  38.  
  39.     ChSetB      : Array[0..255] of SmallWord;
  40.     PlaceB      : Array[0..255] of Byte;
  41.     NToPlB      : Words255;
  42.  
  43.     ChSetC      : Array[0..255] of SmallWord;
  44.     PlaceC      : Array[0..255] of Byte;
  45.     NToPlC      : Words255;
  46.  
  47.     AvrPlc      : SmallWord;
  48.     AvrPlcB     : SmallWord;
  49.     AvrLn1      : SmallWord;
  50.     AvrLn2      : SmallWord;
  51.     AvrLn3      : SmallWord;
  52.  
  53.     NumHuf      : Word;
  54.     StMode      : Boolean;
  55.  
  56.     Nhfb        : Word;
  57.     Nlzb        : Word;
  58.  
  59.     MaxDist3    : Word;
  60.     Buf60       : Word;
  61.     WrAddr      : Word;
  62.     SomeRd      : Word;
  63.     UnpAllBuf   : Word;
  64.  
  65.     LastDist    : Word;
  66.     LastLen     : Word;
  67.     OldDist     : Array[0..3] of Word;
  68.     OldDistNum  : Word;
  69.   end;
  70.  
  71.   DecodeTables = Record
  72.     ECDSH1      : Array[0..255] of Byte;
  73.     ECDSH2      : Array[0..255] of Byte;
  74.     ECDSH3      : Array[0..255] of Byte;
  75.     ECDSH4      : Array[0..255] of Byte;
  76.  
  77.     ECDLN0      : Array[0..255] of Byte;
  78.     ECDLN1      : Array[0..4095] of Byte;
  79.     ECDLN2      : Array[0..4095] of Byte;
  80.     ECODE0      : Array[0..4095] of Byte;
  81.     ECODE1      : Array[0..4095] of Byte;
  82.     ECODE2      : Array[0..1023] of Byte;
  83.     ECODE3      : Array[0..1023] of Byte;
  84.     ECODE4      : Array[0..1023] of Byte;
  85.     NCDSH1      : Array[0..15] of Byte;
  86.     NCDSH2      : Array[0..15] of Byte;
  87.     NCDSH3      : Array[0..15] of Byte;
  88.     NCDSH4      : Array[0..15] of Byte;
  89.     NCDLN0      : Array[0..255] of Byte;
  90.     NCDLN1      : Array[0..255] of Byte;
  91.     NCDLN2      : Array[0..255] of Byte;
  92.     NCODE0      : Array[0..256] of Byte;
  93.     NCODE1      : Array[0..256] of Byte;
  94.     NCODE2      : Array[0..256] of Byte;
  95.     NCODE3      : Array[0..256] of Byte;
  96.     NCODE4      : Array[0..256] of Byte;
  97.   end;
  98.  
  99.   Words258 = Array[0..257] of Word;
  100.   Small258Words = Array[0..257] of SmallWord;
  101.   SmallWords10  = Array[0..9] of SmallWord;
  102.   SmallWords15  = Array[0..14] of SmallWord;
  103.   SmallWords16  = Array[0..15] of SmallWord;
  104.  
  105. Var
  106.   hcdln1 : Small258Words;
  107.   hcdln2 : Small258Words;
  108.   hcode0 : Small258Words;
  109.   hcode1 : Small258Words;
  110.   hcode2 : Small258Words;
  111.   hcode3 : Small258Words;
  112.   hcode4 : Small258Words;
  113.  
  114.   FlagBuf : Byte;
  115.   InAdr,OutAdr : Word;
  116.   NumBit : Word;
  117.   LCount : Word; { 1 }
  118.   FlagsCnt : Integer;
  119.   UnpBuf : pBuffer;
  120.   PackBuf : pBuffer;
  121.   UnpReadFn : IOFunc;
  122.   UnpWriteFn : IOFunc;
  123.   D : ^UnpData;
  124.   T : ^DecodeTables;
  125.  
  126. Const
  127.   DestUnpSize : LongInt = 0;
  128.   Suspend : Boolean = False;
  129.  
  130. Const
  131.  MakeTab : Array[1..7] of MakeHuffTabs =
  132.  ( (Table : @hcdln1;
  133.     HuffCodeCount: ( 0  ,2  ,1  ,2  ,2  ,4   ,5   ,4   ,4   ,8   ,0   ,224 )),
  134.    (Table : @hcdln2;
  135.     HuffCodeCount: ( 0  ,0  ,5  ,2  ,2  ,4   ,5   ,4   ,4   ,8   ,2   ,220 )),
  136.    (Table : @hcode0;
  137.     HuffCodeCount: ( 0  ,0  ,0  ,8  ,8  ,8   ,9   ,0   ,0   ,0   ,0   ,224 )),
  138.    (Table : @hcode1;
  139.     HuffCodeCount: ( 0  ,0  ,0  ,0  ,4  ,40  ,16  ,16  ,4   ,0   ,47  ,130 )),
  140.    (Table : @hcode2;
  141.     HuffCodeCount: ( 0  ,0  ,0  ,0  ,2  ,5   ,46  ,64  ,116 ,24  ,0   ,0   )),
  142.    (Table : @hcode3;
  143.     HuffCodeCount: ( 0  ,0  ,0  ,0  ,0  ,2   ,14  ,202 ,33  ,6   ,0   ,0   )),
  144.    (Table : @hcode4;
  145.     HuffCodeCount: ( 0  ,0  ,0  ,0  ,0  ,0   ,0   ,255 ,2   ,0   ,0   ,0   )));
  146.  
  147.   hcdsh1 : SmallWords15
  148.          = ( $0001,$a003,$d004,$e004,$f005,$f806,$fc07,$fe08,
  149.              $ff08,$c004,$8004,$9005,$9806,$9c06,0 );
  150.  
  151.   hcdsh2 : SmallWords15
  152.          = ( $0002,$4003,$6003,$a003,$d004,$e004,$f005,$f806,
  153.              $fc06,$c004,$8004,$9005,$9806,$9c06,0 );
  154.  
  155.   hcdsh3 : SmallWords16
  156.          = ( $0001,$a004,$d004,$e004,$f005,$f806,$fc07,$fe08,
  157.              $ff08,$c004,$8004,$9005,$9806,$9c06,$b004,0 );
  158.  
  159.   hcdsh4 : SmallWords16
  160.          = ( $0002,$4003,$6003,$a004,$d004,$e004,$f005,$f806,
  161.              $fc06,$c004,$8004,$9005,$9806,$9c06,$b004,0 );
  162.  
  163.   hcdln0 : SmallWords10
  164.          = ( $8001,$4002,$2003,$1004,$0805,$0406,$0207,$0108,
  165.              $0008,0 );
  166.  
  167.   _Suspend    = 1;
  168.   Size_pBuf  = $2000;
  169.   First      = 1;
  170.   Next       = 2;
  171.  
  172.   Unp_Memory = $10010 + Sizeof( UnpData ) + Sizeof( DecodeTables ) + Size_PBuf;
  173.  
  174. Implementation
  175.  
  176. {#define GetField() ((UWORD)((((UDWORD)PackBuf[InAdr] shl 16) |         \
  177.                    ((UWORD)PackBuf[InAdr+1] shl 8) | PackBuf[InAdr+2]) \
  178.                     >> (8-NumBit)))}
  179.  
  180. {$FRAME-} {$USES None}
  181. Function GetField : SmallWord; assembler;
  182. asm
  183.   mov   ecx,InAdr
  184.   mov   edx,PackBuf
  185.   mov   eax,[edx+ecx]
  186.  
  187.  {$IFOPT G3+}
  188.   xchg    al,ah
  189.   rol     eax,16
  190.   xchg    al,ah
  191.  {$ELSE}
  192.   bswap   eax             { 486 & Pentium only }
  193.  {$ENDIF}
  194.  
  195.   mov   ecx,16
  196.   sub   ecx,numbit
  197.   shr   eax,cl
  198. end;
  199.  
  200. Procedure AddBit( NBits : Word ); inline;
  201. begin
  202.   Inc( InAdr, (NumBit+NBits) shr 3 );
  203.   InAdr := SmallWord( InAdr );
  204.   NumBit := (NumBit+NBits) and 7;
  205. end;
  206.  
  207. Function Min( a,b : Word ) : Word; inline;
  208. begin
  209.   If a < b then
  210.     Min := a
  211.   else
  212.     Min := b;
  213. end;
  214.  
  215. Procedure CopyString( Distance : Word; Length : Word );
  216. begin
  217.   Dec( DestUnpSize, Length );
  218.   while Length > 0 do
  219.     begin
  220.       Dec( Length );
  221.       UnpBuf^[OutAdr] := UnpBuf^[ SmallWord( OutAdr-Distance ) ];
  222.       Inc( OutAdr );
  223.       OutAdr := SmallWord(OutAdr);
  224.     end;
  225. end;
  226.  
  227. Procedure UnpInitData(Solid : Boolean);
  228. begin
  229.   if not Solid then
  230.   begin
  231.     FillChar( D^, sizeof(D^), 0 );
  232.     D^.AvrPlc := $3500;
  233.     D^.MaxDist3 := $2001;
  234.     D^.Nhfb := $80;
  235.     D^.Nlzb := $80;
  236.   end;
  237.   FlagsCnt := 0;
  238.   FlagBuf := 0;
  239.   InAdr := 0;
  240.   NumBit := 0;
  241.   D^.StMode := False;
  242.   LCount := 0;
  243. end;
  244.  
  245. Procedure CorrHuff(CharSet : pSmallWords255;NumToPlace : pWords255);
  246. Var
  247.   i, j : Integer;
  248. begin
  249.   for i := 7 downto 0 do
  250.     for j := 0 to 31 do
  251.       begin
  252.         pSmallWord(CharSet)^ := (pSmallWord(CharSet)^ and not $FF ) or I;
  253.         Inc( Word( CharSet ), 2 );
  254.       end;
  255.   FillChar( NumToPlace^, sizeof(D^.NToPl), 0 );
  256.   for i := 6 downto 0 do
  257.     NumToPlace^[I] := (7-I)*32;
  258. end;
  259.  
  260. Procedure InitHuff;
  261. Var
  262.   i : Word;
  263. begin
  264.   for i := 0 to 255 do
  265.     With D^ do
  266.       begin
  267.         Place[I]  := byte(I);
  268.         PlaceA[I] := byte(I);
  269.         PlaceB[I] := byte(I);
  270.         PlaceC[I] := byte(not I+1);
  271.         ChSet[I]  := SmallWord( I shl 8 );
  272.         ChSetB[I] := SmallWord( I shl 8 );
  273.         ChSetA[I] := byte(I);
  274.         ChSetC[I] := SmallWord( (not I+1) shl 8 );
  275.       end;
  276.   FillChar( D^.NToPl,  sizeof(D^.NToPl), 0 );
  277.   FillChar( D^.NToPlB, sizeof(D^.NToPlB), 0 );
  278.   FillChar( D^.NToPlC, sizeof(D^.NToPlC), 0 );
  279.   CorrHuff(@D^.ChSetB,@D^.NToPlB);
  280. end;
  281.  
  282. Function UnpReadBuf( NumBuf : Integer ) : Integer;
  283. Var
  284.   ReadCode : Integer;
  285. begin
  286.   if (NumBuf = FIRST) then
  287.     ReadCode := UnpReadFn( PackBuf, SIZE_PBUF )
  288.   else
  289.     begin
  290.       Move(Ptr(Word(PackBuf)+InAdr)^, PackBuf^, SIZE_PBUF-InAdr);
  291.       ReadCode := UnpReadFn( Ptr(Word(PackBuf)+SIZE_PBUF-InAdr),InAdr);
  292.     end;
  293.   InAdr := 0;
  294.   if (ReadCode = -1) then
  295.     UnpReadBuf := -1
  296.   else
  297.     UnpReadBuf := 0;
  298. end;
  299.  
  300. Procedure GetFlagsBuf;
  301. Var
  302.   Flags : SmallWord;
  303.   FlagsPlace,NewFlagsPlace : Word;
  304.  
  305. begin
  306.   FlagsPlace := T^.ECODE2[GetField shr 6];
  307.   AddBit(T^.NCODE2[FlagsPlace]);
  308.  
  309.   while true do
  310.     begin
  311.       Flags := D^.ChSetC[FlagsPlace];
  312.       FlagBuf := Flags shr 8;
  313.       NewFlagsPlace := D^.NToPlC[Flags AND $ff];
  314.       Inc( D^.NToPlC[Flags AND $ff] );
  315.       Inc( Flags );
  316.       if ((Flags AND $ff)  =  0) then
  317.         begin
  318.           Dec( Flags, $100 ); //??? remove line???
  319.           CorrHuff( @D^.ChSetC, @D^.NToPlC );
  320.         end
  321.       else
  322.         break;
  323.     end;
  324.  
  325.   D^.ChSetC[FlagsPlace] := D^.ChSetC[NewFlagsPlace];
  326.   D^.ChSetC[NewFlagsPlace] := Flags;
  327. end;
  328.  
  329. Function UnpWriteBuf : Integer;
  330. begin
  331.   if (OutAdr<D^.WrAddr) then
  332.     begin
  333.       if ( UnpWriteFn( Ptr(Word(UnpBuf)+D^.WrAddr),SmallWord(-D^.WrAddr)) = -1 ) or
  334.          ( UnpWriteFn( UnpBuf, OutAdr) = -1 ) then
  335.         begin
  336.           UnpWriteBuf := -1;
  337.           Exit;
  338.         end;
  339.     end
  340.   else
  341.     if (UnpWriteFn( Ptr(Word(UnpBuf)+D^.WrAddr), OutAdr-D^.WrAddr) = -1) then
  342.       begin
  343.         UnpWriteBuf := -1;
  344.         Exit;
  345.       end;
  346.  
  347.   D^.WrAddr := OutAdr;
  348.   UnpWriteBuf := 0;
  349. end;
  350.  
  351. Procedure HuffDecode;
  352. Var
  353.   CurByte,BytePlace,NewBytePlace : SmallWord;
  354.   Length,Distance,Code : SmallWord;
  355.  
  356. begin
  357.   Code := GetField;
  358.  
  359.   if (D^.AvrPlc > $75ff) then
  360.     begin
  361.       BytePlace := T^.ECODE4[Code shr 6];
  362.       if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
  363.         BytePlace := $100;
  364.       AddBit( T^.NCODE4[BytePlace] );
  365.     end
  366.   else
  367.     if (D^.AvrPlc > $5dff) then
  368.       begin
  369.         BytePlace := T^.ECODE3[Code shr 6];
  370.         if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
  371.           BytePlace := $100;
  372.         AddBit(T^.NCODE3[BytePlace]);
  373.       end
  374.     else
  375.       if (D^.AvrPlc > $35ff) then
  376.         begin
  377.           BytePlace := T^.ECODE2[Code shr 6];
  378.           if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
  379.             BytePlace := $100;
  380.           AddBit(T^.NCODE2[BytePlace]);
  381.         end
  382.       else
  383.         if (D^.AvrPlc > $0dff) then
  384.           begin
  385.             BytePlace := T^.ECODE1[Code shr 4];
  386.             if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
  387.               BytePlace := $100;
  388.             AddBit(T^.NCODE1[BytePlace]);
  389.           end
  390.         else
  391.           begin
  392.             BytePlace := T^.ECODE0[Code shr 4];
  393.             if ( D^.StMode ) and ( BytePlace = 0 ) and ( Code > $fff ) then
  394.               BytePlace := $100;
  395.             AddBit(T^.NCODE0[BytePlace]);
  396.           end;
  397.  
  398.   if D^.StMode then
  399.     begin
  400.       Dec( BytePlace );
  401.       if (BytePlace = $FFFF) then
  402.         begin
  403.           Code := GetField;
  404.           AddBit(1);
  405.           if (Code >= $8000) then
  406.             begin
  407.               D^.NumHuf := 0;
  408.               D^.StMode := False;
  409.               exit;
  410.             end
  411.           else
  412.             begin
  413.               If (Code AND $4000) <> 0 then
  414.                 Length := 4
  415.               else
  416.                 Length := 3;
  417.               Distance := T^.ECODE2[(Code shr 4) AND $3ff];
  418.               AddBit(T^.NCODE2[Distance]+1);
  419.               Distance := (Distance shl 5) OR (GetField shr 11);
  420.               AddBit(5);
  421.               CopyString(Distance,Length);
  422.               exit;
  423.             end
  424.         end
  425.     end
  426.   else
  427.     begin
  428.       if (D^.NumHuf >= 16 ) and ( FlagsCnt = 0 ) then
  429.         D^.StMode := True;
  430.       Inc( D^.NumHuf );
  431.     end;
  432.   Inc( D^.AvrPlc, BytePlace );
  433.   Dec( D^.AvrPlc, D^.AvrPlc shr 8 );
  434.   Inc( D^.Nhfb, 16 );
  435.   if (D^.Nhfb > $ff) then
  436.     begin
  437.       D^.Nhfb := $90;
  438.       D^.Nlzb := D^.Nlzb shr 1;
  439.     end;
  440.  
  441.   UnpBuf^[ OutAdr ] := D^.ChSet[BytePlace] shr 8;
  442.   Inc( OutAdr );
  443.   OutAdr := SmallWord( OutAdr );
  444.   Dec( DestUnpSize );
  445.  
  446.   while true do
  447.     begin
  448.       CurByte := D^.ChSet[BytePlace];
  449.       NewBytePlace := D^.NToPl[CurByte AND $ff];
  450.       Inc( D^.NToPl[CurByte AND $ff] );
  451.       Inc( CurByte );
  452.       if ((CurByte AND $ff) > $a1) then
  453.         CorrHuff(@D^.ChSet,@D^.NToPl)
  454.       else
  455.         break;
  456.     end;
  457.  
  458.   D^.ChSet[BytePlace] := D^.ChSet[NewBytePlace];
  459.   D^.ChSet[NewBytePlace] := CurByte;
  460. end;
  461.  
  462. procedure LongLZ;
  463. Var
  464.   LengthCode,Length : SmallWord;
  465.   Distance,DistancePlace,NewDistancePlace : SmallWord;
  466.   oldav2,oldav3 : SmallWord;
  467.  
  468. begin
  469.   D^.NumHuf := 0;
  470.   Inc( D^.Nlzb, 16 );
  471.   if (D^.Nlzb > $ff) then
  472.     begin
  473.       D^.Nlzb := $90;
  474.       D^.Nhfb := D^.Nhfb shr 1;
  475.     end;
  476.  
  477.   oldav2 := D^.AvrLn2;
  478.   if (D^.AvrLn2 >= 122) then
  479.     begin
  480.       Length := T^.ECDLN2[GetField shr 4];
  481.       AddBit(T^.NCDLN2[Length]);
  482.     end
  483.   else
  484.     if (D^.AvrLn2 >= 64) then
  485.       begin
  486.         Length := T^.ECDLN1[GetField shr 4];
  487.         AddBit(T^.NCDLN1[Length]);
  488.       end
  489.     else
  490.       begin
  491.         LengthCode := GetField;
  492.         if (LengthCode < $100) then
  493.           begin
  494.             Length := LengthCode;
  495.             AddBit(16);
  496.           end
  497.         else
  498.           begin
  499.             //??? Different
  500.             Length := T^.ECDLN0[LengthCode shr 8];
  501.             AddBit(T^.NCDLN0[Length]);
  502.           end
  503.       end;
  504.  
  505.   Inc( D^.AvrLn2, Length );
  506.   Dec( D^.AvrLn2, D^.AvrLn2 shr 5 );
  507.  
  508.   if (D^.AvrPlcB > $28ff) then
  509.   begin
  510.     DistancePlace := T^.ECODE2[GetField shr 6];
  511.     AddBit(T^.NCODE2[DistancePlace]);
  512.   end
  513.   else
  514.     if (D^.AvrPlcB > $6ff) then
  515.       begin
  516.         DistancePlace := T^.ECODE1[GetField shr 4];
  517.         AddBit(T^.NCODE1[DistancePlace]);
  518.       end
  519.     else
  520.       begin
  521.         DistancePlace := T^.ECODE0[GetField shr 4];
  522.         AddBit(T^.NCODE0[DistancePlace]);
  523.       end;
  524.  
  525.   Inc( D^.AvrPlcB, DistancePlace );
  526.   Dec( D^.AvrPlcB, D^.AvrPlcB shr 8 );
  527.   while true do
  528.     begin
  529.       Distance := D^.ChSetB[DistancePlace];
  530.       NewDistancePlace := D^.NToPlB[Distance AND $ff];
  531.       Inc( D^.NToPlB[Distance AND $ff] );
  532.       Inc( Distance );
  533.       if (Distance AND $ff) = 0 then
  534.         begin
  535.           Dec( Distance, $100 );  //??? remove this line ???
  536.           CorrHuff( @D^.ChSetB, @D^.NToPlB );
  537.         end
  538.       else
  539.         break;
  540.     end;
  541.  
  542.   D^.ChSetB[DistancePlace] := D^.ChSetB[NewDistancePlace];
  543.   D^.ChSetB[NewDistancePlace] := Distance;
  544.  
  545.   Distance := SmallWord ((Distance AND NOT $ff) OR (GetField shr 8)) shr 1;
  546.   AddBit(7);
  547.  
  548.   oldav3 := D^.AvrLn3;
  549.   if (Length<>1) and (Length<>4) then
  550.     if (Length = 0) and ( Distance <= D^.MaxDist3 ) then
  551.       begin
  552.         Inc( D^.AvrLn3 );
  553.         Dec( D^.AvrLn3, D^.AvrLn3 shr 8 );
  554.       end
  555.     else
  556.       if (D^.AvrLn3 > 0) then
  557.         Dec( D^.AvrLn3 );
  558.  
  559.   Inc( Length, 3 );
  560.   if (Distance >= D^.MaxDist3) then
  561.     Inc( Length );
  562.   if (Distance <= 256) then
  563.     Inc( Length, 8 );
  564.   if (oldav3 > $b0 ) or ( D^.AvrPlc >= $2a00 ) and (oldav2 < $40) then
  565.     D^.MaxDist3 := $7f00
  566.   else
  567.     D^.MaxDist3 := $2001;
  568.   D^.OldDist[D^.OldDistNum]:=Distance;
  569.   D^.OldDistNum := ( D^.OldDistNum+1 ) AND 3;
  570.   D^.LastLen := Length;
  571.   D^.LastDist := Distance;
  572.   CopyString(Distance,Length);
  573. end;
  574.  
  575. Procedure ShortLZ;
  576. Var
  577.   LengthCode,SaveLength : Word;
  578.   LastDistance : Word;
  579.   Distance,DistancePlace,Length : SmallWord;
  580.  
  581. begin
  582.   LengthCode := GetField; //??? GetBits
  583.   D^.NumHuf  := 0;
  584.   if (LCount=2) then
  585.     begin
  586.       AddBit(1);
  587.       if (LengthCode >= $8000) then
  588.         begin
  589.           CopyString(D^.LastDist,D^.LastLen);
  590.           exit;
  591.         end;
  592.       LengthCode := LengthCode shl 1;
  593.       LCount := 0;
  594.     end;
  595.  
  596.   LengthCode := LengthCode shr 8;
  597.   //??? Quite different in new code:
  598.   if (D^.Buf60 = 0) then
  599.     if (D^.AvrLn1<37) then
  600.       begin
  601.         Length := T^.ECDSH1[LengthCode];
  602.         AddBit(T^.NCDSH1[Length]);
  603.       end
  604.     else
  605.       begin
  606.         Length :=T^.ECDSH2[LengthCode];
  607.         AddBit(T^.NCDSH2[Length]);
  608.       end
  609.   else
  610.     if (D^.AvrLn1<37) then
  611.       begin
  612.         Length:=T^.ECDSH3[LengthCode];
  613.         AddBit(T^.NCDSH3[Length]);
  614.       end
  615.     else
  616.       begin
  617.         Length:=T^.ECDSH4[LengthCode];
  618.         AddBit(T^.NCDSH4[Length]);
  619.       end;
  620.  
  621.   if (Length >= 9) then
  622.     begin
  623.       if (Length = 9) then
  624.         begin
  625.           Inc( LCount );
  626.           CopyString(D^.LastDist,D^.LastLen);
  627.           exit;
  628.         end;
  629.  
  630.       if (Length = 14) then
  631.         begin
  632.           LCount:=0;
  633.           Length:=T^.ECDLN2[GetField shr 4];
  634.           AddBit(T^.NCDLN2[Length]);
  635.           Inc( Length, 5 );
  636.           Distance:=(GetField shr 1) OR $8000;
  637.           AddBit(15);
  638.           D^.LastLen  := Length;
  639.           D^.LastDist := Distance;
  640.           CopyString(Distance,Length);
  641.           exit;
  642.         end;
  643.  
  644.       LCount := 0;
  645.       SaveLength := Length;
  646.       Distance := D^.OldDist[(D^.OldDistNum-(Length-9)) AND 3];
  647.       Length := T^.ECDLN1[GetField shr 4];
  648.       AddBit(T^.NCDLN1[Length]);
  649.       Inc( Length, 2 );
  650.       if ( Length = $101 ) and ( SaveLength = 10 ) then
  651.         begin
  652.           { ^=:: x?=a -> x := x?a }
  653.           D^.Buf60 := D^.Buf60 xor 1;
  654.           exit;
  655.         end;
  656.  
  657.       if (Distance > 256) then
  658.         Inc( Length );
  659.       if (Distance >= D^.MaxDist3) then  // BUG IN OLD CODE WAS HERE
  660.         Inc( Length );
  661.  
  662.       D^.OldDist[D^.OldDistNum] := Distance;
  663.       D^.OldDistNum := ( D^.OldDistNum+1 ) AND 3;
  664.       D^.LastLen := Length;
  665.       D^.LastDist := Distance;
  666.       CopyString(Distance,Length);
  667.       exit;
  668.     end; { Length >= 9 }
  669.  
  670.   LCount := 0;
  671.   Inc( D^.AvrLn1, Length );
  672.   D^.AvrLn1 := D^.AvrLn1 - D^.AvrLn1 shr 4;
  673.  
  674.   //??? Quite different again
  675.   DistancePlace := T^.ECODE2[GetField shr 6];
  676.   AddBit( T^.NCODE2[DistancePlace] );
  677.   Distance := D^.ChSetA[DistancePlace];
  678.   Dec( DistancePlace );
  679.   if (DistancePlace <> $FFFF) then
  680.     begin
  681.       Dec( D^.PlaceA[Distance] );
  682.       LastDistance := D^.ChSetA[DistancePlace];
  683.       Inc( D^.PlaceA[LastDistance] );
  684.       D^.ChSetA[DistancePlace+1] := LastDistance;
  685.       D^.ChSetA[DistancePlace] := Distance;
  686.     end;
  687.  
  688.   Inc( Length, 2 );
  689.   Inc( Distance );
  690.   D^.OldDist[D^.OldDistNum] := Distance;
  691.   D^.OldDistNum := ( D^.OldDistNum + 1 ) AND 3;
  692.   D^.LastLen := Length;
  693.   D^.LastDist := Distance;
  694.   CopyString(Distance,Length);
  695. end;
  696.  
  697. Function DoUnPack( UnpMem : pBuffer; UnpRead, UnpWrite : IOFunc; Solid : Boolean ) : Integer;
  698. Var
  699.   DbgCount : Word;
  700.   FullSize : Word;
  701.  
  702. begin
  703.   dbgCount := 0;
  704.   FullSize := DestUnpSize;
  705.  
  706.   UnpReadFn  := UnpRead;
  707.   UnpWriteFn := UnpWrite;
  708.   UnpBuf     := UnpMem;
  709.   PackBuf    := Ptr(Word(UnpMem)+$10000+sizeof(UnpData)+sizeof(DecodeTables));
  710.   D := Ptr(Word(UnpMem)+$10000);
  711.  
  712.   if Suspend then
  713.     OutAdr := D^.WrAddr
  714.   else
  715.     begin
  716.       UnpInitData(Solid);
  717.       if not Solid then
  718.         begin
  719.           InitHuff;
  720.           FillChar( UnpBuf^, $10000, 0 );
  721.           OutAdr := 0;
  722.         end
  723.       else
  724.         OutAdr := D^.WrAddr;
  725.  
  726.       Dec( DestUnpSize );
  727.       if DestUnpSize < 0 then
  728.         begin
  729.           DoUnpack := 0;
  730.           exit;
  731.         end;
  732.  
  733.       if UnpReadBuf(FIRST) = -1 then
  734.         begin
  735.           DoUnpack := -1;
  736.           exit;
  737.         end;
  738.  
  739.       GetFlagsBuf;
  740.       FlagsCnt := 8;
  741.     end;
  742.  
  743.   while DestUnpSize >= 0 do
  744.     begin
  745.       If DbgCount = 500 then
  746.         begin
  747.           Write(100-(100*DestUnpSize) div FullSize:3,'%'#8#8#8#8);
  748.           DbgCount := 0;
  749.         end;
  750.       Inc( DbgCount );
  751.  
  752.       if (InAdr >= SIZE_PBUF-30) then
  753.         if (UnpReadBuf(NEXT) = -1) then
  754.           begin
  755.             DoUnpack := -1;
  756.             exit;
  757.           end;
  758.  
  759.       if ( SmallWord(D^.WrAddr - OutAdr) < $110 ) and
  760.          ( D^.WrAddr <> OutAdr ) then
  761.         begin
  762.           if UnpWriteBuf = -1 then
  763.             begin
  764.               DoUnpack := -1;
  765.               exit;
  766.             end;
  767.           if Suspend then
  768.             begin
  769.               DoUnpack := 0;
  770.               exit;
  771.             end;
  772.         end;
  773.  
  774.       if (D^.StMode) then
  775.         begin
  776.           HuffDecode;
  777.           continue;
  778.         end;
  779.  
  780.       Dec( FlagsCnt );
  781.       if FlagsCnt < 0 then
  782.         begin
  783.           GetFlagsBuf;
  784.           FlagsCnt := 7;
  785.         end;
  786.  
  787.       if ( FlagBuf >= $80 ) then
  788.         begin
  789.           FlagBuf := Byte( FlagBuf shl 1 );
  790.           if (D^.Nlzb > D^.Nhfb) then
  791.             LongLZ
  792.           else
  793.             HuffDecode;
  794.         end
  795.       else
  796.         begin
  797.           FlagBuf := FlagBuf shl 1;
  798.           Dec( FlagsCnt );
  799.           if FlagsCnt < 0 then
  800.             begin
  801.               GetFlagsBuf;
  802.               FlagsCnt := 7;
  803.             end;
  804.           if FlagBuf >= $80 then
  805.             begin
  806.               FlagBuf := Byte( FlagBuf shl 1 );
  807.               if (D^.Nlzb > D^.Nhfb) then
  808.                 HuffDecode
  809.               else
  810.                 LongLZ;
  811.             end
  812.           else
  813.             begin
  814.               FlagBuf := Byte( FlagBuf shl 1 );
  815.               ShortLZ;
  816.             end;
  817.         end;
  818.   end;
  819.  
  820.   if UnpWriteBuf = -1 then
  821.     DoUnpack := -1
  822.   else
  823.     DoUnpack := 0;
  824. end; { DoUnpack }
  825.  
  826. Procedure CreateOneTbl(hcd,ecd,ncd : Pointer;ShiftCount : Byte);
  827. Var
  828.   I,MaxCode,Code : Word;
  829. begin
  830.   i := 0;
  831.   While ( pSmallWords( hcd )^[i] <> 0 ) do
  832.     begin
  833.       pBuffer(ncd)^[I] := Byte(pSmallWords(hcd)^[I] AND $f);
  834.       Code := pSmallWords(hcd)^[I] shr ShiftCount;
  835.       MaxCode := 1 shl (16-ShiftCount-Byte(pSmallWords(hcd)^[I] AND $f));
  836.       while MaxCode > 0 do
  837.         begin
  838.           pBuffer(ecd)^[ Code ] := Byte(I);
  839.           Inc( Code );
  840.           Dec( MaxCode );
  841.         end;
  842.  
  843.       Inc( i );
  844.     end
  845. end;
  846.  
  847. Procedure CreateEncTbl( UnpMem : Pointer );
  848. begin
  849.   T := Ptr(Word(UnpMem)+$10000+sizeof(UnpData));
  850.   CreateOneTbl(@hcdsh1,@T^.ECDSH1,@T^.NCDSH1,8);
  851.   CreateOneTbl(@hcdsh2,@T^.ECDSH2,@T^.NCDSH2,8);
  852.   CreateOneTbl(@hcdsh3,@T^.ECDSH3,@T^.NCDSH3,8);
  853.   CreateOneTbl(@hcdsh4,@T^.ECDSH4,@T^.NCDSH4,8);
  854.   CreateOneTbl(@hcdln0,@T^.ECDLN0,@T^.NCDLN0,8);
  855.   CreateOneTbl(@hcdln1,@T^.ECDLN1,@T^.NCDLN1,4);
  856.   CreateOneTbl(@hcdln2,@T^.ECDLN2,@T^.NCDLN2,4);
  857.   CreateOneTbl(@hcode0,@T^.ECODE0,@T^.NCODE0,4);
  858.   CreateOneTbl(@hcode1,@T^.ECODE1,@T^.NCODE1,4);
  859.   CreateOneTbl(@hcode2,@T^.ECODE2,@T^.NCODE2,6);
  860.   CreateOneTbl(@hcode3,@T^.ECODE3,@T^.NCODE3,6);
  861.   CreateOneTbl(@hcode4,@T^.ECODE4,@T^.NCODE4,6);
  862. end;
  863.  
  864. Procedure MakeTbl;
  865. var
  866.   I,J,K,Code : Word;
  867.   OutTab : pSmallWord;
  868. begin
  869.   for i := 1 to Sizeof(MakeTab) div Sizeof(MakeTab[1]) do
  870.     begin
  871.       OutTab := MakeTab[I].Table;
  872.       Code := 0;
  873.       for j := 0 to 11 do
  874.         begin
  875.           K := 0;
  876.           Code := Code shl 1;
  877.           While ( K < MakeTab[i].HuffCodeCount[j] ) do
  878.             begin
  879.               OutTab^ := Code shl (4+11-j) or (j+1);
  880.               Inc( Word(OutTab), 2 );
  881.               Inc( Code );
  882.               Inc( K );
  883.             end;
  884.         end;
  885.       OutTab^ := 0;
  886.     end
  887. end;
  888.  
  889. end.
  890.  
  891.