/[pngwrite]/trunk/zdeflate.pas
ViewVC logotype

Annotation of /trunk/zdeflate.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Sun Apr 13 19:38:04 2008 UTC (11 years, 5 months ago) by plugwash
File size: 75110 byte(s)
initial import

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

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22