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

Contents of /trunk/zdeflate.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Sun Apr 13 19:38:04 2008 UTC (9 years, 8 months ago) by plugwash
File size: 75110 byte(s)
initial import
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.5