src/lib/vampimg/ZLib/iminfcodes.pas

   1 Unit iminfcodes;
   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 imzconf.inc}
  14
  15 uses
  16   {$IFDEF DEBUG}
  17   SysUtils, strutils,
  18   {$ENDIF}
  19   imzutil, impaszlib;
  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   iminfutil, iminffast;
  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 '+AnsiChar(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.