DEADSOFTWARE

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