home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / unity / d5 / JRZIP.ZIP / Zlib / infcodes.pas < prev    next >
Pascal/Delphi Source File  |  1998-06-14  |  16KB  |  576 lines
  1. Unit InfCodes;
  2.  
  3. { infcodes.c -- process literals and length/distance pairs
  4.   Copyright (C) 1995-1998 Mark Adler
  5.  
  6.   Pascal tranlastion
  7.   Copyright (C) 1998 by Jacques Nomssi Nzali
  8.   For conditions of distribution and use, see copyright notice in readme.txt
  9. }
  10.  
  11. interface
  12.  
  13. {$I zconf.inc}
  14.  
  15. uses
  16.   {$IFDEF DEBUG}
  17.   strutils,
  18.   {$ENDIF}
  19.   zutil, zlib;
  20.  
  21. function inflate_codes_new (bl : uInt;
  22.                             bd : uInt;
  23.                             tl : pInflate_huft;
  24.                             td : pInflate_huft;
  25.                             var z : z_stream): pInflate_codes_state;
  26.  
  27. function inflate_codes(var s : inflate_blocks_state;
  28.                        var z : z_stream;
  29.                        r : int) : int;
  30.  
  31. procedure inflate_codes_free(c : pInflate_codes_state;
  32.                              var z : z_stream);
  33.  
  34. implementation
  35.  
  36. uses
  37.   infutil, inffast;
  38.  
  39.  
  40. function inflate_codes_new (bl : uInt;
  41.                             bd : uInt;
  42.                             tl : pInflate_huft;
  43.                             td : pInflate_huft;
  44.                             var z : z_stream): pInflate_codes_state;
  45. var
  46.  c : pInflate_codes_state;
  47. begin
  48.   c := pInflate_codes_state( ZALLOC(z,1,sizeof(inflate_codes_state)) );
  49.   if (c <> Z_NULL) then
  50.   begin
  51.     c^.mode := START;
  52.     c^.lbits := Byte(bl);
  53.     c^.dbits := Byte(bd);
  54.     c^.ltree := tl;
  55.     c^.dtree := td;
  56.     {$IFDEF DEBUG}
  57.     Tracev('inflate:       codes new');
  58.     {$ENDIF}
  59.   end;
  60.   inflate_codes_new := c;
  61. end;
  62.  
  63.  
  64. function inflate_codes(var s : inflate_blocks_state;
  65.                        var z : z_stream;
  66.                        r : int) : int;
  67. var
  68.   j : uInt;               { temporary storage }
  69.   t : pInflate_huft;      { temporary pointer }
  70.   e : uInt;               { extra bits or operation }
  71.   b : uLong;              { bit buffer }
  72.   k : uInt;               { bits in bit buffer }
  73.   p : pBytef;             { input data pointer }
  74.   n : uInt;               { bytes available there }
  75.   q : pBytef;             { output window write pointer }
  76.   m : uInt;               { bytes to end of window or read pointer }
  77.   f : pBytef;             { pointer to copy strings from }
  78. var
  79.   c : pInflate_codes_state;
  80. begin
  81.   c := s.sub.decode.codes;  { codes state }
  82.  
  83.   { copy input/output information to locals }
  84.   p := z.next_in;
  85.   n := z.avail_in;
  86.   b := s.bitb;
  87.   k := s.bitk;
  88.   q := s.write;
  89.   if ptr2int(q) < ptr2int(s.read) then
  90.     m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  91.   else
  92.     m := uInt(ptr2int(s.zend)-ptr2int(q));
  93.  
  94.   { process input and output based on current state }
  95.   while True do
  96.   case (c^.mode) of
  97.     { waiting for "i:"=input, "o:"=output, "x:"=nothing }
  98.   START:         { x: set up for LEN }
  99.     begin
  100. {$ifndef SLOW}
  101.       if (m >= 258) and (n >= 10) then
  102.       begin
  103.         {UPDATE}
  104.         s.bitb := b;
  105.         s.bitk := k;
  106.         z.avail_in := n;
  107.         Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  108.         z.next_in := p;
  109.         s.write := q;
  110.  
  111.         r := inflate_fast(c^.lbits, c^.dbits, c^.ltree, c^.dtree, s, z);
  112.         {LOAD}
  113.         p := z.next_in;
  114.         n := z.avail_in;
  115.         b := s.bitb;
  116.         k := s.bitk;
  117.         q := s.write;
  118.         if ptr2int(q) < ptr2int(s.read) then
  119.           m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  120.         else
  121.           m := uInt(ptr2int(s.zend)-ptr2int(q));
  122.  
  123.         if (r <> Z_OK) then
  124.         begin
  125.           if (r = Z_STREAM_END) then
  126.             c^.mode := WASH
  127.           else
  128.             c^.mode := BADCODE;
  129.           continue;    { break for switch-statement in C }
  130.         end;
  131.       end;
  132. {$endif} { not SLOW }
  133.       c^.sub.code.need := c^.lbits;
  134.       c^.sub.code.tree := c^.ltree;
  135.       c^.mode := LEN;  { falltrough }
  136.     end;
  137.   LEN:           { i: get length/literal/eob next }
  138.     begin
  139.       j := c^.sub.code.need;
  140.       {NEEDBITS(j);}
  141.       while (k < j) do
  142.       begin
  143.         {NEEDBYTE;}
  144.         if (n <> 0) then
  145.           r :=Z_OK
  146.         else
  147.         begin
  148.           {UPDATE}
  149.           s.bitb := b;
  150.           s.bitk := k;
  151.           z.avail_in := n;
  152.           Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  153.           z.next_in := p;
  154.           s.write := q;
  155.           inflate_codes := inflate_flush(s,z,r);
  156.           exit;
  157.         end;
  158.         Dec(n);
  159.         b := b or (uLong(p^) shl k);
  160.         Inc(p);
  161.         Inc(k, 8);
  162.       end;
  163.       t := c^.sub.code.tree;
  164.       Inc(t, uInt(b) and inflate_mask[j]);
  165.       {DUMPBITS(t^.bits);}
  166.       b := b shr t^.bits;
  167.       Dec(k, t^.bits);
  168.  
  169.       e := uInt(t^.exop);
  170.       if (e = 0) then            { literal }
  171.       begin
  172.         c^.sub.lit := t^.base;
  173.        {$IFDEF DEBUG}
  174.         if (t^.base >= $20) and (t^.base < $7f) then
  175.           Tracevv('inflate:         literal '+char(t^.base))
  176.         else
  177.           Tracevv('inflate:         literal '+IntToStr(t^.base));
  178.         {$ENDIF}          
  179.         c^.mode := LIT;
  180.         continue;  { break switch statement }
  181.       end;
  182.       if (e and 16 <> 0) then            { length }
  183.       begin
  184.         c^.sub.copy.get := e and 15;
  185.         c^.len := t^.base;
  186.         c^.mode := LENEXT;
  187.         continue;         { break C-switch statement }
  188.       end;
  189.       if (e and 64 = 0) then             { next table }
  190.       begin
  191.         c^.sub.code.need := e;
  192.         c^.sub.code.tree := @huft_ptr(t)^[t^.base];
  193.         continue;         { break C-switch statement }
  194.       end;
  195.       if (e and 32 <> 0) then            { end of block }
  196.       begin
  197.         {$IFDEF DEBUG}
  198.         Tracevv('inflate:         end of block');
  199.         {$ENDIF}        
  200.         c^.mode := WASH;
  201.         continue;         { break C-switch statement }
  202.       end;
  203.       c^.mode := BADCODE;        { invalid code }
  204.       z.msg := 'invalid literal/length code';
  205.       r := Z_DATA_ERROR;
  206.       {UPDATE}
  207.       s.bitb := b;
  208.       s.bitk := k;
  209.       z.avail_in := n;
  210.       Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  211.       z.next_in := p;
  212.       s.write := q;
  213.       inflate_codes := inflate_flush(s,z,r);
  214.       exit;
  215.     end;
  216.   LENEXT:        { i: getting length extra (have base) }
  217.     begin
  218.       j := c^.sub.copy.get;
  219.       {NEEDBITS(j);}
  220.       while (k < j) do
  221.       begin
  222.         {NEEDBYTE;}
  223.         if (n <> 0) then
  224.           r :=Z_OK
  225.         else
  226.         begin
  227.           {UPDATE}
  228.           s.bitb := b;
  229.           s.bitk := k;
  230.           z.avail_in := n;
  231.           Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  232.           z.next_in := p;
  233.           s.write := q;
  234.           inflate_codes := inflate_flush(s,z,r);
  235.           exit;
  236.         end;
  237.         Dec(n);
  238.         b := b or (uLong(p^) shl k);
  239.         Inc(p);
  240.         Inc(k, 8);
  241.       end;
  242.       Inc(c^.len, uInt(b and inflate_mask[j]));
  243.       {DUMPBITS(j);}
  244.       b := b shr j;
  245.       Dec(k, j);
  246.  
  247.       c^.sub.code.need := c^.dbits;
  248.       c^.sub.code.tree := c^.dtree;
  249.       {$IFDEF DEBUG}
  250.       Tracevv('inflate:         length '+IntToStr(c^.len));
  251.       {$ENDIF}
  252.       c^.mode := DIST;
  253.       { falltrough }
  254.     end;
  255.   DIST:          { i: get distance next }
  256.     begin
  257.       j := c^.sub.code.need;
  258.       {NEEDBITS(j);}
  259.       while (k < j) do
  260.       begin
  261.         {NEEDBYTE;}
  262.         if (n <> 0) then
  263.           r :=Z_OK
  264.         else
  265.         begin
  266.           {UPDATE}
  267.           s.bitb := b;
  268.           s.bitk := k;
  269.           z.avail_in := n;
  270.           Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  271.           z.next_in := p;
  272.           s.write := q;
  273.           inflate_codes := inflate_flush(s,z,r);
  274.           exit;
  275.         end;
  276.         Dec(n);
  277.         b := b or (uLong(p^) shl k);
  278.         Inc(p);
  279.         Inc(k, 8);
  280.       end;
  281.       t := @huft_ptr(c^.sub.code.tree)^[uInt(b) and inflate_mask[j]];
  282.       {DUMPBITS(t^.bits);}
  283.       b := b shr t^.bits;
  284.       Dec(k, t^.bits);
  285.  
  286.       e := uInt(t^.exop);
  287.       if (e and 16 <> 0) then            { distance }
  288.       begin
  289.         c^.sub.copy.get := e and 15;
  290.         c^.sub.copy.dist := t^.base;
  291.         c^.mode := DISTEXT;
  292.         continue;     { break C-switch statement }
  293.       end;
  294.       if (e and 64 = 0) then     { next table }
  295.       begin
  296.         c^.sub.code.need := e;
  297.         c^.sub.code.tree := @huft_ptr(t)^[t^.base];
  298.         continue;     { break C-switch statement }
  299.       end;
  300.       c^.mode := BADCODE;        { invalid code }
  301.       z.msg := 'invalid distance code';
  302.       r := Z_DATA_ERROR;
  303.       {UPDATE}
  304.       s.bitb := b;
  305.       s.bitk := k;
  306.       z.avail_in := n;
  307.       Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  308.       z.next_in := p;
  309.       s.write := q;
  310.       inflate_codes := inflate_flush(s,z,r);
  311.       exit;
  312.     end;
  313.   DISTEXT:       { i: getting distance extra }
  314.     begin
  315.       j := c^.sub.copy.get;
  316.       {NEEDBITS(j);}
  317.       while (k < j) do
  318.       begin
  319.         {NEEDBYTE;}
  320.         if (n <> 0) then
  321.           r :=Z_OK
  322.         else
  323.         begin
  324.           {UPDATE}
  325.           s.bitb := b;
  326.           s.bitk := k;
  327.           z.avail_in := n;
  328.           Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  329.           z.next_in := p;
  330.           s.write := q;
  331.           inflate_codes := inflate_flush(s,z,r);
  332.           exit;
  333.         end;
  334.         Dec(n);
  335.         b := b or (uLong(p^) shl k);
  336.         Inc(p);
  337.         Inc(k, 8);
  338.       end;
  339.       Inc(c^.sub.copy.dist, uInt(b) and inflate_mask[j]);
  340.       {DUMPBITS(j);}
  341.       b := b shr j;
  342.       Dec(k, j);
  343.       {$IFDEF DEBUG}
  344.       Tracevv('inflate:         distance '+ IntToStr(c^.sub.copy.dist));
  345.       {$ENDIF}
  346.       c^.mode := COPY;
  347.       { falltrough }
  348.     end;
  349.   COPY:          { o: copying bytes in window, waiting for space }
  350.     begin
  351.       f := q;
  352.       Dec(f, c^.sub.copy.dist);
  353.       if (uInt(ptr2int(q) - ptr2int(s.window)) < c^.sub.copy.dist) then
  354.       begin
  355.         f := s.zend;
  356.         Dec(f, c^.sub.copy.dist - uInt(ptr2int(q) - ptr2int(s.window)));
  357.       end;
  358.  
  359.       while (c^.len <> 0) do
  360.       begin
  361.         {NEEDOUT}
  362.         if (m = 0) then
  363.         begin
  364.           {WRAP}
  365.           if (q = s.zend) and (s.read <> s.window) then
  366.           begin
  367.             q := s.window;
  368.             if ptr2int(q) < ptr2int(s.read) then
  369.               m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  370.             else
  371.               m := uInt(ptr2int(s.zend)-ptr2int(q));
  372.           end;
  373.  
  374.           if (m = 0) then
  375.           begin
  376.             {FLUSH}
  377.             s.write := q;
  378.             r := inflate_flush(s,z,r);
  379.             q := s.write;
  380.             if ptr2int(q) < ptr2int(s.read) then
  381.               m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  382.             else
  383.               m := uInt(ptr2int(s.zend)-ptr2int(q));
  384.  
  385.             {WRAP}
  386.             if (q = s.zend) and (s.read <> s.window) then
  387.             begin
  388.               q := s.window;
  389.               if ptr2int(q) < ptr2int(s.read) then
  390.                 m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  391.               else
  392.                 m := uInt(ptr2int(s.zend)-ptr2int(q));
  393.             end;
  394.  
  395.             if (m = 0) then
  396.             begin
  397.               {UPDATE}
  398.               s.bitb := b;
  399.               s.bitk := k;
  400.               z.avail_in := n;
  401.               Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  402.               z.next_in := p;
  403.               s.write := q;
  404.               inflate_codes := inflate_flush(s,z,r);
  405.               exit;
  406.             end;
  407.           end;
  408.         end;
  409.         r := Z_OK;
  410.  
  411.         {OUTBYTE( *f++)}
  412.         q^ := f^;
  413.         Inc(q);
  414.         Inc(f);
  415.         Dec(m);
  416.  
  417.         if (f = s.zend) then
  418.           f := s.window;
  419.         Dec(c^.len);
  420.       end;
  421.       c^.mode := START;
  422.       { C-switch break; not needed }
  423.     end;
  424.   LIT:           { o: got literal, waiting for output space }
  425.     begin
  426.       {NEEDOUT}
  427.       if (m = 0) then
  428.       begin
  429.         {WRAP}
  430.         if (q = s.zend) and (s.read <> s.window) then
  431.         begin
  432.           q := s.window;
  433.           if ptr2int(q) < ptr2int(s.read) then
  434.             m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  435.           else
  436.             m := uInt(ptr2int(s.zend)-ptr2int(q));
  437.         end;
  438.  
  439.         if (m = 0) then
  440.         begin
  441.           {FLUSH}
  442.           s.write := q;
  443.           r := inflate_flush(s,z,r);
  444.           q := s.write;
  445.           if ptr2int(q) < ptr2int(s.read) then
  446.             m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  447.           else
  448.             m := uInt(ptr2int(s.zend)-ptr2int(q));
  449.  
  450.           {WRAP}
  451.           if (q = s.zend) and (s.read <> s.window) then
  452.           begin
  453.             q := s.window;
  454.             if ptr2int(q) < ptr2int(s.read) then
  455.               m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  456.             else
  457.               m := uInt(ptr2int(s.zend)-ptr2int(q));
  458.           end;
  459.  
  460.           if (m = 0) then
  461.           begin
  462.             {UPDATE}
  463.             s.bitb := b;
  464.             s.bitk := k;
  465.             z.avail_in := n;
  466.             Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  467.             z.next_in := p;
  468.             s.write := q;
  469.             inflate_codes := inflate_flush(s,z,r);
  470.             exit;
  471.           end;
  472.         end;
  473.       end;
  474.       r := Z_OK;
  475.  
  476.       {OUTBYTE(c^.sub.lit);}
  477.       q^ := c^.sub.lit;
  478.       Inc(q);
  479.       Dec(m);
  480.  
  481.       c^.mode := START;
  482.       {break;}
  483.     end;
  484.   WASH:          { o: got eob, possibly more output }
  485.     begin
  486.       {$ifdef patch112}
  487.       if (k > 7) then           { return unused byte, if any }
  488.       begin
  489.         {$IFDEF DEBUG}
  490.         Assert(k < 16, 'inflate_codes grabbed too many bytes');
  491.         {$ENDIF}
  492.         Dec(k, 8);
  493.         Inc(n);
  494.         Dec(p);                    { can always return one }
  495.       end;
  496.       {$endif}
  497.       {FLUSH}
  498.       s.write := q;
  499.       r := inflate_flush(s,z,r);
  500.       q := s.write;
  501.       if ptr2int(q) < ptr2int(s.read) then
  502.         m := uInt(ptr2int(s.read)-ptr2int(q)-1)
  503.       else
  504.         m := uInt(ptr2int(s.zend)-ptr2int(q));
  505.  
  506.       if (s.read <> s.write) then
  507.       begin
  508.         {UPDATE}
  509.         s.bitb := b;
  510.         s.bitk := k;
  511.         z.avail_in := n;
  512.         Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  513.         z.next_in := p;
  514.         s.write := q;
  515.         inflate_codes := inflate_flush(s,z,r);
  516.         exit;
  517.       end;
  518.       c^.mode := ZEND;
  519.       { falltrough }
  520.     end;
  521.  
  522.   ZEND:
  523.     begin
  524.       r := Z_STREAM_END;
  525.       {UPDATE}
  526.       s.bitb := b;
  527.       s.bitk := k;
  528.       z.avail_in := n;
  529.       Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  530.       z.next_in := p;
  531.       s.write := q;
  532.       inflate_codes := inflate_flush(s,z,r);
  533.       exit;
  534.     end;
  535.   BADCODE:       { x: got error }
  536.     begin
  537.       r := Z_DATA_ERROR;
  538.       {UPDATE}
  539.       s.bitb := b;
  540.       s.bitk := k;
  541.       z.avail_in := n;
  542.       Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  543.       z.next_in := p;
  544.       s.write := q;
  545.       inflate_codes := inflate_flush(s,z,r);
  546.       exit;
  547.     end;
  548.   else
  549.     begin
  550.       r := Z_STREAM_ERROR;
  551.       {UPDATE}
  552.       s.bitb := b;
  553.       s.bitk := k;
  554.       z.avail_in := n;
  555.       Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
  556.       z.next_in := p;
  557.       s.write := q;
  558.       inflate_codes := inflate_flush(s,z,r);
  559.       exit;
  560.     end;
  561.   end;
  562. {NEED_DUMMY_RETURN - Delphi2+ dumb compilers complain without this }
  563.   inflate_codes := Z_STREAM_ERROR;
  564. end;
  565.  
  566.  
  567. procedure inflate_codes_free(c : pInflate_codes_state;
  568.                              var z : z_stream);
  569. begin
  570.   ZFREE(z, c);
  571.   {$IFDEF DEBUG}  
  572.   Tracev('inflate:       codes free');
  573.   {$ENDIF}
  574. end;
  575.  
  576. end.