zdeflate.pas

   1 Unit zDeflate;\r
   2 \r
   3 { Orginal: deflate.h -- internal compression state\r
   4            deflate.c -- compress data using the deflation algorithm\r
   5   Copyright (C) 1995-1996 Jean-loup Gailly.\r
   6 \r
   7   Pascal tranlastion\r
   8   Copyright (C) 1998 by Jacques Nomssi Nzali\r
   9   For conditions of distribution and use, see copyright notice in readme.paszlib\r
  10 }\r
  11 \r
  12 \r
  13 {  ALGORITHM\r
  14 \r
  15        The "deflation" process depends on being able to identify portions\r
  16        of the input text which are identical to earlier input (within a\r
  17        sliding window trailing behind the input currently being processed).\r
  18 \r
  19        The most straightforward technique turns out to be the fastest for\r
  20        most input files: try all possible matches and select the longest.\r
  21        The key feature of this algorithm is that insertions into the string\r
  22        dictionary are very simple and thus fast, and deletions are avoided\r
  23        completely. Insertions are performed at each input character, whereas\r
  24        string matches are performed only when the previous match ends. So it\r
  25        is preferable to spend more time in matches to allow very fast string\r
  26        insertions and avoid deletions. The matching algorithm for small\r
  27        strings is inspired from that of Rabin & Karp. A brute force approach\r
  28        is used to find longer strings when a small match has been found.\r
  29        A similar algorithm is used in comic (by Jan-Mark Wams) and freeze\r
  30        (by Leonid Broukhis).\r
  31           A previous version of this file used a more sophisticated algorithm\r
  32        (by Fiala and Greene) which is guaranteed to run in linear amortized\r
  33        time, but has a larger average cost, uses more memory and is patented.\r
  34        However the F&G algorithm may be faster for some highly redundant\r
  35        files if the parameter max_chain_length (described below) is too large.\r
  36 \r
  37    ACKNOWLEDGEMENTS\r
  38 \r
  39        The idea of lazy evaluation of matches is due to Jan-Mark Wams, and\r
  40        I found it in 'freeze' written by Leonid Broukhis.\r
  41        Thanks to many people for bug reports and testing.\r
  42 \r
  43    REFERENCES\r
  44 \r
  45        Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".\r
  46        Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc\r
  47 \r
  48        A description of the Rabin and Karp algorithm is given in the book\r
  49           "Algorithms" by R. Sedgewick, Addison-Wesley, p252.\r
  50 \r
  51        Fiala,E.R., and Greene,D.H.\r
  52           Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595}\r
  53 \r
  54 { $Id: deflate.c,v 1.14 1996/07/02 12:40:55 me Exp $ }\r
  55 \r
  56 interface\r
  57 \r
  58 {$I zconf.inc}\r
  59 \r
  60 uses\r
  61   zutil, zlib;\r
  62 \r
  63 \r
  64 function deflateInit_(strm : z_streamp;\r
  65                       level : int;\r
  66                       const version : string;\r
  67                       stream_size : int) : int;\r
  68 \r
  69 \r
  70 function deflateInit (var strm : z_stream; level : int) : int;\r
  71 \r
  72 {  Initializes the internal stream state for compression. The fields\r
  73    zalloc, zfree and opaque must be initialized before by the caller.\r
  74    If zalloc and zfree are set to Z_NULL, deflateInit updates them to\r
  75    use default allocation functions.\r
  76 \r
  77      The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:\r
  78    1 gives best speed, 9 gives best compression, 0 gives no compression at\r
  79    all (the input data is simply copied a block at a time).\r
  80    Z_DEFAULT_COMPRESSION requests a default compromise between speed and\r
  81    compression (currently equivalent to level 6).\r
  82 \r
  83      deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not\r
  84    enough memory, Z_STREAM_ERROR if level is not a valid compression level,\r
  85    Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible\r
  86    with the version assumed by the caller (ZLIB_VERSION).\r
  87    msg is set to null if there is no error message.  deflateInit does not\r
  88    perform any compression: this will be done by deflate(). }\r
  89 \r
  90 \r
  91 {EXPORT}\r
  92 function deflate (var strm : z_stream; flush : int) : int;\r
  93 \r
  94 { Performs one or both of the following actions:\r
  95 \r
  96   - Compress more input starting at next_in and update next_in and avail_in\r
  97     accordingly. If not all input can be processed (because there is not\r
  98     enough room in the output buffer), next_in and avail_in are updated and\r
  99     processing will resume at this point for the next call of deflate().\r
 100 \r
 101   - Provide more output starting at next_out and update next_out and avail_out\r
 102     accordingly. This action is forced if the parameter flush is non zero.\r
 103     Forcing flush frequently degrades the compression ratio, so this parameter\r
 104     should be set only when necessary (in interactive applications).\r
 105     Some output may be provided even if flush is not set.\r
 106 \r
 107   Before the call of deflate(), the application should ensure that at least\r
 108   one of the actions is possible, by providing more input and/or consuming\r
 109   more output, and updating avail_in or avail_out accordingly; avail_out\r
 110   should never be zero before the call. The application can consume the\r
 111   compressed output when it wants, for example when the output buffer is full\r
 112   (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK\r
 113   and with zero avail_out, it must be called again after making room in the\r
 114   output buffer because there might be more output pending.\r
 115 \r
 116     If the parameter flush is set to Z_PARTIAL_FLUSH, the current compression\r
 117   block is terminated and flushed to the output buffer so that the\r
 118   decompressor can get all input data available so far. For method 9, a future\r
 119   variant on method 8, the current block will be flushed but not terminated.\r
 120   Z_SYNC_FLUSH has the same effect as partial flush except that the compressed\r
 121   output is byte aligned (the compressor can clear its internal bit buffer)\r
 122   and the current block is always terminated; this can be useful if the\r
 123   compressor has to be restarted from scratch after an interruption (in which\r
 124   case the internal state of the compressor may be lost).\r
 125     If flush is set to Z_FULL_FLUSH, the compression block is terminated, a\r
 126   special marker is output and the compression dictionary is discarded; this\r
 127   is useful to allow the decompressor to synchronize if one compressed block\r
 128   has been damaged (see inflateSync below).  Flushing degrades compression and\r
 129   so should be used only when necessary.  Using Z_FULL_FLUSH too often can\r
 130   seriously degrade the compression. If deflate returns with avail_out == 0,\r
 131   this function must be called again with the same value of the flush\r
 132   parameter and more output space (updated avail_out), until the flush is\r
 133   complete (deflate returns with non-zero avail_out).\r
 134 \r
 135     If the parameter flush is set to Z_FINISH, all pending input is processed,\r
 136   all pending output is flushed and deflate returns with Z_STREAM_END if there\r
 137   was enough output space; if deflate returns with Z_OK, this function must be\r
 138   called again with Z_FINISH and more output space (updated avail_out) but no\r
 139   more input data, until it returns with Z_STREAM_END or an error. After\r
 140   deflate has returned Z_STREAM_END, the only possible operations on the\r
 141   stream are deflateReset or deflateEnd.\r
 142 \r
 143     Z_FINISH can be used immediately after deflateInit if all the compression\r
 144   is to be done in a single step. In this case, avail_out must be at least\r
 145   0.1% larger than avail_in plus 12 bytes.  If deflate does not return\r
 146   Z_STREAM_END, then it must be called again as described above.\r
 147 \r
 148     deflate() may update data_type if it can make a good guess about\r
 149   the input data type (Z_ASCII or Z_BINARY). In doubt, the data is considered\r
 150   binary. This field is only for information purposes and does not affect\r
 151   the compression algorithm in any manner.\r
 152 \r
 153     deflate() returns Z_OK if some progress has been made (more input\r
 154   processed or more output produced), Z_STREAM_END if all input has been\r
 155   consumed and all output has been produced (only when flush is set to\r
 156   Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example\r
 157   if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible. }\r
 158 \r
 159 \r
 160 function deflateEnd (var strm : z_stream) : int;\r
 161 \r
 162 {     All dynamically allocated data structures for this stream are freed.\r
 163    This function discards any unprocessed input and does not flush any\r
 164    pending output.\r
 165 \r
 166      deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the\r
 167    stream state was inconsistent, Z_DATA_ERROR if the stream was freed\r
 168    prematurely (some input or output was discarded). In the error case,\r
 169    msg may be set but then points to a static string (which must not be\r
 170    deallocated). }\r
 171 \r
 172 \r
 173 \r
 174 \r
 175                         { Advanced functions }\r
 176 \r
 177 { The following functions are needed only in some special applications. }\r
 178 \r
 179 \r
 180 {EXPORT}\r
 181 function deflateInit2 (var strm : z_stream;\r
 182                        level : int;\r
 183                        method : int;\r
 184                        windowBits : int;\r
 185                        memLevel : int;\r
 186                        strategy : int) : int;\r
 187 \r
 188 {  This is another version of deflateInit with more compression options. The\r
 189    fields next_in, zalloc, zfree and opaque must be initialized before by\r
 190    the caller.\r
 191 \r
 192      The method parameter is the compression method. It must be Z_DEFLATED in\r
 193    this version of the library. (Method 9 will allow a 64K history buffer and\r
 194    partial block flushes.)\r
 195 \r
 196      The windowBits parameter is the base two logarithm of the window size\r
 197    (the size of the history buffer).  It should be in the range 8..15 for this\r
 198    version of the library (the value 16 will be allowed for method 9). Larger\r
 199    values of this parameter result in better compression at the expense of\r
 200    memory usage. The default value is 15 if deflateInit is used instead.\r
 201 \r
 202      The memLevel parameter specifies how much memory should be allocated\r
 203    for the internal compression state. memLevel=1 uses minimum memory but\r
 204    is slow and reduces compression ratio; memLevel=9 uses maximum memory\r
 205    for optimal speed. The default value is 8. See zconf.h for total memory\r
 206    usage as a function of windowBits and memLevel.\r
 207 \r
 208      The strategy parameter is used to tune the compression algorithm. Use the\r
 209    value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a\r
 210    filter (or predictor), or Z_HUFFMAN_ONLY to force Huffman encoding only (no\r
 211    string match).  Filtered data consists mostly of small values with a\r
 212    somewhat random distribution. In this case, the compression algorithm is\r
 213    tuned to compress them better. The effect of Z_FILTERED is to force more\r
 214    Huffman coding and less string matching; it is somewhat intermediate\r
 215    between Z_DEFAULT and Z_HUFFMAN_ONLY. The strategy parameter only affects\r
 216    the compression ratio but not the correctness of the compressed output even\r
 217    if it is not set appropriately.\r
 218 \r
 219      If next_in is not null, the library will use this buffer to hold also\r
 220    some history information; the buffer must either hold the entire input\r
 221    data, or have at least 1<<(windowBits+1) bytes and be writable. If next_in\r
 222    is null, the library will allocate its own history buffer (and leave next_in\r
 223    null). next_out need not be provided here but must be provided by the\r
 224    application for the next call of deflate().\r
 225 \r
 226      If the history buffer is provided by the application, next_in must\r
 227    must never be changed by the application since the compressor maintains\r
 228    information inside this buffer from call to call; the application\r
 229    must provide more input only by increasing avail_in. next_in is always\r
 230    reset by the library in this case.\r
 231 \r
 232       deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was\r
 233    not enough memory, Z_STREAM_ERROR if a parameter is invalid (such as\r
 234    an invalid method). msg is set to null if there is no error message.\r
 235    deflateInit2 does not perform any compression: this will be done by\r
 236    deflate(). }\r
 237 \r
 238 \r
 239 {EXPORT}\r
 240 function deflateSetDictionary (var strm : z_stream;\r
 241                                dictionary : pBytef; {const bytes}\r
 242                                dictLength : uint) : int;\r
 243 \r
 244 {    Initializes the compression dictionary (history buffer) from the given\r
 245    byte sequence without producing any compressed output. This function must\r
 246    be called immediately after deflateInit or deflateInit2, before any call\r
 247    of deflate. The compressor and decompressor must use exactly the same\r
 248    dictionary (see inflateSetDictionary).\r
 249      The dictionary should consist of strings (byte sequences) that are likely\r
 250    to be encountered later in the data to be compressed, with the most commonly\r
 251    used strings preferably put towards the end of the dictionary. Using a\r
 252    dictionary is most useful when the data to be compressed is short and\r
 253    can be predicted with good accuracy; the data can then be compressed better\r
 254    than with the default empty dictionary. In this version of the library,\r
 255    only the last 32K bytes of the dictionary are used.\r
 256      Upon return of this function, strm->adler is set to the Adler32 value\r
 257    of the dictionary; the decompressor may later use this value to determine\r
 258    which dictionary has been used by the compressor. (The Adler32 value\r
 259    applies to the whole dictionary even if only a subset of the dictionary is\r
 260    actually used by the compressor.)\r
 261 \r
 262      deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a\r
 263    parameter is invalid (such as NULL dictionary) or the stream state\r
 264    is inconsistent (for example if deflate has already been called for this\r
 265    stream). deflateSetDictionary does not perform any compression: this will\r
 266    be done by deflate(). }\r
 267 \r
 268 {EXPORT}\r
 269 function deflateCopy (dest : z_streamp;\r
 270                       source : z_streamp) : int;\r
 271 \r
 272 {  Sets the destination stream as a complete copy of the source stream.  If\r
 273    the source stream is using an application-supplied history buffer, a new\r
 274    buffer is allocated for the destination stream.  The compressed output\r
 275    buffer is always application-supplied. It's the responsibility of the\r
 276    application to provide the correct values of next_out and avail_out for the\r
 277    next call of deflate.\r
 278 \r
 279      This function can be useful when several compression strategies will be\r
 280    tried, for example when there are several ways of pre-processing the input\r
 281    data with a filter. The streams that will be discarded should then be freed\r
 282    by calling deflateEnd.  Note that deflateCopy duplicates the internal\r
 283    compression state which can be quite large, so this strategy is slow and\r
 284    can consume lots of memory.\r
 285 \r
 286      deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not\r
 287    enough memory, Z_STREAM_ERROR if the source stream state was inconsistent\r
 288    (such as zalloc being NULL). msg is left unchanged in both source and\r
 289    destination. }\r
 290 \r
 291 {EXPORT}\r
 292 function deflateReset (var strm : z_stream) : int;\r
 293 \r
 294 {   This function is equivalent to deflateEnd followed by deflateInit,\r
 295    but does not free and reallocate all the internal compression state.\r
 296    The stream will keep the same compression level and any other attributes\r
 297    that may have been set by deflateInit2.\r
 298 \r
 299       deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source\r
 300    stream state was inconsistent (such as zalloc or state being NIL). }\r
 301 \r
 302 \r
 303 {EXPORT}\r
 304 function deflateParams (var strm : z_stream; level : int; strategy : int) : int;\r
 305 \r
 306 {    Dynamically update the compression level and compression strategy.\r
 307    This can be used to switch between compression and straight copy of\r
 308    the input data, or to switch to a different kind of input data requiring\r
 309    a different strategy. If the compression level is changed, the input\r
 310    available so far is compressed with the old level (and may be flushed);\r
 311    the new level will take effect only at the next call of deflate().\r
 312 \r
 313      Before the call of deflateParams, the stream state must be set as for\r
 314    a call of deflate(), since the currently available input may have to\r
 315    be compressed and flushed. In particular, strm->avail_out must be non-zero.\r
 316 \r
 317      deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source\r
 318    stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR\r
 319    if strm->avail_out was zero. }\r
 320 \r
 321 \r
 322 const\r
 323    deflate_copyright : string = ' deflate 1.1.2 Copyright 1995-1998 Jean-loup Gailly ';\r
 324 \r
 325 { If you use the zlib library in a product, an acknowledgment is welcome\r
 326   in the documentation of your product. If for some reason you cannot\r
 327   include such an acknowledgment, I would appreciate that you keep this\r
 328   copyright string in the executable of your product. }\r
 329 \r
 330 implementation\r
 331 \r
 332 uses\r
 333   trees, adler;\r
 334 \r
 335 {  ===========================================================================\r
 336    Function prototypes. }\r
 337 \r
 338 type\r
 339    block_state = (\r
 340     need_more,      { block not completed, need more input or more output }\r
 341     block_done,     { block flush performed }\r
 342     finish_started, { finish started, need only more output at next deflate }\r
 343     finish_done);   { finish done, accept no more input or output }\r
 344 \r
 345 { Compression function. Returns the block state after the call. }\r
 346 type\r
 347   compress_func = function(var s : deflate_state; flush : int) : block_state;\r
 348 \r
 349 {local}\r
 350 procedure fill_window(var s : deflate_state); forward;\r
 351 {local}\r
 352 function deflate_stored(var s : deflate_state; flush : int) : block_state; far; forward;\r
 353 {local}\r
 354 function deflate_fast(var s : deflate_state; flush : int) : block_state; far; forward;\r
 355 {local}\r
 356 function deflate_slow(var s : deflate_state; flush : int) : block_state; far; forward;\r
 357 {local}\r
 358 procedure lm_init(var s : deflate_state); forward;\r
 359 \r
 360 {local}\r
 361 procedure putShortMSB(var s : deflate_state; b : uInt); forward;\r
 362 {local}\r
 363 procedure  flush_pending (var strm : z_stream); forward;\r
 364 {local}\r
 365 function read_buf(strm : z_streamp;\r
 366                   buf : pBytef;\r
 367                   size : unsigned) : int; forward;\r
 368 {$ifdef ASMV}\r
 369 procedure match_init; { asm code initialization }\r
 370 function longest_match(var deflate_state; cur_match : IPos) : uInt; forward;\r
 371 {$else}\r
 372 {local}\r
 373 function longest_match(var s : deflate_state; cur_match : IPos) : uInt;\r
 374   forward;\r
 375 {$endif}\r
 376 \r
 377 {$ifdef DEBUG}\r
 378 {local}\r
 379 procedure check_match(var s : deflate_state;\r
 380                       start, match : IPos;\r
 381                       length : int); forward;\r
 382 {$endif}\r
 383 \r
 384 {  ==========================================================================\r
 385   local data }\r
 386 \r
 387 const\r
 388   ZNIL = 0;\r
 389 { Tail of hash chains }\r
 390 \r
 391 const\r
 392   TOO_FAR = 4096;\r
 393 { Matches of length 3 are discarded if their distance exceeds TOO_FAR }\r
 394 \r
 395 const\r
 396   MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);\r
 397 { Minimum amount of lookahead, except at the end of the input file.\r
 398   See deflate.c for comments about the MIN_MATCH+1. }\r
 399 \r
 400 {macro MAX_DIST(var s : deflate_state) : uInt;\r
 401 begin\r
 402   MAX_DIST := (s.w_size - MIN_LOOKAHEAD);\r
 403 end;\r
 404   In order to simplify the code, particularly on 16 bit machines, match\r
 405   distances are limited to MAX_DIST instead of WSIZE. }\r
 406 \r
 407 \r
 408 { Values for max_lazy_match, good_match and max_chain_length, depending on\r
 409   the desired pack level (0..9). The values given below have been tuned to\r
 410   exclude worst case performance for pathological files. Better values may be\r
 411   found for specific files. }\r
 412 \r
 413 type\r
 414   config = record\r
 415    good_length : ush; { reduce lazy search above this match length }\r
 416    max_lazy : ush;    { do not perform lazy search above this match length }\r
 417    nice_length : ush; { quit search above this match length }\r
 418    max_chain : ush;\r
 419    func : compress_func;\r
 420   end;\r
 421 \r
 422 {local}\r
 423 const\r
 424   configuration_table : array[0..10-1] of config = (\r
 425 {      good lazy nice chain }\r
 426 {0} (good_length:0;  max_lazy:0;   nice_length:0;   max_chain:0;    func:deflate_stored),  { store only }\r
 427 {1} (good_length:4;  max_lazy:4;   nice_length:8;   max_chain:4;    func:deflate_fast), { maximum speed, no lazy matches }\r
 428 {2} (good_length:4;  max_lazy:5;   nice_length:16;  max_chain:8;    func:deflate_fast),\r
 429 {3} (good_length:4;  max_lazy:6;   nice_length:32;  max_chain:32;   func:deflate_fast),\r
 430 \r
 431 {4} (good_length:4;  max_lazy:4;   nice_length:16;  max_chain:16;   func:deflate_slow),  { lazy matches }\r
 432 {5} (good_length:8;  max_lazy:16;  nice_length:32;  max_chain:32;   func:deflate_slow),\r
 433 {6} (good_length:8;  max_lazy:16;  nice_length:128; max_chain:128;  func:deflate_slow),\r
 434 {7} (good_length:8;  max_lazy:32;  nice_length:128; max_chain:256;  func:deflate_slow),\r
 435 {8} (good_length:32; max_lazy:128; nice_length:258; max_chain:1024; func:deflate_slow),\r
 436 {9} (good_length:32; max_lazy:258; nice_length:258; max_chain:4096; func:deflate_slow)); { maximum compression }\r
 437 \r
 438 { Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4\r
 439   For deflate_fast() (levels <= 3) good is ignored and lazy has a different\r
 440   meaning. }\r
 441 \r
 442 const\r
 443   EQUAL = 0;\r
 444 { result of memcmp for equal strings }\r
 445 \r
 446 { ==========================================================================\r
 447   Update a hash value with the given input byte\r
 448   IN  assertion: all calls to to UPDATE_HASH are made with consecutive\r
 449      input characters, so that a running hash key can be computed from the\r
 450      previous key instead of complete recalculation each time.\r
 451 \r
 452 macro UPDATE_HASH(s,h,c)\r
 453    h := (( (h) shl s^.hash_shift) xor (c)) and s^.hash_mask;\r
 454 }\r
 455 \r
 456 { ===========================================================================\r
 457   Insert string str in the dictionary and set match_head to the previous head\r
 458   of the hash chain (the most recent string with same hash key). Return\r
 459   the previous length of the hash chain.\r
 460   If this file is compiled with -DFASTEST, the compression level is forced\r
 461   to 1, and no hash chains are maintained.\r
 462   IN  assertion: all calls to to INSERT_STRING are made with consecutive\r
 463      input characters and the first MIN_MATCH bytes of str are valid\r
 464      (except for the last MIN_MATCH-1 bytes of the input file). }\r
 465 \r
 466 procedure INSERT_STRING(var s : deflate_state;\r
 467                         str : uInt;\r
 468                         var match_head : IPos);\r
 469 begin\r
 470 {$ifdef FASTEST}\r
 471    {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}\r
 472     s.ins_h := ((s.ins_h shl s.hash_shift) xor\r
 473                  (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;\r
 474     match_head := s.head[s.ins_h]\r
 475     s.head[s.ins_h] := Pos(str);\r
 476 {$else}\r
 477    {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}\r
 478     s.ins_h := ((s.ins_h shl s.hash_shift) xor\r
 479                  (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;\r
 480 \r
 481     match_head := s.head^[s.ins_h];\r
 482     s.prev^[(str) and s.w_mask] := match_head;\r
 483     s.head^[s.ins_h] := Pos(str);\r
 484 {$endif}\r
 485 end;\r
 486 \r
 487 {  =========================================================================\r
 488   Initialize the hash table (avoiding 64K overflow for 16 bit systems).\r
 489   prev[] will be initialized on the fly.\r
 490 \r
 491 macro CLEAR_HASH(s)\r
 492     s^.head[s^.hash_size-1] := ZNIL;\r
 493     zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0]));\r
 494 }\r
 495 \r
 496 {  ======================================================================== }\r
 497 \r
 498 function deflateInit2_(var strm : z_stream;\r
 499                        level : int;\r
 500                        method : int;\r
 501                        windowBits : int;\r
 502                        memLevel : int;\r
 503                        strategy : int;\r
 504                        const version : string;\r
 505                        stream_size : int) : int;\r
 506 var\r
 507   s : deflate_state_ptr;\r
 508   noheader : int;\r
 509 \r
 510   overlay : pushfArray;\r
 511   { We overlay pending_buf and d_buf+l_buf. This works since the average\r
 512     output size for (length,distance) codes is <= 24 bits. }\r
 513 begin\r
 514   noheader := 0;\r
 515   if (version  =  '') or (version[1] <> ZLIB_VERSION[1]) or\r
 516      (stream_size <> sizeof(z_stream)) then\r
 517   begin\r
 518     deflateInit2_ := Z_VERSION_ERROR;\r
 519     exit;\r
 520   end;\r
 521   {\r
 522   if (strm = Z_NULL) then\r
 523   begin\r
 524     deflateInit2_ := Z_STREAM_ERROR;\r
 525     exit;\r
 526   end;\r
 527   }\r
 528   { SetLength(strm.msg, 255); }\r
 529   strm.msg := '';\r
 530   if not Assigned(strm.zalloc) then\r
 531   begin\r
 532     {$IFDEF FPC}  strm.zalloc := @zcalloc;  {$ELSE}\r
 533     strm.zalloc := zcalloc;\r
 534     {$ENDIF}\r
 535     strm.opaque := voidpf(0);\r
 536   end;\r
 537   if not Assigned(strm.zfree) then\r
 538     {$IFDEF FPC}  strm.zfree := @zcfree;  {$ELSE}\r
 539     strm.zfree := zcfree;\r
 540     {$ENDIF}\r
 541 \r
 542   if (level  =  Z_DEFAULT_COMPRESSION) then\r
 543     level := 6;\r
 544 {$ifdef FASTEST}\r
 545     level := 1;\r
 546 {$endif}\r
 547 \r
 548   if (windowBits < 0) then { undocumented feature: suppress zlib header }\r
 549   begin\r
 550     noheader := 1;\r
 551     windowBits := -windowBits;\r
 552   end;\r
 553   if (memLevel < 1) or (memLevel > MAX_MEM_LEVEL) or (method <> Z_DEFLATED)\r
 554     or (windowBits < 8) or (windowBits > 15) or (level < 0)\r
 555     or (level > 9) or (strategy < 0) or (strategy > Z_HUFFMAN_ONLY) then\r
 556   begin\r
 557     deflateInit2_ := Z_STREAM_ERROR;\r
 558     exit;\r
 559   end;\r
 560 \r
 561   s := deflate_state_ptr (ZALLOC(strm, 1, sizeof(deflate_state)));\r
 562   if (s = Z_NULL) then\r
 563   begin\r
 564     deflateInit2_ := Z_MEM_ERROR;\r
 565     exit;\r
 566   end;\r
 567   strm.state := pInternal_state(s);\r
 568   s^.strm := @strm;\r
 569 \r
 570   s^.noheader := noheader;\r
 571   s^.w_bits := windowBits;\r
 572   s^.w_size := 1 shl s^.w_bits;\r
 573   s^.w_mask := s^.w_size - 1;\r
 574 \r
 575   s^.hash_bits := memLevel + 7;\r
 576   s^.hash_size := 1 shl s^.hash_bits;\r
 577   s^.hash_mask := s^.hash_size - 1;\r
 578   s^.hash_shift :=  ((s^.hash_bits+MIN_MATCH-1) div MIN_MATCH);\r
 579 \r
 580   s^.window := pzByteArray (ZALLOC(strm, s^.w_size, 2*sizeof(Byte)));\r
 581   s^.prev   := pzPosfArray (ZALLOC(strm, s^.w_size, sizeof(Pos)));\r
 582   s^.head   := pzPosfArray (ZALLOC(strm, s^.hash_size, sizeof(Pos)));\r
 583 \r
 584   s^.lit_bufsize := 1 shl (memLevel + 6); { 16K elements by default }\r
 585 \r
 586   overlay := pushfArray (ZALLOC(strm, s^.lit_bufsize, sizeof(ush)+2));\r
 587   s^.pending_buf := pzByteArray (overlay);\r
 588   s^.pending_buf_size := ulg(s^.lit_bufsize) * (sizeof(ush)+Long(2));\r
 589 \r
 590   if (s^.window = Z_NULL) or (s^.prev = Z_NULL) or (s^.head = Z_NULL)\r
 591    or (s^.pending_buf = Z_NULL) then\r
 592   begin\r
 593     {ERR_MSG(Z_MEM_ERROR);}\r
 594     strm.msg := z_errmsg[z_errbase-Z_MEM_ERROR];\r
 595     deflateEnd (strm);\r
 596     deflateInit2_ := Z_MEM_ERROR;\r
 597     exit;\r
 598   end;\r
 599   s^.d_buf := pushfArray( @overlay^[s^.lit_bufsize div sizeof(ush)] );\r
 600   s^.l_buf := puchfArray( @s^.pending_buf^[(1+sizeof(ush))*s^.lit_bufsize] );\r
 601 \r
 602   s^.level := level;\r
 603   s^.strategy := strategy;\r
 604   s^.method := Byte(method);\r
 605 \r
 606   deflateInit2_ := deflateReset(strm);\r
 607 end;\r
 608 \r
 609 {  ========================================================================= }\r
 610 \r
 611 function deflateInit2(var strm : z_stream;\r
 612                       level : int;\r
 613                       method : int;\r
 614                       windowBits : int;\r
 615                       memLevel : int;\r
 616                       strategy : int) : int;\r
 617 { a macro }\r
 618 begin\r
 619   deflateInit2 := deflateInit2_(strm, level, method, windowBits,\r
 620                    memLevel, strategy, ZLIB_VERSION, sizeof(z_stream));\r
 621 end;\r
 622 \r
 623 {  ========================================================================= }\r
 624 \r
 625 function deflateInit_(strm : z_streamp;\r
 626                       level : int;\r
 627                       const version : string;\r
 628                       stream_size : int) : int;\r
 629 begin\r
 630   if (strm = Z_NULL) then\r
 631     deflateInit_ := Z_STREAM_ERROR\r
 632   else\r
 633     deflateInit_ := deflateInit2_(strm^, level, Z_DEFLATED, MAX_WBITS,\r
 634                    DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, version, stream_size);\r
 635   { To do: ignore strm^.next_in if we use it as window }\r
 636 end;\r
 637 \r
 638 {  ========================================================================= }\r
 639 \r
 640 function deflateInit(var strm : z_stream; level : int) : int;\r
 641 { deflateInit is a macro to allow checking the zlib version\r
 642   and the compiler's view of z_stream: }\r
 643 begin\r
 644   deflateInit := deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS,\r
 645          DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(z_stream));\r
 646 end;\r
 647 \r
 648 {  ======================================================================== }\r
 649 function deflateSetDictionary (var strm : z_stream;\r
 650                                dictionary : pBytef;\r
 651                                dictLength : uInt) : int;\r
 652 var\r
 653   s : deflate_state_ptr;\r
 654   length : uInt;\r
 655   n : uInt;\r
 656   hash_head : IPos;\r
 657 var\r
 658   MAX_DIST : uInt;  {macro}\r
 659 begin\r
 660   length := dictLength;\r
 661   hash_head := 0;\r
 662 \r
 663   if {(@strm  =  Z_NULL) or}\r
 664      (strm.state  =  Z_NULL) or (dictionary  =  Z_NULL)\r
 665     or (deflate_state_ptr(strm.state)^.status <> INIT_STATE) then\r
 666   begin\r
 667     deflateSetDictionary := Z_STREAM_ERROR;\r
 668     exit;\r
 669   end;\r
 670 \r
 671   s := deflate_state_ptr(strm.state);\r
 672   strm.adler := adler32(strm.adler, dictionary, dictLength);\r
 673 \r
 674   if (length < MIN_MATCH) then\r
 675   begin\r
 676     deflateSetDictionary := Z_OK;\r
 677     exit;\r
 678   end;\r
 679   MAX_DIST := (s^.w_size - MIN_LOOKAHEAD);\r
 680   if (length > MAX_DIST) then\r
 681   begin\r
 682     length := MAX_DIST;\r
 683 {$ifndef USE_DICT_HEAD}\r
 684     Inc(dictionary, dictLength - length);  { use the tail of the dictionary }\r
 685 {$endif}\r
 686   end;\r
 687 \r
 688   zmemcpy( pBytef(s^.window), dictionary, length);\r
 689   s^.strstart := length;\r
 690   s^.block_start := long(length);\r
 691 \r
 692   { Insert all strings in the hash table (except for the last two bytes).\r
 693     s^.lookahead stays null, so s^.ins_h will be recomputed at the next\r
 694     call of fill_window. }\r
 695 \r
 696   s^.ins_h := s^.window^[0];\r
 697   {UPDATE_HASH(s, s^.ins_h, s^.window[1]);}\r
 698   s^.ins_h := ((s^.ins_h shl s^.hash_shift) xor (s^.window^[1]))\r
 699               and s^.hash_mask;\r
 700 \r
 701   for n := 0 to length - MIN_MATCH do\r
 702   begin\r
 703     INSERT_STRING(s^, n, hash_head);\r
 704   end;\r
 705   {if (hash_head <> 0) then\r
 706     hash_head := 0;  - to make compiler happy }\r
 707   deflateSetDictionary := Z_OK;\r
 708 end;\r
 709 \r
 710 {  ======================================================================== }\r
 711 function deflateReset (var strm : z_stream) : int;\r
 712 var\r
 713   s : deflate_state_ptr;\r
 714 begin\r
 715   if {(@strm = Z_NULL) or}\r
 716    (strm.state = Z_NULL)\r
 717    or (not Assigned(strm.zalloc)) or (not Assigned(strm.zfree)) then\r
 718   begin\r
 719     deflateReset := Z_STREAM_ERROR;\r
 720     exit;\r
 721   end;\r
 722 \r
 723   strm.total_out := 0;\r
 724   strm.total_in := 0;\r
 725   strm.msg := '';      { use zfree if we ever allocate msg dynamically }\r
 726   strm.data_type := Z_UNKNOWN;\r
 727 \r
 728   s := deflate_state_ptr(strm.state);\r
 729   s^.pending := 0;\r
 730   s^.pending_out := pBytef(s^.pending_buf);\r
 731 \r
 732   if (s^.noheader < 0) then\r
 733   begin\r
 734     s^.noheader := 0; { was set to -1 by deflate(..., Z_FINISH); }\r
 735   end;\r
 736   if s^.noheader <> 0 then\r
 737     s^.status := BUSY_STATE\r
 738   else\r
 739     s^.status := INIT_STATE;\r
 740   strm.adler := 1;\r
 741   s^.last_flush := Z_NO_FLUSH;\r
 742 \r
 743   _tr_init(s^);\r
 744   lm_init(s^);\r
 745 \r
 746   deflateReset := Z_OK;\r
 747 end;\r
 748 \r
 749 {  ======================================================================== }\r
 750 function deflateParams(var strm : z_stream;\r
 751                        level : int;\r
 752                        strategy : int) : int;\r
 753 var\r
 754   s : deflate_state_ptr;\r
 755   func : compress_func;\r
 756   err : int;\r
 757 begin\r
 758   err := Z_OK;\r
 759   if {(@strm  =  Z_NULL) or} (strm.state  =  Z_NULL) then\r
 760   begin\r
 761     deflateParams := Z_STREAM_ERROR;\r
 762     exit;\r
 763   end;\r
 764 \r
 765   s := deflate_state_ptr(strm.state);\r
 766 \r
 767   if (level = Z_DEFAULT_COMPRESSION) then\r
 768   begin\r
 769     level := 6;\r
 770   end;\r
 771   if (level < 0) or (level > 9) or (strategy < 0)\r
 772   or (strategy > Z_HUFFMAN_ONLY) then\r
 773   begin\r
 774     deflateParams := Z_STREAM_ERROR;\r
 775     exit;\r
 776   end;\r
 777   func := configuration_table[s^.level].func;\r
 778 \r
 779   if (@func <> @configuration_table[level].func)\r
 780     and (strm.total_in <> 0) then\r
 781   begin\r
 782       { Flush the last buffer: }\r
 783       err := deflate(strm, Z_PARTIAL_FLUSH);\r
 784   end;\r
 785   if (s^.level <> level) then\r
 786   begin\r
 787     s^.level := level;\r
 788     s^.max_lazy_match   := configuration_table[level].max_lazy;\r
 789     s^.good_match       := configuration_table[level].good_length;\r
 790     s^.nice_match       := configuration_table[level].nice_length;\r
 791     s^.max_chain_length := configuration_table[level].max_chain;\r
 792   end;\r
 793   s^.strategy := strategy;\r
 794   deflateParams := err;\r
 795 end;\r
 796 \r
 797 { =========================================================================\r
 798   Put a short in the pending buffer. The 16-bit value is put in MSB order.\r
 799   IN assertion: the stream state is correct and there is enough room in\r
 800   pending_buf. }\r
 801 \r
 802 {local}\r
 803 procedure putShortMSB (var s : deflate_state; b : uInt);\r
 804 begin\r
 805   s.pending_buf^[s.pending] := Byte(b shr 8);\r
 806   Inc(s.pending);\r
 807   s.pending_buf^[s.pending] := Byte(b and $ff);\r
 808   Inc(s.pending);\r
 809 end;\r
 810 \r
 811 { =========================================================================\r
 812   Flush as much pending output as possible. All deflate() output goes\r
 813   through this function so some applications may wish to modify it\r
 814   to avoid allocating a large strm^.next_out buffer and copying into it.\r
 815   (See also read_buf()). }\r
 816 \r
 817 {local}\r
 818 procedure flush_pending(var strm : z_stream);\r
 819 var\r
 820   len : unsigned;\r
 821   s : deflate_state_ptr;\r
 822 begin\r
 823   s := deflate_state_ptr(strm.state);\r
 824   len := s^.pending;\r
 825 \r
 826   if (len > strm.avail_out) then\r
 827     len := strm.avail_out;\r
 828   if (len = 0) then\r
 829     exit;\r
 830 \r
 831   zmemcpy(strm.next_out, s^.pending_out, len);\r
 832   Inc(strm.next_out, len);\r
 833   Inc(s^.pending_out, len);\r
 834   Inc(strm.total_out, len);\r
 835   Dec(strm.avail_out, len);\r
 836   Dec(s^.pending, len);\r
 837   if (s^.pending = 0) then\r
 838   begin\r
 839     s^.pending_out := pBytef(s^.pending_buf);\r
 840   end;\r
 841 end;\r
 842 \r
 843 { ========================================================================= }\r
 844 function deflate (var strm : z_stream; flush : int) : int;\r
 845 var\r
 846   old_flush : int; { value of flush param for previous deflate call }\r
 847   s : deflate_state_ptr;\r
 848 var\r
 849   header : uInt;\r
 850   level_flags : uInt;\r
 851 var\r
 852   bstate : block_state;\r
 853 begin\r
 854   if {(@strm = Z_NULL) or} (strm.state = Z_NULL)\r
 855     or (flush > Z_FINISH) or (flush < 0) then\r
 856   begin\r
 857     deflate := Z_STREAM_ERROR;\r
 858     exit;\r
 859   end;\r
 860   s := deflate_state_ptr(strm.state);\r
 861 \r
 862   if (strm.next_out = Z_NULL) or\r
 863      ((strm.next_in = Z_NULL) and (strm.avail_in <> 0)) or\r
 864      ((s^.status = FINISH_STATE) and (flush <> Z_FINISH)) then\r
 865   begin\r
 866     {ERR_RETURN(strm^, Z_STREAM_ERROR);}\r
 867     strm.msg := z_errmsg[z_errbase - Z_STREAM_ERROR];\r
 868     deflate := Z_STREAM_ERROR;\r
 869     exit;\r
 870   end;\r
 871   if (strm.avail_out = 0) then\r
 872   begin\r
 873     {ERR_RETURN(strm^, Z_BUF_ERROR);}\r
 874     strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];\r
 875     deflate := Z_BUF_ERROR;\r
 876     exit;\r
 877   end;\r
 878 \r
 879   s^.strm := @strm; { just in case }\r
 880   old_flush := s^.last_flush;\r
 881   s^.last_flush := flush;\r
 882 \r
 883   { Write the zlib header }\r
 884   if (s^.status = INIT_STATE) then\r
 885   begin\r
 886 \r
 887     header := (Z_DEFLATED + ((s^.w_bits-8) shl 4)) shl 8;\r
 888     level_flags := (s^.level-1) shr 1;\r
 889 \r
 890     if (level_flags > 3) then\r
 891       level_flags := 3;\r
 892     header := header or (level_flags shl 6);\r
 893     if (s^.strstart <> 0) then\r
 894       header := header or PRESET_DICT;\r
 895     Inc(header, 31 - (header mod 31));\r
 896 \r
 897     s^.status := BUSY_STATE;\r
 898     putShortMSB(s^, header);\r
 899 \r
 900     { Save the adler32 of the preset dictionary: }\r
 901     if (s^.strstart <> 0) then\r
 902     begin\r
 903       putShortMSB(s^, uInt(strm.adler shr 16));\r
 904       putShortMSB(s^, uInt(strm.adler and $ffff));\r
 905     end;\r
 906     strm.adler := long(1);\r
 907   end;\r
 908 \r
 909   { Flush as much pending output as possible }\r
 910   if (s^.pending <> 0) then\r
 911   begin\r
 912     flush_pending(strm);\r
 913     if (strm.avail_out = 0) then\r
 914     begin\r
 915       { Since avail_out is 0, deflate will be called again with\r
 916         more output space, but possibly with both pending and\r
 917         avail_in equal to zero. There won't be anything to do,\r
 918         but this is not an error situation so make sure we\r
 919         return OK instead of BUF_ERROR at next call of deflate: }\r
 920 \r
 921       s^.last_flush := -1;\r
 922       deflate := Z_OK;\r
 923       exit;\r
 924     end;\r
 925 \r
 926   { Make sure there is something to do and avoid duplicate consecutive\r
 927     flushes. For repeated and useless calls with Z_FINISH, we keep\r
 928     returning Z_STREAM_END instead of Z_BUFF_ERROR. }\r
 929 \r
 930   end\r
 931   else\r
 932     if (strm.avail_in = 0) and (flush <= old_flush)\r
 933       and (flush <> Z_FINISH) then\r
 934     begin\r
 935       {ERR_RETURN(strm^, Z_BUF_ERROR);}\r
 936       strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];\r
 937       deflate := Z_BUF_ERROR;\r
 938       exit;\r
 939     end;\r
 940 \r
 941   { User must not provide more input after the first FINISH: }\r
 942   if (s^.status = FINISH_STATE) and (strm.avail_in <> 0) then\r
 943   begin\r
 944     {ERR_RETURN(strm^, Z_BUF_ERROR);}\r
 945     strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];\r
 946     deflate := Z_BUF_ERROR;\r
 947     exit;\r
 948   end;\r
 949 \r
 950   { Start a new block or continue the current one. }\r
 951   if (strm.avail_in <> 0) or (s^.lookahead <> 0)\r
 952     or ((flush <> Z_NO_FLUSH) and (s^.status <> FINISH_STATE)) then\r
 953   begin\r
 954     bstate := configuration_table[s^.level].func(s^, flush);\r
 955 \r
 956     if (bstate = finish_started) or (bstate = finish_done) then\r
 957       s^.status := FINISH_STATE;\r
 958 \r
 959     if (bstate = need_more) or (bstate = finish_started) then\r
 960     begin\r
 961       if (strm.avail_out = 0) then\r
 962         s^.last_flush := -1; { avoid BUF_ERROR next call, see above }\r
 963 \r
 964       deflate := Z_OK;\r
 965       exit;\r
 966       { If flush != Z_NO_FLUSH && avail_out == 0, the next call\r
 967         of deflate should use the same flush parameter to make sure\r
 968         that the flush is complete. So we don't have to output an\r
 969         empty block here, this will be done at next call. This also\r
 970         ensures that for a very small output buffer, we emit at most\r
 971          one empty block. }\r
 972     end;\r
 973     if (bstate = block_done) then\r
 974     begin\r
 975       if (flush = Z_PARTIAL_FLUSH) then\r
 976         _tr_align(s^)\r
 977       else\r
 978       begin  { FULL_FLUSH or SYNC_FLUSH }\r
 979         _tr_stored_block(s^, pcharf(NIL), Long(0), FALSE);\r
 980         { For a full flush, this empty block will be recognized\r
 981           as a special marker by inflate_sync(). }\r
 982 \r
 983         if (flush = Z_FULL_FLUSH) then\r
 984         begin\r
 985           {macro CLEAR_HASH(s);}             { forget history }\r
 986           s^.head^[s^.hash_size-1] := ZNIL;\r
 987           zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0]));\r
 988         end;\r
 989       end;\r
 990 \r
 991       flush_pending(strm);\r
 992       if (strm.avail_out = 0) then\r
 993       begin\r
 994         s^.last_flush := -1; { avoid BUF_ERROR at next call, see above }\r
 995         deflate := Z_OK;\r
 996         exit;\r
 997       end;\r
 998 \r
 999     end;\r
