home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / PASCAL / DUMPING / INFLATE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-03-22  |  38KB  |  1,034 lines
  1. Unit  Inflate ;
  2.  
  3. {
  4.    This code is based on the following:
  5.  
  6.       "inflate.c -- Not copyrighted 1992 by Mark Adler"
  7.       version c10p1, 10 January 1993
  8.  
  9.    Written 1995 by Oliver Fromme <fromme@rz.tu-clausthal.de>.
  10.    Donated to the public domain.
  11.  
  12.    Freely distributable, freely usable.
  13.    Nobody may claim copyright on this code.
  14.  
  15.    Disclaimer:  Use it at your own risk.  I am not liable for anything.
  16.  
  17.    Note that this is not my usual programming style, because of the
  18.    conversion from C to Pascal.  Many things could have been implemented
  19.    more efficient and in a more natural way if written from scratch in
  20.    Pascal.  Especially the handling of pointers and arrays is awful in C.
  21.  
  22.    *** VERY IMPORTANT NOTES: ***
  23.  
  24.    1. This unit assumes that GetMem returns a NIL pointer if there is not
  25.       enoug memory (no run-time error).  This requires a user-defined
  26.       HeapError function which always returns 1.
  27.  
  28.    2. The application must allocate memory for the slide^[] array!
  29.       Exactly WSIZE bytes have to be allocated.  This is _not_ done by this
  30.       unit, so the application has to care about that.
  31.  
  32.    3. The application has to provide the InflateFlush function (interface
  33.       section) which takes the first w bytes of the slide array as output
  34.       of the inflate process.  It returns an error code:  0 = no error,
  35.       any other value causes inflate to stop and return the same code.
  36.  
  37.    4. The application has to provide the InflateRead function which returns
  38.       the next byte of the input stream which is fed into the inflate
  39.       process.
  40. }
  41.  
  42. {$A+,B-,I-,Q-,R-,S-,T-,V+,X+}
  43. {$D+,L+,Y+} {for debugging only}
  44.  
  45. {
  46.    The following text (and many of the comments) is from the original
  47.    inflate code by Mark Adler.
  48.  
  49.    Inflate deflated (PKZIP's method 8 compressed) data.  The compression
  50.    method searches for as much of the current string of bytes (up to a
  51.    length of 258) in the previous 32K bytes.  If it doesn't find any
  52.    matches (of at least length 3), it codes the next byte.  Otherwise, it
  53.    codes the length of the matched string and its distance backwards from
  54.    the current position.  There is a single Huffman code that codes both
  55.    single bytes (called "literals") and match lengths.  A second Huffman
  56.    code codes the distance information, which follows a length code.  Each
  57.    length or distance code actually represents a base value and a number
  58.    of "extra" (sometimes zero) bits to get to add to the base value.  At
  59.    the end of each deflated block is a special end-of-block (EOB) literal/
  60.    length code.  The decoding process is basically: get a literal/length
  61.    code; if EOB then done; if a literal, emit the decoded byte; if a
  62.    length then get the distance and emit the referred-to bytes from the
  63.    sliding window of previously emitted data.
  64.  
  65.    There are (currently) three kinds of inflate blocks: stored, fixed, and
  66.    dynamic.  The compressor outputs a chunk of data at a time, and decides
  67.    which method to use on a chunk-by-chunk basis.  A chunk might typically
  68.    be 32K to 64K, uncompressed.  If the chunk is uncompressible, then the
  69.    "stored" method is used.  In this case, the bytes are simply stored as
  70.    is, eight bits per byte, with none of the above coding.  The bytes are
  71.    preceded by a count, since there is no longer an EOB code.
  72.  
  73.    If the data is compressible, then either the fixed or dynamic methods
  74.    are used.  In the dynamic method, the compressed data is preceded by
  75.    an encoding of the literal/length and distance Huffman codes that are
  76.    to be used to decode this block.  The representation is itself Huffman
  77.    coded, and so is preceded by a description of that code.  These code
  78.    descriptions take up a little space, and so for small blocks, there is
  79.    a predefined set of codes, called the fixed codes.  The fixed method is
  80.    used if the block ends up smaller that way (usually for quite small
  81.    chunks), otherwise the dynamic method is used.  In the latter case, the
  82.    codes are customized to the probabilities in the current block, and so
  83.    can code it much better than the pre-determined fixed codes can.
  84.  
  85.    The Huffman codes themselves are decoded using a mutli-level table
  86.    lookup, in order to maximize the speed of decoding plus the speed of
  87.    building the decoding tables.  See the comments below that precede the
  88.    lbits and dbits tuning parameters.
  89.  
  90.    Notes beyond the 1.93a appnote.txt:
  91.  
  92.    1. Distance pointers never point before the beginning of the output
  93.       stream.
  94.    2. Distance pointers can point back across blocks, up to 32k away.
  95.    3. There is an implied maximum of 7 bits for the bit length table and
  96.       15 bits for the actual data.
  97.    4. If only one code exists, then it is encoded using one bit.  (Zero
  98.       would be more efficient, but perhaps a little confusing.)  If two
  99.       codes exist, they are coded using one bit each (0 and 1).
  100.    5. There is no way of sending zero distance codes--a dummy must be
  101.       sent if there are none.  (History: a pre 2.0 version of PKZIP would
  102.       store blocks with no distance codes, but this was discovered to be
  103.       too harsh a criterion.)  Valid only for 1.93a.  2.04c does allow
  104.       zero distance codes, which is sent as one code of zero bits in
  105.       length.
  106.    6. There are up to 286 literal/length codes.  Code 256 represents the
  107.       end-of-block.  Note however that the static length tree defines
  108.       288 codes just to fill out the Huffman codes.  Codes 286 and 287
  109.       cannot be used though, since there is no length base or extra bits
  110.       defined for them.  Similarily, there are up to 30 distance codes.
  111.       However, static trees define 32 codes (all 5 bits) to fill out the
  112.       Huffman codes, but the last two had better not show up in the data.
  113.    7. Unzip can check dynamic Huffman blocks for complete code sets.
  114.       The exception is that a single code would not be complete (see #4).
  115.    8. The five bits following the block type is really the number of
  116.       literal codes sent minus 257.
  117.    9. Length codes 8,16,16 are interpreted as 13 length codes of 8 bits
  118.       (1+6+6).  Therefore, to output three times the length, you output
  119.       three codes (1+1+1), whereas to output four times the same length,
  120.       you only need two codes (1+3).  Hmm.
  121.   10. In the tree reconstruction algorithm, Code = Code + Increment
  122.       only if BitLength(i) is not zero.  (Pretty obvious.)
  123.   11. Correction: 4 Bits: # of Bit Length codes - 4     (4 - 19)
  124.   12. Note: length code 284 can represent 227-258, but length code 285
  125.       really is 258.  The last length deserves its own, short code
  126.       since it gets used a lot in very redundant files.  The length
  127.       258 is special since 258 - 3 (the min match length) is 255.
  128.   13. The literal/length and distance code bit lengths are read as a
  129.       single stream of lengths.  It is possible (and advantageous) for
  130.       a repeat code (16, 17, or 18) to go across the boundary between
  131.       the two sets of lengths.
  132. }
  133.  
  134. Interface
  135.  
  136. Const  WSIZE = $8000 ;
  137.    {window size--must be a power of two, and at least 32K for zip's deflate}
  138.  
  139. Type  InflateWindow  = Array [0..Pred(WSIZE)] Of Byte ;
  140.       pInflateWindow = ^InflateWindow ;
  141.  
  142. Var  slide : pInflateWindow ;
  143.      InflateFlush : Function (w : Word) : Integer ;
  144.      InflateRead  : Function : Byte ;
  145.  
  146. Function  InflateRun : Integer ;
  147.  
  148. Implementation
  149.  
  150. {
  151.    Huffman code lookup table entry--this entry is four bytes for machines
  152.    that have 16-bit pointers (e.g. PC's in the small or medium model).
  153.    Valid extra bits are 0..13.  e == 15 is EOB (end of block), e == 16
  154.    means that v is a literal, 16 < e < 32 means that v is a pointer to
  155.    the next table, which codes e - 16 bits, and lastly e == 99 indicates
  156.    an unused code.  If a code with e == 99 is looked up, this implies an
  157.    error in the data.
  158. }
  159.  
  160. Type  pInteger = ^Integer ;
  161.       pWord = ^Word ;
  162.       phuft = ^huft ;
  163.       huft  = Record
  164.                  e : Byte ; {number of extra bits or operation}
  165.                  b : Byte ; {number of bits in this code or subcode}
  166.                  v : Record {this odd Record is just for easier Pas2C}
  167.                  Case Integer Of
  168.                     0 : (n : Word) ; {literal, length base, or distance base}
  169.                     1 : (t : phuft) {pointer to next level of table}
  170.                  End
  171.               End ;
  172.       pphuft = ^phuft ;
  173.  
  174. {
  175.    The inflate algorithm uses a sliding 32K byte window on the uncompressed
  176.    stream to find repeated byte strings.  This is implemented here as a
  177.    circular buffer.  The index is updated simply by incrementing and then
  178.    and'ing with $7fff (32K-1).
  179.    It is left to other modules to supply the 32K area.  It is assumed
  180.    to be usable as if it were declared "slide : ^Array [0..32767] Of Byte".
  181. }
  182.  
  183. Var  wp : Word ; {current position in slide}
  184.  
  185. {Tables for deflate from PKZIP's appnote.txt.}
  186.  
  187. Const  border : Array [0..18] Of Word {Order of the bit length code lengths}
  188.               = (16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15) ;
  189.  
  190.        cplens : Array [0..30] Of Word {Copy lengths for literal codes 257..285}
  191.               = (3,4,5,6,7,8,9,10,11,13,15,17,19,23,27,31,
  192.                  35,43,51,59,67,83,99,115,131,163,195,227,258,0,0) ;
  193.                 {note: see note #13 above about the 258 in this list.}
  194.  
  195.        cplext : Array [0..30] Of Word {Extra bits for literal codes 257..285}
  196.               = (0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,
  197.                  3,3,3,3,4,4,4,4,5,5,5,5,0,99,99) ; {99=invalid}
  198.  
  199.        cpdist : Array [0..29] Of Word {Copy offsets for distance codes 0..29}
  200.               = (1,2,3,4,5,7,9,13,17,25,33,49,65,97,129,193,
  201.                  257,385,513,769,1025,1537,2049,3073,4097,6145,
  202.                  8193,12289,16385,24577) ;
  203.  
  204.        cpdext : Array [0..29] Of Word {Extra bits for distance codes}
  205.               = (0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,
  206.                  7,7,8,8,9,9,10,10,11,11,
  207.                  12,12,13,13) ;
  208.  
  209. {NEXTBYTE -> InflateRead}
  210.  
  211. Procedure  NEEDBITS (Var b : LongInt ; Var k : Byte ; n : Byte) ;
  212.    Begin
  213.       While k<n Do Begin
  214.          b := b Or (LongInt(InflateRead) Shl k) ;
  215.          Inc (k,8)
  216.       End
  217.    End {NEEDBITS} ;
  218.  
  219. Procedure  DUMPBITS (Var b : LongInt ; Var k : Byte ; n : Byte) ;
  220.    Begin
  221.       b := b Shr n ;
  222.       Dec (k,n)
  223.    End {DUMPBITS} ;
  224.  
  225. (*
  226.    Macros for inflate() bit peeking and grabbing.
  227.  
  228. #define NEXTBYTE    (ReadByte(&bytebuf), bytebuf)
  229. #define NEEDBITS(n) {while(k<(n)){b|=((ulg)NEXTBYTE)<<k;k+=8;}}
  230. #define DUMPBITS(n) {b>>=(n);k-=(n);}
  231.  
  232.    The usage is:
  233.  
  234.         NEEDBITS(j)
  235.         x = b & mask_bits[j];
  236.         DUMPBITS(j)
  237.  
  238.    where NEEDBITS makes sure that b has at least j bits in it, and
  239.    DUMPBITS removes the bits from b.  The macros use the variable k
  240.    for the number of bits in b.  Normally, b and k are register
  241.    variables for speed, and are initialized at the begining of a
  242.    routine that uses these macros from a global bit buffer and count.
  243.  
  244.    If we assume that EOB will be the longest code, then we will never
  245.    ask for bits with NEEDBITS that are beyond the end of the stream.
  246.    So, NEEDBITS should not read any more bytes than are needed to
  247.    meet the request.  Then no bytes need to be "returned" to the buffer
  248.    at the end of the last block.
  249.  
  250.    However, this assumption is not true for fixed blocks--the EOB code
  251.    is 7 bits, but the other literal/length codes can be 8 or 9 bits.
  252.    (The EOB code is shorter than other codes becuase fixed blocks are
  253.    generally short.  So, while a block always has an EOB, many other
  254.    literal/length codes have a significantly lower probability of
  255.    showing up at all.)  However, by making the first table have a
  256.    lookup of seven bits, the EOB code will be found in that first
  257.    lookup, and so will not require that too many bits be pulled from
  258.    the stream.
  259. *)
  260.  
  261. Var  bb : LongInt ; {bit buffer, unsigned}
  262.      bk : Byte ; {bits in bit buffer}
  263.  
  264. {
  265.    Huffman code decoding is performed using a multi-level table lookup.
  266.    The fastest way to decode is to simply build a lookup table whose
  267.    size is determined by the longest code.  However, the time it takes
  268.    to build this table can also be a factor if the data being decoded
  269.    is not very long.  The most common codes are necessarily the
  270.    shortest codes, so those codes dominate the decoding time, and hence
  271.    the speed.  The idea is you can have a shorter table that decodes the
  272.    shorter, more probable codes, and then point to subsidiary tables for
  273.    the longer codes.  The time it costs to decode the longer codes is
  274.    then traded against the time it takes to make longer tables.
  275.  
  276.    This results of this trade are in the variables lbits and dbits
  277.    below.  lbits is the number of bits the first level table for literal/
  278.    length codes can decode in one step, and dbits is the same thing for
  279.    the distance codes.  Subsequent tables are also less than or equal to
  280.    those sizes.  These values may be adjusted either when all of the
  281.    codes are shorter than that, in which case the longest code length in
  282.    bits is used, or when the shortest code is *longer* than the requested
  283.    table size, in which case the length of the shortest code in bits is
  284.    used.
  285.  
  286.    There are two different values for the two tables, since they code a
  287.    different number of possibilities each.  The literal/length table
  288.    codes 286 possible values, or in a flat code, a little over eight
  289.    bits.  The distance table codes 30 possible values, or a little less
  290.    than five bits, flat.  The optimum values for speed end up being
  291.    about one bit more than those, so lbits is 8+1 and dbits is 5+1.
  292.    The optimum values may differ though from machine to machine, and
  293.    possibly even between compilers.  Your mileage may vary.
  294. }
  295.  
  296. Const  lbits = 9 ; {bits in base literal/length lookup table}
  297.        dbits = 6 ; {bits in base distance lookup table}
  298.  
  299. {If BMAX needs to be larger than 16, then h and x[] should be LongInts.}
  300.  
  301. Const  BMAX = 16 ; {maximum bit length of any code (16 for explode)}
  302.        N_MAX = 288 ; {maximum number of codes in any set}
  303.  
  304. Var  hufts : Word ; {track memory usage}
  305.  
  306. {
  307.    Free the malloc'ed tables built by huft_build, which makes a linked
  308.    list of the tables it made, with the links in a dummy first entry of
  309.    each table.
  310. }
  311. Procedure  huft_free (
  312.    t : phuft {table to free}
  313.    ) ;
  314.  
  315.    Var  p,q : phuft ; {(register variables)}
  316.         alloc_tmp : Word ;
  317.  
  318.    Begin
  319.       {Go through linked list, freeing from the malloced (t[-1]) address.}
  320.       p := t ;
  321.       While p<>NIL Do BEgin
  322.          Dec (p) ;
  323.          q := p^.v.t ;
  324.          Dec (Word(p),2) ;
  325.          alloc_tmp := (pWord(p))^ ;
  326.          FreeMem (p,alloc_tmp) ;
  327.          p := q
  328.       End
  329.    End {huft_free} ;
  330.  
  331. {
  332.    Given a list of code lengths and a maximum table size, make a set of
  333.    tables to decode that set of codes.  Return zero on success, one if
  334.    the given code set is incomplete (the tables are still built in this
  335.    case), two if the input is invalid (all zero length codes or an
  336.    oversubscribed set of lengths), and three if not enough memory.
  337. }
  338. Function  huft_build (
  339.    b : pWord ;     {code lengths in bits (all assumed <= BMAX)}
  340.    n : Word ;      {number of codes (assumed <= N_MAX)}
  341.    s : Word ;      {number of simple-valued codes (0..s-1)}
  342.    d : pWord ;     {list of base values for non-simple codes}
  343.    e : pWord ;     {list of extra bits for non-simple codes}
  344.    t : pphuft ;    {result: starting table}
  345.    m : pInteger    {maximum lookup bits, returns actual}
  346.    ) : Integer ;
  347.  
  348.    Var  a : Word ;                    {counter for codes of length k}
  349.         c : Array [0..BMAX] Of Word ; {bit length count table}
  350.         f : Word ;                    {i repeats in table every f entries}
  351.         g : Integer ;                 {maximum code length}
  352.         h : Integer ;                 {table level}
  353.         i : Word ;                    {counter, current code (register variable)}
  354.         j : Word ;                    {counter (register variable)}
  355.         k : Integer ;                 {number of bits in current code (register variable)}
  356.         l : Integer ;                 {bits per table (returned in m)}
  357.         p : pWord ;                   {pointer into c[], b[], or v[] (register variable)}
  358.         q : phuft ;                   {points to current table (register variable)}
  359.         r : huft ;                    {table entry for structure assignment}
  360.         u : Array [0..BMAX-1] Of phuft ;{table stack}
  361.         v : Array [0..N_MAX-1] Of Word ;{values in order of bit length}
  362.         w : Integer ;                 {bits before this table = (l*h) (register variable)}
  363.         x : Array [0..BMAX] Of Word ; {bit offsets, then code stack}
  364.         xp : pWord ;                  {pointer into x}
  365.         y : Integer ;                 {number of dummy codes added}
  366.         z : Word ;                    {number of entries in current table}
  367.         alloc_tmp : Word ;
  368.         phuft_tmp : phuft ;
  369.         pword_tmp : pWord ;
  370.  
  371.    Begin
  372.       {Generate counts for each bit length}
  373.       FillChar (c,SizeOf(c),0) ;
  374.       p := b ;
  375.       i := n ;
  376.       Repeat
  377.          Inc (c[p^]) ; {assume all entries <= BMAX}
  378.          Inc (p) ;
  379.          Dec (i)
  380.       Until i=0 ;
  381.       If c[0]=n Then Begin {null input--all zero length codes}
  382.          t^ := NIL ;
  383.          m^ := 0 ;
  384.          huft_build := 0 ;
  385.          Exit
  386.       End ;
  387.  
  388.       {Find minimum and maximum length, bound m^ by those}
  389.       l := m^ ;
  390.       For j:=1 To BMAX Do
  391.          If c[j]<>0 Then
  392.             Break ;
  393.       k := j ; {minimum code length}
  394.       If l<j Then
  395.          l := j ;
  396.       For i:=BMAX DownTo 1 Do
  397.          If c[i]<>0 Then
  398.             Break ;
  399.       g := i ; {maximum code length}
  400.       If l>i Then
  401.          l := i ;
  402.       m^:= l ;
  403.  
  404.       {Adjust last length count to fill out codes, if needed}
  405.       y := 1 Shl j ;
  406.       While j<i Do Begin
  407.          Dec (y,c[j]) ;
  408.          If y<0 Then Begin
  409.             huft_build := 2 ; {bad input: more codes than bits}
  410.             Exit
  411.          End ;
  412.          Inc (j) ;
  413.          y := y Shl 1
  414.       End ;
  415.       Dec (y,c[i]) ;
  416.       If y<0 Then Begin
  417.          huft_build := 2 ; {bad input: more codes than bits}
  418.          Exit
  419.       End ;
  420.       Inc (c[i],y) ;
  421.  
  422.       {Generate starting offsets into the value table for each length}
  423.       x[1] := 0 ;
  424.       j := 0 ;
  425.       p := Addr(c[1]) ;
  426.       xp := Addr(x[2]) ;
  427.       Dec (i) ; {note that i=g from above}
  428.       While i<>0 Do Begin
  429.          Inc (j,p^) ;
  430.          Inc (p) ;
  431.          xp^ := j ;
  432.          Inc (xp) ;
  433.          Dec (i)
  434.       End ;
  435.  
  436.       {Make a table of values in order of bit lengths}
  437.       p := b ;
  438.       i := 0 ;
  439.       Repeat
  440.          j := p^ ;
  441.          Inc (p) ;
  442.          If j<>0 Then Begin
  443.             v[x[j]] := i ;
  444.             Inc (x[j])
  445.          End ;
  446.          Inc (i)
  447.       Until i>=n ;
  448.  
  449.       {Generate the Huffman codes and for each, make the table entries}
  450.       x[0] := 0 ; {first Huffman code is zero}
  451.       i := 0 ;
  452.       p := Addr(v) ; {grab values in bit order}
  453.       h := -1 ; {no tables yet--level -1}
  454.       w := -l ; {bits decoded = (l*h)}
  455.       u[0] := NIL ; {just to keep compilers happy}
  456.       q := NIL ; {ditto}
  457.       z := 0 ; {ditto}
  458.  
  459.       {go through the bit lengths (k already is bits in shortest code)}
  460.       While k<=g Do Begin
  461.          a := c[k] ;
  462.          While (a<>0) Do Begin
  463.             Dec (a) ;
  464.             {here i is the Huffman code of length k bits for value *p}
  465.             {make tables up to required level}
  466.             While k>w+l Do Begin
  467.                Inc (h) ;
  468.                Inc (w,l) ; {previous table always l bits}
  469.                {compute minimum size table less than or equal to l bits}
  470.                If g-w>l Then {upper limit on table size}
  471.                   z := l
  472.                Else
  473.                   z := g-w ;
  474.                j := k-w ; {try a k-w bit table}
  475.                f := 1 Shl j ;
  476.                If f>a+1 Then Begin {too few codes for k-w bit table}
  477.                   Dec (f,a+1) ; {deduct codes from patterns left}
  478.                   xp := Addr(c[k]) ;
  479.                   Inc (j) ;
  480.                   While j<z Do Begin {try smaller tables up to z bits}
  481.                      f := f Shl 1 ;
  482.                      Inc (xp) ;
  483.                      If f<=xp^ Then
  484.                         Break ; {enough codes to use up j bits}
  485.                      Dec (f,xp^) ; {else deduct codes from patterns}
  486.                      Inc (j)
  487.                   End ;
  488.                End ;
  489.                z := 1 Shl j ; {table entries for j-bit table}
  490.                {allocate and link in new table}
  491.                alloc_tmp := 2+(z+1)*SizeOf(huft) ;
  492.                GetMem (q,alloc_tmp) ;
  493.                If q=NIL Then Begin
  494.                   If h<>0 Then
  495.                      huft_free (u[0]) ;
  496.                   huft_build := 3 ; {not enough memory}
  497.                   Exit
  498.                End ;
  499.                pWord(q)^ := alloc_tmp ;
  500.                Inc (Word(q),2) ;
  501.                Inc (hufts,z+1) ; {track memory usage}
  502.                t^ := q ; Inc (t^) ; {link to list for huft_free()}
  503.                t := Addr(q^.v.t) ;
  504.                t^ := NIL ;
  505.                Inc (q) ;
  506.                u[h] := q ; {table starts after link}
  507.                {connect to last table, if there is one}
  508.                If h<>0 Then Begin
  509.                   x[h] := i ;        {save pattern for backing up}
  510.                   r.b := l ;         {bits to dump before this table}
  511.                   r.e := 16+j ;      {bits in this table}
  512.                   r.v.t := q ;       {pointer to this table}
  513.                   j := i Shr (w-l) ; {(get around Turbo C bug)}
  514.                   {u[h-1][j] := r}
  515.                   phuft_tmp := u[h-1] ;
  516.                   Inc (phuft_tmp,j) ;
  517.                   phuft_tmp^ := r     {connect to last table}
  518.                End ;
  519.             End ;
  520.             {set up table entry in r}
  521.             r.b := k-w ;
  522.             If LongInt(p)>=LongInt(@(v[n])) Then
  523.                r.e := 99 {out of values--invalid code}
  524.             Else If p^<s Then Begin
  525.                If p^<256 Then {256 is end-of-block code}
  526.                   r.e := 16
  527.                Else
  528.                   r.e := 15 ;
  529.                r.v.n := p^ ; {simple code is just the value}
  530.                Inc (p)
  531.             End
  532.             Else Begin
  533.                pword_tmp := e ;
  534.                Inc (pword_tmp,p^-s) ;
  535.                r.e := pword_tmp^ ; {non-simple--look up in lists}
  536.                pword_tmp := d ;
  537.                Inc (pword_tmp,p^-s) ;
  538.                r.v.n := pword_tmp^ ;
  539.                Inc (p)
  540.             End ;
  541.             {fill code-like entries with r}
  542.             f := 1 Shl (k-w) ;
  543.             j := i Shr w ;
  544.             While j<z Do Begin
  545.                phuft_tmp := q ;
  546.                Inc (phuft_tmp,j) ;
  547.                phuft_tmp^ := r ;
  548.                Inc (j,f)
  549.             End ;
  550.             {backwards increment the k-bit code i}
  551.             j := 1 Shl (k-1) ;
  552.             While (i And j)<>0 Do Begin
  553.                i := i XOr j ;
  554.                j := j Shr 1
  555.             End ;
  556.             i := i XOr j ;
  557.             {backup over finished tables}
  558.             While (i And (1 Shl w -1)) <> x[h] Do Begin
  559.                Dec (h) ; {don't need to update q}
  560.                Dec (w,l)
  561.             End ;
  562.  
  563.          End ;
  564.          Dec (a) ;
  565.  
  566.          Inc (k)
  567.       End ;
  568.       {Return 1 if we were given an incomplete table}
  569.       If (y<>0) And (g<>1) Then
  570.          huft_build := 1
  571.       Else
  572.          huft_build := 0
  573.    End {huft_build} ;
  574.  
  575. Const  mask_bits : Array [0..16] Of Word
  576.                  = (0,1,3,7,15,31,63,127,255,511,1023,
  577.                     2047,4095,8191,16383,32767,65535) ;
  578.  
  579. {
  580.    inflate (decompress) the codes in a deflated (compressed) block.
  581.    Return an error code or zero if it all goes ok.
  582. }
  583. Function  inflate_codes (
  584.    tl,td : phuft ; {literal/length and distance decoder tables}
  585.    bl,bd : Integer {number of bits decoded by tl[] and td[]}
  586.    ) : Integer ;
  587.  
  588.    Var  e : Word ;     {table entry flag/number of extra bits (register variable)}
  589.         n,d : Word ;   {length and index for copy}
  590.         w : Word ;     {current window position}
  591.         t : phuft ;    {pointer to table entry}
  592.         ml,md : Word ; {masks for bl and bd bits}
  593.         b : LongInt ;  {bit buffer (unsigned, register variable)}
  594.         k : Byte ;     {number of bits in bit buffer (register variable)}
  595.         i : Integer ;
  596.  
  597.    Begin
  598.       {make local copies of globals}
  599.       b := bb ; {initialize bit buffer}
  600.       k := bk ;
  601.       w := wp ; {initialize window position}
  602.       {inflate the coded data}
  603.       ml := mask_bits[bl] ; {precompute masks for speed}
  604.       md := mask_bits[bd] ;
  605.       While True Do Begin {do until end of block}
  606.          NEEDBITS (b,k,bl) ;
  607.          t := tl ;
  608.          Inc (t,b And ml) ;
  609.          e := t^.e ;
  610.          If e>16 Then
  611.             Repeat
  612.                If e=99 Then Begin
  613.                   inflate_codes := 1 ;
  614.                   Exit
  615.                End ;
  616.                DUMPBITS (b,k,t^.b) ;
  617.                Dec (e,16) ;
  618.                NEEDBITS (b,k,e) ;
  619.                t := t^.v.t ;
  620.                Inc (t,b And mask_bits[e]) ;
  621.                e := t^.e
  622.             Until e<=16 ;
  623.          DUMPBITS (b,k,t^.b) ;
  624.          If e=16 Then Begin {it's a literal}
  625.             slide^[w] := t^.v.n ;
  626.             Inc (w) ;
  627.             If w=WSIZE Then Begin
  628.                i := InflateFlush(w) ;
  629.                If i<>0 Then Begin
  630.                   inflate_codes := i ;
  631.                   Exit
  632.                End ;
  633.                w := 0
  634.             End
  635.          End
  636.          Else Begin {it's an EOB or a length}
  637.             {exit if end of block}
  638.             If e=15 Then
  639.                Break ;
  640.             {get length of block to copy}
  641.             NEEDBITS (b,k,e) ;
  642.             n := t^.v.n+(b And mask_bits[e]) ;
  643.             DUMPBITS (b,k,e) ;
  644.             {decode distance of block to copy}
  645.             NEEDBITS (b,k,bd) ;
  646.             t := td ;
  647.             Inc (t,b And md) ;
  648.             e := t^.e ;
  649.             If e>16 Then
  650.                Repeat
  651.                   If e=99 Then Begin
  652.                      inflate_codes := 1 ;
  653.                      Exit
  654.                   End ;
  655.                   DUMPBITS (b,k,t^.b) ;
  656.                   Dec (e,16) ;
  657.                   NEEDBITS (b,k,e) ;
  658.                   t := t^.v.t ;
  659.                   Inc (t,b And mask_bits[e]) ;
  660.                   e := t^.e
  661.                Until e<=16 ;
  662.             DUMPBITS (b,k,t^.b) ;
  663.             NEEDBITS (b,k,e) ;
  664.             d := w-t^.v.n-Word(b And mask_bits[e]) ;
  665.             DUMPBITS (b,k,e) ;
  666.             {do the copy}
  667.             Repeat
  668.                d := d And (WSIZE-1) ;
  669.                If d>w Then
  670.                   e := WSIZE-d
  671.                Else
  672.                   e := WSIZE-w ;
  673.                If e>n Then
  674.                   e := n ;
  675.                Dec (n,e) ;
  676.                While e>0 Do Begin
  677.                   slide^[w] := slide^[d] ;
  678.                   Inc (w) ;
  679.                   Inc (d) ;
  680.                   Dec (e)
  681.                End ;
  682.                If w=WSIZE Then Begin
  683.                   i := InflateFlush(w) ;
  684.                   If i<>0 Then Begin
  685.                      inflate_codes := i ;
  686.                      Exit
  687.                   End ;
  688.                   w := 0
  689.                End
  690.             Until n=0 ;
  691.          End
  692.       End ;
  693.       {restore the globals from the locals}
  694.       wp := w ; {restore global window pointer}
  695.       bb := b ; {restore global bit buffer}
  696.       bk := k ;
  697.       {done}
  698.       inflate_codes := 0
  699.    End {inflate_codes} ;
  700.  
  701. {
  702.    "decompress" an inflated type 0 (stored) block.
  703. }
  704. Function inflate_stored : Integer ;
  705.  
  706.    Var  n : Word ;    {number of bytes in block}
  707.         w : Word ;    {current window position}
  708.         b : LongInt ; {bit buffer (unsigned, register variable)}
  709.         k : Byte ;    {number of bits in bit buffer (register variable)}
  710.         i : Integer ;
  711.  
  712.    Begin
  713.       {make local copies of globals}
  714.       b := bb ; {initialize bit buffer}
  715.       k := bk ;
  716.       w := wp ; {initialize window position}
  717.       {go to byte boundary}
  718.       n := k And 7 ;
  719.       DUMPBITS (b,k,n) ;
  720.       {get the length and its complement}
  721.       NEEDBITS (b,k,16) ;
  722.       n := (b And $ffff) ;
  723.       DUMPBITS (b,k,16) ;
  724.       NEEDBITS (b,k,16) ;
  725.       If n<>((Not b) And $ffff) Then Begin
  726.          inflate_stored := 1 ; {error in compressed data}
  727.          Exit
  728.       End ;
  729.       DUMPBITS (b,k,16) ;
  730.       {read and output the compressed data}
  731.       While n<>0 Do Begin
  732.          Dec (n) ;
  733.          NEEDBITS (b,k,8) ;
  734.          slide^[w] := b ;
  735.          Inc (w) ;
  736.          If w=WSIZE Then Begin
  737.             i := InflateFlush(w) ;
  738.             If i<>0 Then Begin
  739.                inflate_stored := i ;
  740.                Exit
  741.             End ;
  742.             w := 0
  743.          End ;
  744.          DUMPBITS (b,k,8)
  745.       End ;
  746.       {restore the globals from the locals}
  747.       wp := w ;  {restore global window pointer}
  748.       bb := b ;  {restore global bit buffer}
  749.       bk := k ;
  750.       inflate_stored := 0
  751.    End {inflate_stored} ;
  752.  
  753. {
  754.    decompress a deflated type 1 (fixed Huffman codes) block.  We should
  755.    either replace this with a custom decoder, or at least precompute the
  756.    Huffman tables.
  757. }
  758. Function  inflate_fixed : Integer ;
  759.  
  760.    Var  i : Integer ;  {temporary variable}
  761.         tl : phuft ;   {literal/length code table}
  762.         td : phuft ;   {distance code table}
  763.         bl : Integer ; {lookup bits for tl}
  764.         bd : Integer ; {lookup bits for td}
  765.         l : Array [0..287] Of Word ; {length list for huft_build}
  766.  
  767.    Begin
  768.       {set up literal table}
  769.       For i:=0 To 143 Do
  770.          l[i] := 8 ;
  771.       For i:=144 To 255 Do
  772.          l[i] := 9 ;
  773.       For i:=256 To 279 Do
  774.          l[i] := 7 ;
  775.       For i:=280 To 287 Do {make a complete, but wrong code set}
  776.          l[i] := 8 ;
  777.       bl := 7 ;
  778.       i := huft_build(@l,288,257,@cplens,@cplext,Addr(tl),Addr(bl)) ;
  779.       If i<>0 Then Begin
  780.          inflate_fixed := i ;
  781.          Exit
  782.       End ;
  783.       {set up distance table}
  784.       For i:=0 To 29 Do {make an incomplete code set}
  785.          l[i] := 5 ;
  786.       bd := 5 ;
  787.       i := huft_build(@l,30,0,@cpdist,@cpdext,Addr(td),Addr(bd)) ;
  788.       If i>1 Then Begin
  789.          huft_free (tl) ;
  790.          inflate_fixed := i ;
  791.          Exit
  792.       End ;
  793.       {decompress until an end-of-block code}
  794.       i := inflate_codes(tl,td,bl,bd) ;
  795.       If i<>0 Then Begin
  796.          inflate_fixed := i ;
  797.          huft_free (tl) ;
  798.          huft_free (td) ;
  799.          Exit
  800.       End ;
  801.       {free the decoding tables, return}
  802.       huft_free (tl) ;
  803.       huft_free (td) ;
  804.       inflate_fixed := 0
  805.    End {inflate_fixed} ;
  806.  
  807. {
  808.    decompress an inflated type 2 (dynamic Huffman codes) block.
  809. }
  810. Function  inflate_dynamic : Integer ;
  811.  
  812.    Var  i : Integer ;  {temporary variables}
  813.         j : Word ;
  814.         l : Word ;     {last length}
  815.         m : Word ;     {mask for bit lengths table}
  816.         n : Word ;     {number of lengths to get}
  817.         tl : phuft ;   {literal/length code table}
  818.         td : phuft ;   {distance code table}
  819.         bl : Integer ; {lookup bits for tl}
  820.         bd : Integer ; {lookup bits for td}
  821.         nb : Word ;    {number of bit length codes}
  822.         nl : Word ;    {number of literal/length codes}
  823.         nd : Word ;    {number of distance codes}
  824.         ll : Array [0..286+30-1] Of Word ;  {literal/length and distance code lengths}
  825.         b : LongInt ;  {bit buffer (unsigned, register variable)}
  826.         k : Byte ;     {number of bits in bit buffer (register variable)}
  827.  
  828.    Begin
  829.       {make local bit buffer}
  830.       b := bb ;
  831.       k := bk ;
  832.       {read in table lengths}
  833.       NEEDBITS (b,k,5) ;
  834.       nl := 257+(b And $1f) ; {number of literal/length codes}
  835.       DUMPBITS (b,k,5) ;
  836.       NEEDBITS (b,k,5) ;
  837.       nd := 1+(b And $1f) ; {number of distance codes}
  838.       DUMPBITS (b,k,5) ;
  839.       NEEDBITS (b,k,4) ;
  840.       nb := 4+(b And $f) ; {number of bit length codes}
  841.       DUMPBITS (b,k,4) ;
  842.       If (nl>286) Or (nd>30) Then Begin
  843.          inflate_dynamic := 1 ; {bad lengths}
  844.          Exit
  845.       End ;
  846.       {read in bit-length-code lengths}
  847.       For j:=0 To nb-1 Do Begin
  848.          NEEDBITS (b,k,3) ;
  849.          ll[border[j]] := b And 7 ;
  850.          DUMPBITS (b,k,3)
  851.       End ;
  852.       For j:=nb To 18 Do
  853.          ll[border[j]] := 0 ;
  854.       {build decoding table for trees--single level, 7 bit lookup}
  855.       bl := 7 ;
  856.       i := huft_build(@ll,19,19,NIL,NIL,Addr(tl),Addr(bl)) ;
  857.       If i<>0 Then Begin
  858.          If i=1 Then
  859.             huft_free (tl) ;
  860.          inflate_dynamic := i ; {incomplete code set}
  861.          Exit
  862.       End ;
  863.       {read in literal and distance code lengths}
  864.       n := nl+nd ;
  865.       m := mask_bits[bl] ;
  866.       l := 0 ;
  867.       i := 0 ;
  868.       While i<n Do Begin
  869.          NEEDBITS (b,k,bl) ;
  870.          td := tl ;
  871.          Inc (td,b And m) ;
  872.          j := td^.b ;
  873.          DUMPBITS (b,k,j) ;
  874.          j := td^.v.n ;
  875.          If j<16 Then Begin {length of code in bits (0..15)}
  876.             l := j ; {save last length in l}
  877.             ll[i] := j ;
  878.             Inc (i)
  879.          End
  880.          Else If j=16 Then Begin {repeat last length 3 to 6 times}
  881.             NEEDBITS (b,k,2) ;
  882.             j := 3+(b And 3) ;
  883.             DUMPBITS (b,k,2) ;
  884.             If i+j>n Then Begin
  885.                inflate_dynamic := 1 ;
  886.                Exit
  887.             End ;
  888.             While j<>0 Do Begin
  889.                Dec (j) ;
  890.                ll[i] := l ;
  891.                Inc (i)
  892.             End ;
  893.             Dec (j)
  894.          End
  895.          Else If j=17 Then Begin {3 to 10 zero length codes}
  896.             NEEDBITS (b,k,3) ;
  897.             j := 3+(b And 7) ;
  898.             DUMPBITS (b,k,3) ;
  899.             If i+j>n Then Begin
  900.                inflate_dynamic := 1 ;
  901.                Exit
  902.             End ;
  903.             While j<>0 Do Begin
  904.                Dec (j) ;
  905.                ll[i] := 0 ;
  906.                Inc (i)
  907.             End ;
  908.             Dec (j) ;
  909.             l := 0
  910.          End
  911.          Else Begin {j=18: 11 to 138 zero length codes}
  912.             NEEDBITS (b,k,7) ;
  913.             j := 11+(b And $7f) ;
  914.             DUMPBITS (b,k,7) ;
  915.             If i+j>n Then Begin
  916.                inflate_dynamic := 1 ;
  917.                Exit
  918.             End ;
  919.             While j<>0 Do Begin
  920.                Dec (j) ;
  921.                ll[i] := 0 ;
  922.                Inc (i)
  923.             End ;
  924.             Dec (j) ;
  925.             l := 0
  926.          End
  927.       End ;
  928.       {free decoding table for trees}
  929.       huft_free (tl) ;
  930.       {restore the global bit buffer}
  931.       bb := b ;
  932.       bk := k ;
  933.       {build the decoding tables for literal/length and distance codes}
  934.       bl := lbits ;
  935.       i := huft_build(@ll,nl,257,@cplens,@cplext,Addr(tl),Addr(bl)) ;
  936.       If i<>0 Then Begin
  937.          if i=1 Then
  938.             huft_free (tl) ;
  939.          inflate_dynamic := i ; {incomplete code set}
  940.          Exit
  941.       End ;
  942.       bd := dbits ;
  943.       i := huft_build(@(ll[nl]),nd,0,@cpdist,@cpdext,Addr(td),Addr(bd)) ;
  944.       If i<>0 Then Begin
  945.          if i=1 Then
  946.             huft_free (td) ;
  947.          huft_free (tl) ;
  948.          inflate_dynamic := i ; {incomplete code set}
  949.          Exit
  950.       End ;
  951.       {decompress until an end-of-block code}
  952.       i := inflate_codes(tl,td,bl,bd) ;
  953.       If i<>0 Then Begin
  954.          inflate_dynamic := i ;
  955.          huft_free (tl) ;
  956.          huft_free (td) ;
  957.          Exit
  958.       End ;
  959.       {free the decoding tables, return}
  960.       huft_free (tl) ;
  961.       huft_free (td) ;
  962.       inflate_dynamic := 0
  963.    End {inflate_dynamic} ;
  964.  
  965. {
  966.    decompress an inflated block
  967. }
  968. Function  inflate_block (
  969.    e : pInteger {last block flag}
  970.    ) : Integer ;
  971.  
  972.    Var  t : Word ;    {block type}
  973.         b : LongInt ; {bit buffer (unsigned, register variable)}
  974.         k : Byte ;    {number of bits in bit buffer (register variable)}
  975.  
  976.    Begin
  977.       {make local bit buffer}
  978.       b := bb ;
  979.       k := bk ;
  980.       {read in last block bit}
  981.       NEEDBITS (b,k,1) ;
  982.       e^ := b And 1 ;
  983.       DUMPBITS (b,k,1) ;
  984.       {read in block type}
  985.       NEEDBITS (b,k,2) ;
  986.       t := b And 3 ;
  987.       DUMPBITS (b,k,2) ;
  988.       {restore the global bit buffer}
  989.       bb := b ;
  990.       bk := k ;
  991.       {inflate that block type}
  992.       Case t Of
  993.          2 : inflate_block := inflate_dynamic ;
  994.          0 : inflate_block := inflate_stored ;
  995.          1 : inflate_block := inflate_fixed
  996.       Else
  997.          inflate_block := 2 {bad block type}
  998.       End
  999.    End {inflate_block} ;
  1000.  
  1001. {
  1002.    decompress an inflated entry
  1003. }
  1004. Function  InflateRun : Integer ;
  1005.  
  1006.    Var  e : Integer ; {last block flag}
  1007.         r : Integer ; {result code}
  1008.         h : Word ;    {maximum struct huft's malloc'ed}
  1009.  
  1010.    Begin
  1011.       {initialize window, bit buffer}
  1012.       wp := 0 ;
  1013.       bk := 0 ;
  1014.       bb := 0 ;
  1015.       {decompress until the last block}
  1016.       h := 0 ;
  1017.       Repeat
  1018.          hufts := 0 ;
  1019.          r := inflate_block(Addr(e)) ;
  1020.          if r<>0 Then Begin
  1021.             InflateRun := r ;
  1022.             Exit
  1023.          End ;
  1024.          If hufts>h Then
  1025.             h := hufts
  1026.       Until e<>0 ;
  1027.       {flush out slide, return error code}
  1028.       InflateRun := InflateFlush(wp)
  1029.    End {InflateRun} ;
  1030.  
  1031. Begin
  1032.    slide := NIL
  1033. End.
  1034.