1000   end;\r
1001   {$IFDEF DEBUG}\r
1002   Assert(strm.avail_out > 0, 'bug2');\r
1003   {$ENDIF}\r
1004   if (flush <> Z_FINISH) then\r
1005   begin\r
1006     deflate := Z_OK;\r
1007     exit;\r
1008   end;\r
1009 \r
1010   if (s^.noheader <> 0) then\r
1011   begin\r
1012     deflate := Z_STREAM_END;\r
1013     exit;\r
1014   end;\r
1015 \r
1016   { Write the zlib trailer (adler32) }\r
1017   putShortMSB(s^, uInt(strm.adler shr 16));\r
1018   putShortMSB(s^, uInt(strm.adler and $ffff));\r
1019   flush_pending(strm);\r
1020   { If avail_out is zero, the application will call deflate again\r
1021     to flush the rest. }\r
1022 \r
1023   s^.noheader := -1; { write the trailer only once! }\r
1024   if s^.pending <> 0 then\r
1025     deflate := Z_OK\r
1026   else\r
1027     deflate := Z_STREAM_END;\r
1028 end;\r
1029 \r
1030 { ========================================================================= }\r
1031 function deflateEnd (var strm : z_stream) : int;\r
1032 var\r
1033   status : int;\r
1034   s : deflate_state_ptr;\r
1035 begin\r
1036   if {(@strm = Z_NULL) or} (strm.state = Z_NULL) then\r
1037   begin\r
1038     deflateEnd := Z_STREAM_ERROR;\r
1039     exit;\r
1040   end;\r
1041 \r
1042   s := deflate_state_ptr(strm.state);\r
1043   status := s^.status;\r
1044   if (status <> INIT_STATE) and (status <> BUSY_STATE) and\r
1045      (status <> FINISH_STATE) then\r
1046   begin\r
1047     deflateEnd := Z_STREAM_ERROR;\r
1048     exit;\r
1049   end;\r
1050 \r
1051   { Deallocate in reverse order of allocations: }\r
1052   TRY_FREE(strm, s^.pending_buf);\r
1053   TRY_FREE(strm, s^.head);\r
1054   TRY_FREE(strm, s^.prev);\r
1055   TRY_FREE(strm, s^.window);\r
1056 \r
1057   ZFREE(strm, s);\r
1058   strm.state := Z_NULL;\r
1059 \r
1060   if status = BUSY_STATE then\r
1061     deflateEnd := Z_DATA_ERROR\r
1062   else\r
1063     deflateEnd := Z_OK;\r
1064 end;\r
1065 \r
1066 { =========================================================================\r
1067   Copy the source state to the destination state.\r
1068   To simplify the source, this is not supported for 16-bit MSDOS (which\r
1069   doesn't have enough memory anyway to duplicate compression states). }\r
1070 \r
1071 \r
1072 { ========================================================================= }\r
1073 function deflateCopy (dest, source : z_streamp) : int;\r
1074 {$ifndef MAXSEG_64K}\r
1075 var\r
1076   ds : deflate_state_ptr;\r
1077   ss : deflate_state_ptr;\r
1078   overlay : pushfArray;\r
1079 {$endif}\r
1080 begin\r
1081 {$ifdef MAXSEG_64K}\r
1082   deflateCopy := Z_STREAM_ERROR;\r
1083   exit;\r
1084 {$else}\r
1085 \r
1086   if (source = Z_NULL) or (dest = Z_NULL) or (source^.state = Z_NULL) then\r
1087   begin\r
1088     deflateCopy := Z_STREAM_ERROR;\r
1089     exit;\r
1090   end;\r
1091   ss := deflate_state_ptr(source^.state);\r
1092   dest^ := source^;\r
1093 \r
1094   ds := deflate_state_ptr( ZALLOC(dest^, 1, sizeof(deflate_state)) );\r
1095   if (ds = Z_NULL) then\r
1096   begin\r
1097     deflateCopy := Z_MEM_ERROR;\r
1098     exit;\r
1099   end;\r
1100   dest^.state := pInternal_state(ds);\r
1101   ds^ := ss^;\r
1102   ds^.strm := dest;\r
1103 \r
1104   ds^.window := pzByteArray ( ZALLOC(dest^, ds^.w_size, 2*sizeof(Byte)) );\r
1105   ds^.prev   := pzPosfArray ( ZALLOC(dest^, ds^.w_size, sizeof(Pos)) );\r
1106   ds^.head   := pzPosfArray ( ZALLOC(dest^, ds^.hash_size, sizeof(Pos)) );\r
1107   overlay := pushfArray ( ZALLOC(dest^, ds^.lit_bufsize, sizeof(ush)+2) );\r
1108   ds^.pending_buf := pzByteArray ( overlay );\r
1109 \r
1110   if (ds^.window = Z_NULL) or (ds^.prev = Z_NULL) or (ds^.head = Z_NULL)\r
1111      or (ds^.pending_buf = Z_NULL) then\r
1112   begin\r
1113     deflateEnd (dest^);\r
1114     deflateCopy := Z_MEM_ERROR;\r
1115     exit;\r
1116   end;\r
1117   { following zmemcpy do not work for 16-bit MSDOS }\r
1118   zmemcpy(pBytef(ds^.window), pBytef(ss^.window), ds^.w_size * 2 * sizeof(Byte));\r
1119   zmemcpy(pBytef(ds^.prev), pBytef(ss^.prev), ds^.w_size * sizeof(Pos));\r
1120   zmemcpy(pBytef(ds^.head), pBytef(ss^.head), ds^.hash_size * sizeof(Pos));\r
1121   zmemcpy(pBytef(ds^.pending_buf), pBytef(ss^.pending_buf), uInt(ds^.pending_buf_size));\r
1122 \r
1123   ds^.pending_out := @ds^.pending_buf^[ptr2int(ss^.pending_out) - ptr2int(ss^.pending_buf)];\r
1124   ds^.d_buf := pushfArray (@overlay^[ds^.lit_bufsize div sizeof(ush)] );\r
1125   ds^.l_buf := puchfArray (@ds^.pending_buf^[(1+sizeof(ush))*ds^.lit_bufsize]);\r
1126 \r
1127   ds^.l_desc.dyn_tree := tree_ptr(@ds^.dyn_ltree);\r
1128   ds^.d_desc.dyn_tree := tree_ptr(@ds^.dyn_dtree);\r
1129   ds^.bl_desc.dyn_tree := tree_ptr(@ds^.bl_tree);\r
1130 \r
1131   deflateCopy := Z_OK;\r
1132 {$endif}\r
1133 end;\r
1134 \r
1135 \r
1136 { ===========================================================================\r
1137   Read a new buffer from the current input stream, update the adler32\r
1138   and total number of bytes read.  All deflate() input goes through\r
1139   this function so some applications may wish to modify it to avoid\r
1140   allocating a large strm^.next_in buffer and copying from it.\r
1141   (See also flush_pending()). }\r
1142 \r
1143 {local}\r
1144 function read_buf(strm : z_streamp; buf : pBytef; size : unsigned) : int;\r
1145 var\r
1146   len : unsigned;\r
1147 begin\r
1148   len := strm^.avail_in;\r
1149 \r
1150   if (len > size) then\r
1151     len := size;\r
1152   if (len = 0) then\r
1153   begin\r
1154     read_buf := 0;\r
1155     exit;\r
1156   end;\r
1157 \r
1158   Dec(strm^.avail_in, len);\r
1159 \r
1160   if deflate_state_ptr(strm^.state)^.noheader = 0 then\r
1161   begin\r
1162     strm^.adler := adler32(strm^.adler, strm^.next_in, len);\r
1163   end;\r
1164   zmemcpy(buf, strm^.next_in, len);\r
1165   Inc(strm^.next_in, len);\r
1166   Inc(strm^.total_in, len);\r
1167 \r
1168   read_buf := int(len);\r
1169 end;\r
1170 \r
1171 { ===========================================================================\r
1172   Initialize the "longest match" routines for a new zlib stream }\r
1173 \r
1174 {local}\r
1175 procedure lm_init (var s : deflate_state);\r
1176 begin\r
1177   s.window_size := ulg( uLong(2)*s.w_size);\r
1178 \r
1179   {macro CLEAR_HASH(s);}\r
1180   s.head^[s.hash_size-1] := ZNIL;\r
1181   zmemzero(pBytef(s.head), unsigned(s.hash_size-1)*sizeof(s.head^[0]));\r
1182 \r
1183   { Set the default configuration parameters: }\r
1184 \r
1185   s.max_lazy_match   := configuration_table[s.level].max_lazy;\r
1186   s.good_match       := configuration_table[s.level].good_length;\r
1187   s.nice_match       := configuration_table[s.level].nice_length;\r
1188   s.max_chain_length := configuration_table[s.level].max_chain;\r
1189 \r
1190   s.strstart := 0;\r
1191   s.block_start := long(0);\r
1192   s.lookahead := 0;\r
1193   s.prev_length := MIN_MATCH-1;\r
1194   s.match_length := MIN_MATCH-1;\r
1195   s.match_available := FALSE;\r
1196   s.ins_h := 0;\r
1197 {$ifdef ASMV}\r
1198   match_init; { initialize the asm code }\r
1199 {$endif}\r
1200 end;\r
1201 \r
1202 { ===========================================================================\r
1203   Set match_start to the longest match starting at the given string and\r
1204   return its length. Matches shorter or equal to prev_length are discarded,\r
1205   in which case the result is equal to prev_length and match_start is\r
1206   garbage.\r
1207   IN assertions: cur_match is the head of the hash chain for the current\r
1208     string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1\r
1209   OUT assertion: the match length is not greater than s^.lookahead. }\r
1210 \r
1211 \r
1212 {$ifndef ASMV}\r
1213 { For 80x86 and 680x0, an optimized version will be provided in match.asm or\r
1214   match.S. The code will be functionally equivalent. }\r
1215 \r
1216 {$ifndef FASTEST}\r
1217 \r
1218 {local}\r
1219 function longest_match(var s : deflate_state;\r
1220                        cur_match : IPos  { current match }\r
1221                        ) : uInt;\r
1222 label\r
1223   nextstep;\r
1224 var\r
1225   chain_length : unsigned;    { max hash chain length }\r
1226   {register} scan : pBytef;   { current string }\r
1227   {register} match : pBytef;  { matched string }\r
1228   {register} len : int;       { length of current match }\r
1229   best_len : int;             { best match length so far }\r
1230   nice_match : int;           { stop if match long enough }\r
1231   limit : IPos;\r
1232 \r
1233   prev : pzPosfArray;\r
1234   wmask : uInt;\r
1235 {$ifdef UNALIGNED_OK}\r
1236   {register} strend : pBytef;\r
1237   {register} scan_start : ush;\r
1238   {register} scan_end : ush;\r
1239 {$else}\r
1240   {register} strend : pBytef;\r
1241   {register} scan_end1 : Byte;\r
1242   {register} scan_end : Byte;\r
1243 {$endif}\r
1244 var\r
1245   MAX_DIST : uInt;\r
1246 begin\r
1247   chain_length := s.max_chain_length; { max hash chain length }\r
1248   scan := @(s.window^[s.strstart]);\r
1249   best_len := s.prev_length;              { best match length so far }\r
1250   nice_match := s.nice_match;             { stop if match long enough }\r
1251 \r
1252 \r
1253   MAX_DIST := s.w_size - MIN_LOOKAHEAD;\r
1254 {In order to simplify the code, particularly on 16 bit machines, match\r
1255 distances are limited to MAX_DIST instead of WSIZE. }\r
1256 \r
1257   if s.strstart > IPos(MAX_DIST) then\r
1258     limit := s.strstart - IPos(MAX_DIST)\r
1259   else\r
1260     limit := ZNIL;\r
1261   { Stop when cur_match becomes <= limit. To simplify the code,\r
1262     we prevent matches with the string of window index 0. }\r
1263 \r
1264   prev := s.prev;\r
1265   wmask := s.w_mask;\r
1266 \r
1267 {$ifdef UNALIGNED_OK}\r
1268   { Compare two bytes at a time. Note: this is not always beneficial.\r
1269     Try with and without -DUNALIGNED_OK to check. }\r
1270 \r
1271   strend := pBytef(@(s.window^[s.strstart + MAX_MATCH - 1]));\r
1272   scan_start := pushf(scan)^;\r
1273   scan_end   := pushfArray(scan)^[best_len-1];   { fix }\r
1274 {$else}\r
1275   strend := pBytef(@(s.window^[s.strstart + MAX_MATCH]));\r
1276   {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}\r
1277   scan_end1  := pzByteArray(scan)^[best_len-1];\r
1278   {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}\r
1279   scan_end   := pzByteArray(scan)^[best_len];\r
1280 {$endif}\r
1281 \r
1282     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.\r
1283       It is easy to get rid of this optimization if necessary. }\r
1284     {$IFDEF DEBUG}\r
1285     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');\r
1286     {$ENDIF}\r
1287     { Do not waste too much time if we already have a good match: }\r
1288     if (s.prev_length >= s.good_match) then\r
1289     begin\r
1290       chain_length := chain_length shr 2;\r
1291     end;\r
1292 \r
1293     { Do not look for matches beyond the end of the input. This is necessary\r
1294       to make deflate deterministic. }\r
1295 \r
1296     if (uInt(nice_match) > s.lookahead) then\r
1297       nice_match := s.lookahead;\r
1298     {$IFDEF DEBUG}\r
1299     Assert(ulg(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');\r
1300     {$ENDIF}\r
1301     repeat\r
1302         {$IFDEF DEBUG}\r
1303         Assert(cur_match < s.strstart, 'no future');\r
1304         {$ENDIF}\r
1305         match := @(s.window^[cur_match]);\r
1306 \r
1307         { Skip to next match if the match length cannot increase\r
1308           or if the match length is less than 2: }\r
1309 \r
1310 {$undef DO_UNALIGNED_OK}\r
1311 {$ifdef UNALIGNED_OK}\r
1312   {$ifdef MAX_MATCH_IS_258}\r
1313     {$define DO_UNALIGNED_OK}\r
1314   {$endif}\r
1315 {$endif}\r
1316 \r
1317 {$ifdef DO_UNALIGNED_OK}\r
1318         { This code assumes sizeof(unsigned short) = 2. Do not use\r
1319           UNALIGNED_OK if your compiler uses a different size. }\r
1320   {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}\r
1321         if (pushfArray(match)^[best_len-1] <> scan_end) or\r
1322            (pushf(match)^ <> scan_start) then\r
1323           goto nextstep; {continue;}\r
1324   {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}\r
1325 \r
1326         { It is not necessary to compare scan[2] and match[2] since they are\r
1327           always equal when the other bytes match, given that the hash keys\r
1328           are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at\r
1329           strstart+3, +5, ... up to strstart+257. We check for insufficient\r
1330           lookahead only every 4th comparison; the 128th check will be made\r
1331           at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is\r
1332           necessary to put more guard bytes at the end of the window, or\r
1333           to check more often for insufficient lookahead. }\r
1334         {$IFDEF DEBUG}\r
1335         Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?');\r
1336         {$ENDIF}\r
1337         Inc(scan);\r
1338         Inc(match);\r
1339 \r
1340         repeat\r
1341           Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;\r
1342           Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;\r
1343           Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;\r
1344           Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break;\r
1345         until (ptr2int(scan) >= ptr2int(strend));\r
1346         { The funny "do while" generates better code on most compilers }\r
1347 \r
1348         { Here, scan <= window+strstart+257 }\r
1349         {$IFDEF DEBUG}\r
1350         {$ifopt R+} {$define RangeCheck} {$endif} {$R-}\r
1351         Assert(ptr2int(scan) <=\r
1352                ptr2int(@(s.window^[unsigned(s.window_size-1)])),\r
1353                'wild scan');\r
1354         {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif}\r
1355         {$ENDIF}\r
1356         if (scan^ = match^) then\r
1357           Inc(scan);\r
1358 \r
1359         len := (MAX_MATCH - 1) - int(ptr2int(strend)) + int(ptr2int(scan));\r
1360         scan := strend;\r
1361         Dec(scan, (MAX_MATCH-1));\r
1362 \r
1363 {$else} { UNALIGNED_OK }\r
1364 \r
1365   {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}\r
1366         if (pzByteArray(match)^[best_len]   <> scan_end) or\r
1367            (pzByteArray(match)^[best_len-1] <> scan_end1) or\r
1368            (match^ <> scan^) then\r
1369           goto nextstep; {continue;}\r
1370   {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}\r
1371         Inc(match);\r
1372         if (match^ <> pzByteArray(scan)^[1]) then\r
1373           goto nextstep; {continue;}\r
1374 \r
1375         { The check at best_len-1 can be removed because it will be made\r
1376           again later. (This heuristic is not always a win.)\r
1377           It is not necessary to compare scan[2] and match[2] since they\r
1378           are always equal when the other bytes match, given that\r
1379           the hash keys are equal and that HASH_BITS >= 8. }\r
1380 \r
1381         Inc(scan, 2);\r
1382         Inc(match);\r
1383         {$IFDEF DEBUG}\r
1384         Assert( scan^ = match^, 'match[2]?');\r
1385         {$ENDIF}\r
1386         { We check for insufficient lookahead only every 8th comparison;\r
1387           the 256th check will be made at strstart+258. }\r
1388 \r
1389         repeat\r
1390           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1391           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1392           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1393           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1394           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1395           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1396           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1397           Inc(scan); Inc(match); if (scan^ <> match^) then break;\r
1398         until (ptr2int(scan) >= ptr2int(strend));\r
1399 \r
1400         {$IFDEF DEBUG}\r
1401         Assert(ptr2int(scan) <=\r
1402                ptr2int(@(s.window^[unsigned(s.window_size-1)])),\r
1403                'wild scan');\r
1404         {$ENDIF}\r
1405 \r
1406         len := MAX_MATCH - int(ptr2int(strend) - ptr2int(scan));\r
1407         scan := strend;\r
1408         Dec(scan, MAX_MATCH);\r
1409 \r
1410 {$endif} { UNALIGNED_OK }\r
1411 \r
1412         if (len > best_len) then\r
1413         begin\r
1414             s.match_start := cur_match;\r
1415             best_len := len;\r
1416             if (len >= nice_match) then\r
1417               break;\r
1418   {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}\r
1419 {$ifdef UNALIGNED_OK}\r
1420             scan_end   := pzByteArray(scan)^[best_len-1];\r
1421 {$else}\r
1422             scan_end1  := pzByteArray(scan)^[best_len-1];\r
1423             scan_end   := pzByteArray(scan)^[best_len];\r
1424 {$endif}\r
1425   {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}\r
1426         end;\r
1427     nextstep:\r
1428       cur_match := prev^[cur_match and wmask];\r
1429       Dec(chain_length);\r
1430     until (cur_match <= limit) or (chain_length = 0);\r
1431 \r
1432     if (uInt(best_len) <= s.lookahead) then\r
1433       longest_match := uInt(best_len)\r
1434     else\r
1435       longest_match := s.lookahead;\r
1436 end;\r
1437 {$endif} { ASMV }\r
1438 \r
1439 {$else} { FASTEST }\r
1440 { ---------------------------------------------------------------------------\r
1441   Optimized version for level = 1 only }\r
1442 \r
1443 {local}\r
1444 function longest_match(var s : deflate_state;\r
1445                        cur_match : IPos  { current match }\r
1446                        ) : uInt;\r
1447 var\r
1448   {register} scan : pBytef;   { current string }\r
1449   {register} match : pBytef;  { matched string }\r
1450   {register} len : int;       { length of current match }\r
1451   {register} strend : pBytef;\r
1452 begin\r
1453   scan := @s.window^[s.strstart];\r
1454   strend := @s.window^[s.strstart + MAX_MATCH];\r
1455 \r
1456 \r
1457     { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.\r
1458       It is easy to get rid of this optimization if necessary. }\r
1459     {$IFDEF DEBUG}\r
1460     Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');\r
1461 \r
1462     Assert(ulg(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');\r
1463 \r
1464     Assert(cur_match < s.strstart, 'no future');\r
1465     {$ENDIF}\r
1466     match := s.window + cur_match;\r
1467 \r
1468     { Return failure if the match length is less than 2: }\r
1469 \r
1470     if (match[0] <> scan[0]) or (match[1] <> scan[1]) then\r
1471     begin\r
1472       longest_match := MIN_MATCH-1;\r
1473       exit;\r
1474     end;\r
1475 \r
1476     { The check at best_len-1 can be removed because it will be made\r
1477       again later. (This heuristic is not always a win.)\r
1478       It is not necessary to compare scan[2] and match[2] since they\r
1479       are always equal when the other bytes match, given that\r
1480       the hash keys are equal and that HASH_BITS >= 8. }\r
1481 \r
1482     scan += 2, match += 2;\r
1483     Assert(scan^ = match^, 'match[2]?');\r
1484 \r
1485     { We check for insufficient lookahead only every 8th comparison;\r
1486       the 256th check will be made at strstart+258. }\r
1487 \r
1488     repeat\r
1489       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1490       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1491       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1492       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1493       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1494       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1495       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1496       Inc(scan); Inc(match); if scan^<>match^ then break;\r
1497     until (ptr2int(scan) >= ptr2int(strend));\r
1498 \r
1499     Assert(scan <= s.window+unsigned(s.window_size-1), 'wild scan');\r
1500 \r
1501     len := MAX_MATCH - int(strend - scan);\r
1502 \r
1503     if (len < MIN_MATCH) then\r
1504     begin\r
1505       return := MIN_MATCH - 1;\r
1506       exit;\r
1507     end;\r
1508 \r
1509     s.match_start := cur_match;\r
1510     if len <= s.lookahead then\r
1511       longest_match := len\r
1512     else\r
1513       longest_match := s.lookahead;\r
1514 end;\r
1515 {$endif} { FASTEST }\r
1516 \r
1517 {$ifdef DEBUG}\r
1518 { ===========================================================================\r
1519   Check that the match at match_start is indeed a match. }\r
1520 \r
1521 {local}\r
1522 procedure check_match(var s : deflate_state;\r
1523                       start, match : IPos;\r
1524                       length : int);\r
1525 begin\r
1526   exit;\r
1527   { check that the match is indeed a match }\r
1528   if (zmemcmp(pBytef(@s.window^[match]),\r
1529               pBytef(@s.window^[start]), length) <> EQUAL) then\r
1530   begin\r
1531     WriteLn(' start ',start,', match ',match ,' length ', length);\r
1532     repeat\r
1533       Write(char(s.window^[match]), char(s.window^[start]));\r
1534       Inc(match);\r
1535       Inc(start);\r
1536       Dec(length);\r
1537     Until (length = 0);\r
1538     z_error('invalid match');\r
1539   end;\r
1540   if (z_verbose > 1) then\r
1541   begin\r
1542     Write('\\[',start-match,',',length,']');\r
1543     repeat\r
1544        Write(char(s.window^[start]));\r
1545        Inc(start);\r
1546        Dec(length);\r
1547     Until (length = 0);\r
1548   end;\r
1549 end;\r
1550 {$endif}\r
1551 \r
1552 { ===========================================================================\r
1553   Fill the window when the lookahead becomes insufficient.\r
1554   Updates strstart and lookahead.\r
1555 \r
1556   IN assertion: lookahead < MIN_LOOKAHEAD\r
1557   OUT assertions: strstart <= window_size-MIN_LOOKAHEAD\r
1558      At least one byte has been read, or avail_in = 0; reads are\r
1559      performed for at least two bytes (required for the zip translate_eol\r
1560      option -- not supported here). }\r
1561 \r
1562 {local}\r
1563 procedure fill_window(var s : deflate_state);\r
1564 var\r
1565   {register} n, m : unsigned;\r
1566   {register} p : pPosf;\r
1567   more : unsigned;    { Amount of free space at the end of the window. }\r
1568   wsize : uInt;\r
1569 begin\r
1570    wsize := s.w_size;\r
1571    repeat\r
1572      more := unsigned(s.window_size -ulg(s.lookahead) -ulg(s.strstart));\r
1573 \r
1574      { Deal with !@#$% 64K limit: }\r
1575      if (more = 0) and (s.strstart = 0) and (s.lookahead = 0) then\r
1576        more := wsize\r
1577      else\r
1578      if (more = unsigned(-1)) then\r
1579      begin\r
1580        { Very unlikely, but possible on 16 bit machine if strstart = 0\r
1581          and lookahead = 1 (input done one byte at time) }\r
1582        Dec(more);\r
1583 \r
1584        { If the window is almost full and there is insufficient lookahead,\r
1585          move the upper half to the lower one to make room in the upper half.}\r
1586      end\r
1587      else\r
1588        if (s.strstart >= wsize+ {MAX_DIST}(wsize-MIN_LOOKAHEAD)) then\r
1589        begin\r
1590          zmemcpy( pBytef(s.window), pBytef(@(s.window^[wsize])),\r
1591                  unsigned(wsize));\r
1592          Dec(s.match_start, wsize);\r
1593          Dec(s.strstart, wsize); { we now have strstart >= MAX_DIST }\r
1594          Dec(s.block_start, long(wsize));\r
1595 \r
1596          { Slide the hash table (could be avoided with 32 bit values\r
1597            at the expense of memory usage). We slide even when level = 0\r
1598            to keep the hash table consistent if we switch back to level > 0\r
1599            later. (Using level 0 permanently is not an optimal usage of\r
1600            zlib, so we don't care about this pathological case.) }\r
1601 \r
1602          n := s.hash_size;\r
1603          p := @s.head^[n];\r
1604          repeat\r
1605            Dec(p);\r
1606            m := p^;\r
1607            if (m >= wsize) then\r
1608              p^ := Pos(m-wsize)\r
1609            else\r
1610              p^ := Pos(ZNIL);\r
1611            Dec(n);\r
1612          Until (n=0);\r
1613 \r
1614          n := wsize;\r
1615 {$ifndef FASTEST}\r
1616          p := @s.prev^[n];\r
1617          repeat\r
1618            Dec(p);\r
1619            m := p^;\r
1620            if (m >= wsize) then\r
1621              p^ := Pos(m-wsize)\r
1622            else\r
1623              p^:= Pos(ZNIL);\r
1624              { If n is not on any hash chain, prev^[n] is garbage but\r
1625                its value will never be used. }\r
1626            Dec(n);\r
1627          Until (n=0);\r
1628 {$endif}\r
1629          Inc(more, wsize);\r
1630      end;\r
1631      if (s.strm^.avail_in = 0) then\r
1632        exit;\r
1633 \r
1634      {* If there was no sliding:\r
1635       *    strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&\r
1636       *    more == window_size - lookahead - strstart\r
1637       * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1)\r
1638       * => more >= window_size - 2*WSIZE + 2\r
1639       * In the BIG_MEM or MMAP case (not yet supported),\r
1640       *   window_size == input_size + MIN_LOOKAHEAD  &&\r
1641       *   strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD.\r
1642       * Otherwise, window_size == 2*WSIZE so more >= 2.\r
1643       * If there was sliding, more >= WSIZE. So in all cases, more >= 2. }\r
1644 \r
1645      {$IFDEF DEBUG}\r
1646      Assert(more >= 2, 'more < 2');\r
1647      {$ENDIF}\r
1648 \r
1649      n := read_buf(s.strm, pBytef(@(s.window^[s.strstart + s.lookahead])),\r
1650                   more);\r
1651      Inc(s.lookahead, n);\r
1652 \r
1653      { Initialize the hash value now that we have some input: }\r
1654      if (s.lookahead >= MIN_MATCH) then\r
1655      begin\r
1656        s.ins_h := s.window^[s.strstart];\r
1657        {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);}\r
1658        s.ins_h := ((s.ins_h shl s.hash_shift) xor s.window^[s.strstart+1])\r
1659                      and s.hash_mask;\r
1660 {$ifdef MIN_MATCH <> 3}\r
1661        Call UPDATE_HASH() MIN_MATCH-3 more times\r
1662 {$endif}\r
1663      end;\r
1664      { If the whole input has less than MIN_MATCH bytes, ins_h is garbage,\r
1665        but this is not important since only literal bytes will be emitted. }\r
1666 \r
1667    until (s.lookahead >= MIN_LOOKAHEAD) or (s.strm^.avail_in = 0);\r
1668 end;\r
1669 \r
1670 { ===========================================================================\r
1671   Flush the current block, with given end-of-file flag.\r
1672   IN assertion: strstart is set to the end of the current match. }\r
1673 \r
1674 procedure FLUSH_BLOCK_ONLY(var s : deflate_state; eof : boolean); {macro}\r
1675 begin\r
1676   if (s.block_start >= Long(0)) then\r
1677     _tr_flush_block(s, pcharf(@s.window^[unsigned(s.block_start)]),\r
1678                     ulg(long(s.strstart) - s.block_start), eof)\r
1679   else\r
1680     _tr_flush_block(s, pcharf(Z_NULL),\r
1681                     ulg(long(s.strstart) - s.block_start), eof);\r
1682 \r
1683   s.block_start := s.strstart;\r
1684   flush_pending(s.strm^);\r
1685   {$IFDEF DEBUG}\r
1686   Tracev('[FLUSH]');\r
1687   {$ENDIF}\r
1688 end;\r
1689 \r
1690 { Same but force premature exit if necessary.\r
1691 macro FLUSH_BLOCK(var s : deflate_state; eof : boolean) : boolean;\r
1692 var\r
1693   result : block_state;\r
1694 begin\r
1695  FLUSH_BLOCK_ONLY(s, eof);\r
1696  if (s.strm^.avail_out = 0) then\r
1697  begin\r
1698    if eof then\r
1699      result := finish_started\r
1700    else\r
1701      result := need_more;\r
1702    exit;\r
1703  end;\r
1704 end;\r
1705 }\r
1706 \r
1707 { ===========================================================================\r
1708   Copy without compression as much as possible from the input stream, return\r
1709   the current block state.\r
1710   This function does not insert new strings in the dictionary since\r
1711   uncompressible data is probably not useful. This function is used\r
1712   only for the level=0 compression option.\r
1713   NOTE: this function should be optimized to avoid extra copying from\r
1714   window to pending_buf. }\r
1715 \r
1716 \r
1717 {local}\r
1718 function deflate_stored(var s : deflate_state; flush : int) : block_state;\r
1719 { Stored blocks are limited to 0xffff bytes, pending_buf is limited\r
1720   to pending_buf_size, and each stored block has a 5 byte header: }\r
1721 var\r
1722   max_block_size : ulg;\r
1723   max_start : ulg;\r
1724 begin\r
1725   max_block_size := $ffff;\r
1726   if (max_block_size > s.pending_buf_size - 5) then\r
1727     max_block_size := s.pending_buf_size - 5;\r
1728 \r
1729   { Copy as much as possible from input to output: }\r
1730   while TRUE do\r
1731   begin\r
1732     { Fill the window as much as possible: }\r
1733     if (s.lookahead <= 1) then\r
1734     begin\r
1735       {$IFDEF DEBUG}\r
1736       Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or\r
1737               (s.block_start >= long(s.w_size)), 'slide too late');\r
1738       {$ENDIF}\r
1739       fill_window(s);\r
1740       if (s.lookahead = 0) and (flush = Z_NO_FLUSH) then\r
1741       begin\r
1742         deflate_stored := need_more;\r
1743         exit;\r
1744       end;\r
1745 \r
1746       if (s.lookahead = 0) then\r
1747         break; { flush the current block }\r
1748     end;\r
1749     {$IFDEF DEBUG}\r
1750     Assert(s.block_start >= long(0), 'block gone');\r
1751     {$ENDIF}\r
1752     Inc(s.strstart, s.lookahead);\r
1753     s.lookahead := 0;\r
1754 \r
1755     { Emit a stored block if pending_buf will be full: }\r
1756     max_start := s.block_start + max_block_size;\r
1757     if (s.strstart = 0) or (ulg(s.strstart) >= max_start) then\r
1758     begin\r
1759       { strstart = 0 is possible when wraparound on 16-bit machine }\r
1760       s.lookahead := uInt(s.strstart - max_start);\r
1761       s.strstart := uInt(max_start);\r
1762       {FLUSH_BLOCK(s, FALSE);}\r
1763       FLUSH_BLOCK_ONLY(s, FALSE);\r
1764       if (s.strm^.avail_out = 0) then\r
1765       begin\r
1766         deflate_stored := need_more;\r
1767         exit;\r
1768       end;\r
1769     end;\r
1770 \r
1771     { Flush if we may have to slide, otherwise block_start may become\r
1772       negative and the data will be gone: }\r
1773 \r
1774     if (s.strstart - uInt(s.block_start) >= {MAX_DIST}\r
1775         s.w_size-MIN_LOOKAHEAD) then\r
1776     begin\r
1777       {FLUSH_BLOCK(s, FALSE);}\r
1778       FLUSH_BLOCK_ONLY(s, FALSE);\r
1779       if (s.strm^.avail_out = 0) then\r
1780       begin\r
1781         deflate_stored := need_more;\r
1782         exit;\r
1783       end;\r
1784     end;\r
1785   end;\r
1786 \r
1787   {FLUSH_BLOCK(s, flush = Z_FINISH);}\r
1788   FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);\r
1789   if (s.strm^.avail_out = 0) then\r
1790   begin\r
1791     if flush = Z_FINISH then\r
1792       deflate_stored := finish_started\r
1793     else\r
1794       deflate_stored := need_more;\r
1795     exit;\r
1796   end;\r
1797 \r
1798   if flush = Z_FINISH then\r
1799     deflate_stored := finish_done\r
1800   else\r
1801     deflate_stored := block_done;\r
1802 end;\r
1803 \r
1804 { ===========================================================================\r
1805   Compress as much as possible from the input stream, return the current\r
1806   block state.\r
1807   This function does not perform lazy evaluation of matches and inserts\r
1808   new strings in the dictionary only for unmatched strings or for short\r
1809   matches. It is used only for the fast compression options. }\r
1810 \r
1811 {local}\r
1812 function deflate_fast(var s : deflate_state; flush : int) : block_state;\r
1813 var\r
1814   hash_head : IPos;     { head of the hash chain }\r
1815   bflush : boolean;     { set if current block must be flushed }\r
1816 begin\r
1817   hash_head := ZNIL;\r
1818   while TRUE do\r
1819   begin\r
1820   { Make sure that we always have enough lookahead, except\r
1821     at the end of the input file. We need MAX_MATCH bytes\r
1822     for the next match, plus MIN_MATCH bytes to insert the\r
1823     string following the next match. }\r
1824 \r
1825     if (s.lookahead < MIN_LOOKAHEAD) then\r
1826     begin\r
1827       fill_window(s);\r
1828       if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then\r
1829       begin\r
1830         deflate_fast := need_more;\r
1831         exit;\r
1832       end;\r
1833 \r
1834       if (s.lookahead = 0) then\r
1835         break; { flush the current block }\r
1836     end;\r
1837 \r
1838 \r
1839     { Insert the string window[strstart .. strstart+2] in the\r
1840       dictionary, and set hash_head to the head of the hash chain: }\r
1841 \r
1842     if (s.lookahead >= MIN_MATCH) then\r
1843     begin\r
1844       INSERT_STRING(s, s.strstart, hash_head);\r
1845     end;\r
1846 \r
1847     { Find the longest match, discarding those <= prev_length.\r
1848       At this point we have always match_length < MIN_MATCH }\r
1849     if (hash_head <> ZNIL) and\r
1850        (s.strstart - hash_head <= (s.w_size-MIN_LOOKAHEAD){MAX_DIST}) then\r
1851     begin\r
1852       { To simplify the code, we prevent matches with the string\r
1853         of window index 0 (in particular we have to avoid a match\r
1854         of the string with itself at the start of the input file). }\r
1855       if (s.strategy <> Z_HUFFMAN_ONLY) then\r
1856       begin\r
1857         s.match_length := longest_match (s, hash_head);\r
1858       end;\r
1859       { longest_match() sets match_start }\r
1860     end;\r
1861     if (s.match_length >= MIN_MATCH) then\r
1862     begin\r
1863       {$IFDEF DEBUG}\r
1864       check_match(s, s.strstart, s.match_start, s.match_length);\r
1865       {$ENDIF}\r
1866 \r
1867       {_tr_tally_dist(s, s.strstart - s.match_start,\r
1868                         s.match_length - MIN_MATCH, bflush);}\r
1869       bflush := _tr_tally(s, s.strstart - s.match_start,\r
1870                         s.match_length - MIN_MATCH);\r
1871 \r
1872       Dec(s.lookahead, s.match_length);\r
1873 \r
1874       { Insert new strings in the hash table only if the match length\r
1875         is not too large. This saves time but degrades compression. }\r
1876 \r
1877 {$ifndef FASTEST}\r
1878       if (s.match_length <= s.max_insert_length)\r
1879        and (s.lookahead >= MIN_MATCH) then\r
1880       begin\r
1881         Dec(s.match_length); { string at strstart already in hash table }\r
1882         repeat\r
1883           Inc(s.strstart);\r
1884           INSERT_STRING(s, s.strstart, hash_head);\r
1885           { strstart never exceeds WSIZE-MAX_MATCH, so there are\r
1886             always MIN_MATCH bytes ahead. }\r
1887           Dec(s.match_length);\r
1888         until (s.match_length = 0);\r
1889         Inc(s.strstart);\r
1890       end\r
1891       else\r
1892 {$endif}\r
1893 \r
1894       begin\r
1895         Inc(s.strstart, s.match_length);\r
1896         s.match_length := 0;\r
1897         s.ins_h := s.window^[s.strstart];\r
1898         {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);}\r
1899         s.ins_h := (( s.ins_h shl s.hash_shift) xor\r
1900                      s.window^[s.strstart+1]) and s.hash_mask;\r
1901 if MIN_MATCH <> 3 then   { the linker removes this }\r
1902 begin\r
1903           {Call UPDATE_HASH() MIN_MATCH-3 more times}\r
1904 end;\r
1905 \r
1906         { If lookahead < MIN_MATCH, ins_h is garbage, but it does not\r
1907           matter since it will be recomputed at next deflate call. }\r
1908 \r
1909       end;\r
1910     end\r
1911     else\r
1912     begin\r
1913       { No match, output a literal byte }\r
1914       {$IFDEF DEBUG}\r
1915       Tracevv(char(s.window^[s.strstart]));\r
1916       {$ENDIF}\r
1917       {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}\r
1918       bflush := _tr_tally (s, 0, s.window^[s.strstart]);\r
1919 \r
1920       Dec(s.lookahead);\r
1921       Inc(s.strstart);\r
1922     end;\r
1923     if bflush then\r
1924     begin  {FLUSH_BLOCK(s, FALSE);}\r
1925       FLUSH_BLOCK_ONLY(s, FALSE);\r
1926       if (s.strm^.avail_out = 0) then\r
1927       begin\r
1928         deflate_fast := need_more;\r
1929         exit;\r
1930       end;\r
1931     end;\r
1932   end;\r
1933   {FLUSH_BLOCK(s, flush = Z_FINISH);}\r
1934   FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);\r
1935   if (s.strm^.avail_out = 0) then\r
1936   begin\r
1937     if flush = Z_FINISH then\r
1938       deflate_fast := finish_started\r
1939     else\r
1940       deflate_fast := need_more;\r
1941     exit;\r
1942   end;\r
1943 \r
1944   if flush = Z_FINISH then\r
1945     deflate_fast := finish_done\r
1946   else\r
1947     deflate_fast := block_done;\r
1948 end;\r
1949 \r
1950 { ===========================================================================\r
1951   Same as above, but achieves better compression. We use a lazy\r
1952   evaluation for matches: a match is finally adopted only if there is\r
1953   no better match at the next window position. }\r
1954 \r
1955 {local}\r
1956 function deflate_slow(var s : deflate_state; flush : int) : block_state;\r
1957 var\r
1958   hash_head : IPos;       { head of hash chain }\r
1959   bflush : boolean;       { set if current block must be flushed }\r
1960 var\r
1961   max_insert : uInt;\r
1962 begin\r
1963   hash_head := ZNIL;\r
1964 \r
1965   { Process the input block. }\r
1966   while TRUE do\r
1967   begin\r
1968     { Make sure that we always have enough lookahead, except\r
1969       at the end of the input file. We need MAX_MATCH bytes\r
1970       for the next match, plus MIN_MATCH bytes to insert the\r
1971       string following the next match. }\r
1972 \r
1973     if (s.lookahead < MIN_LOOKAHEAD) then\r
1974     begin\r
1975       fill_window(s);\r
1976       if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then\r
1977       begin\r
1978         deflate_slow := need_more;\r
1979         exit;\r
1980       end;\r
1981 \r
1982       if (s.lookahead = 0) then\r
1983         break; { flush the current block }\r
1984     end;\r
1985 \r
1986     { Insert the string window[strstart .. strstart+2] in the\r
1987       dictionary, and set hash_head to the head of the hash chain: }\r
1988 \r
1989     if (s.lookahead >= MIN_MATCH) then\r
1990     begin\r
1991       INSERT_STRING(s, s.strstart, hash_head);\r
1992     end;\r
1993 \r
1994     { Find the longest match, discarding those <= prev_length. }\r
1995 \r
1996     s.prev_length := s.match_length;\r
1997     s.prev_match := s.match_start;\r
1998     s.match_length := MIN_MATCH-1;\r
1999 \r
2000     if (hash_head <> ZNIL) and (s.prev_length < s.max_lazy_match) and\r
2001        (s.strstart - hash_head <= {MAX_DIST}(s.w_size-MIN_LOOKAHEAD)) then\r
2002     begin\r
2003         { To simplify the code, we prevent matches with the string\r
2004           of window index 0 (in particular we have to avoid a match\r
2005           of the string with itself at the start of the input file). }\r
2006 \r
2007         if (s.strategy <> Z_HUFFMAN_ONLY) then\r
2008         begin\r
2009           s.match_length := longest_match (s, hash_head);\r
2010         end;\r
2011         { longest_match() sets match_start }\r
2012 \r
2013         if (s.match_length <= 5) and ((s.strategy = Z_FILTERED) or\r
2014              ((s.match_length = MIN_MATCH) and\r
2015               (s.strstart - s.match_start > TOO_FAR))) then\r
2016         begin\r
2017             { If prev_match is also MIN_MATCH, match_start is garbage\r
2018               but we will ignore the current match anyway. }\r
2019 \r
2020             s.match_length := MIN_MATCH-1;\r
2021         end;\r
2022     end;\r
2023     { If there was a match at the previous step and the current\r
2024       match is not better, output the previous match: }\r
2025 \r
2026     if (s.prev_length >= MIN_MATCH)\r
2027       and (s.match_length <= s.prev_length) then\r
2028     begin\r
2029       max_insert := s.strstart + s.lookahead - MIN_MATCH;\r
2030       { Do not insert strings in hash table beyond this. }\r
2031       {$ifdef DEBUG}\r
2032       check_match(s, s.strstart-1, s.prev_match, s.prev_length);\r
2033       {$endif}\r
2034 \r
2035       {_tr_tally_dist(s, s->strstart -1 - s->prev_match,\r
2036                         s->prev_length - MIN_MATCH, bflush);}\r
2037       bflush := _tr_tally(s, s.strstart -1 - s.prev_match,\r
2038                            s.prev_length - MIN_MATCH);\r
2039 \r
2040       { Insert in hash table all strings up to the end of the match.\r
2041         strstart-1 and strstart are already inserted. If there is not\r
2042         enough lookahead, the last two strings are not inserted in\r
2043         the hash table. }\r
2044 \r
2045       Dec(s.lookahead, s.prev_length-1);\r
2046       Dec(s.prev_length, 2);\r
2047       repeat\r
2048         Inc(s.strstart);\r
2049         if (s.strstart <= max_insert) then\r
2050         begin\r
2051           INSERT_STRING(s, s.strstart, hash_head);\r
2052         end;\r
2053         Dec(s.prev_length);\r
2054       until (s.prev_length = 0);\r
2055       s.match_available := FALSE;\r
2056       s.match_length := MIN_MATCH-1;\r
2057       Inc(s.strstart);\r
2058 \r
2059       if (bflush) then  {FLUSH_BLOCK(s, FALSE);}\r
2060       begin\r
2061         FLUSH_BLOCK_ONLY(s, FALSE);\r
2062         if (s.strm^.avail_out = 0) then\r
2063         begin\r
2064           deflate_slow := need_more;\r
2065           exit;\r
2066         end;\r
2067       end;\r
2068     end\r
2069     else\r
2070       if (s.match_available) then\r
2071       begin\r
2072         { If there was no match at the previous position, output a\r
2073           single literal. If there was a match but the current match\r
2074           is longer, truncate the previous match to a single literal. }\r
2075         {$IFDEF DEBUG}\r
2076         Tracevv(char(s.window^[s.strstart-1]));\r
2077         {$ENDIF}\r
2078         bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);\r
2079 \r
2080         if bflush then\r
2081         begin\r
2082           FLUSH_BLOCK_ONLY(s, FALSE);\r
2083         end;\r
2084         Inc(s.strstart);\r
2085         Dec(s.lookahead);\r
2086         if (s.strm^.avail_out = 0) then\r
2087         begin\r
2088           deflate_slow := need_more;\r
2089           exit;\r
2090         end;\r
2091       end\r
2092       else\r
2093       begin\r
2094         { There is no previous match to compare with, wait for\r
2095           the next step to decide. }\r
2096 \r
2097         s.match_available := TRUE;\r
2098         Inc(s.strstart);\r
2099         Dec(s.lookahead);\r
2100       end;\r
2101   end;\r
2102 \r
2103   {$IFDEF DEBUG}\r
2104   Assert (flush <> Z_NO_FLUSH, 'no flush?');\r
2105   {$ENDIF}\r
2106   if (s.match_available) then\r
2107   begin\r
2108     {$IFDEF DEBUG}\r
2109     Tracevv(char(s.window^[s.strstart-1]));\r
2110     bflush :=\r
2111     {$ENDIF}\r
2112       _tr_tally (s, 0, s.window^[s.strstart-1]);\r
2113     s.match_available := FALSE;\r
2114   end;\r
2115   {FLUSH_BLOCK(s, flush = Z_FINISH);}\r
2116   FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);\r
2117   if (s.strm^.avail_out = 0) then\r
2118   begin\r
2119     if flush = Z_FINISH then\r
2120       deflate_slow := finish_started\r
2121     else\r
2122       deflate_slow := need_more;\r
2123     exit;\r
2124   end;\r
2125   if flush = Z_FINISH then\r
2126     deflate_slow := finish_done\r
2127   else\r
2128     deflate_slow := block_done;\r
2129 end;\r
2130 \r
2131 end.