1 |
Unit trees;
|
2 |
|
3 |
{$T-}
|
4 |
{$define ORG_DEBUG}
|
5 |
{
|
6 |
trees.c -- output deflated data using Huffman coding
|
7 |
Copyright (C) 1995-1998 Jean-loup Gailly
|
8 |
|
9 |
Pascal tranlastion
|
10 |
Copyright (C) 1998 by Jacques Nomssi Nzali
|
11 |
For conditions of distribution and use, see copyright notice in readme.paszlib
|
12 |
}
|
13 |
|
14 |
{
|
15 |
* ALGORITHM
|
16 |
*
|
17 |
* The "deflation" process uses several Huffman trees. The more
|
18 |
* common source values are represented by shorter bit sequences.
|
19 |
*
|
20 |
* Each code tree is stored in a compressed form which is itself
|
21 |
* a Huffman encoding of the lengths of all the code strings (in
|
22 |
* ascending order by source values). The actual code strings are
|
23 |
* reconstructed from the lengths in the inflate process, as described
|
24 |
* in the deflate specification.
|
25 |
*
|
26 |
* REFERENCES
|
27 |
*
|
28 |
* Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
|
29 |
* Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
|
30 |
*
|
31 |
* Storer, James A.
|
32 |
* Data Compression: Methods and Theory, pp. 49-50.
|
33 |
* Computer Science Press, 1988. ISBN 0-7167-8156-5.
|
34 |
*
|
35 |
* Sedgewick, R.
|
36 |
* Algorithms, p290.
|
37 |
* Addison-Wesley, 1983. ISBN 0-201-06672-6.
|
38 |
}
|
39 |
|
40 |
interface
|
41 |
|
42 |
{$I zconf.inc}
|
43 |
|
44 |
uses
|
45 |
{$ifdef DEBUG}
|
46 |
strutils,
|
47 |
{$ENDIF}
|
48 |
zutil, zlib;
|
49 |
|
50 |
{ ===========================================================================
|
51 |
Internal compression state. }
|
52 |
|
53 |
const
|
54 |
LENGTH_CODES = 29;
|
55 |
{ number of length codes, not counting the special END_BLOCK code }
|
56 |
|
57 |
LITERALS = 256;
|
58 |
{ number of literal bytes 0..255 }
|
59 |
|
60 |
L_CODES = (LITERALS+1+LENGTH_CODES);
|
61 |
{ number of Literal or Length codes, including the END_BLOCK code }
|
62 |
|
63 |
D_CODES = 30;
|
64 |
{ number of distance codes }
|
65 |
|
66 |
BL_CODES = 19;
|
67 |
{ number of codes used to transfer the bit lengths }
|
68 |
|
69 |
HEAP_SIZE = (2*L_CODES+1);
|
70 |
{ maximum heap size }
|
71 |
|
72 |
MAX_BITS = 15;
|
73 |
{ All codes must not exceed MAX_BITS bits }
|
74 |
|
75 |
const
|
76 |
INIT_STATE = 42;
|
77 |
BUSY_STATE = 113;
|
78 |
FINISH_STATE = 666;
|
79 |
{ Stream status }
|
80 |
|
81 |
|
82 |
{ Data structure describing a single value and its code string. }
|
83 |
type
|
84 |
ct_data_ptr = ^ct_data;
|
85 |
ct_data = record
|
86 |
fc : record
|
87 |
case byte of
|
88 |
0:(freq : ush); { frequency count }
|
89 |
1:(code : ush); { bit string }
|
90 |
end;
|
91 |
dl : record
|
92 |
case byte of
|
93 |
0:(dad : ush); { father node in Huffman tree }
|
94 |
1:(len : ush); { length of bit string }
|
95 |
end;
|
96 |
end;
|
97 |
|
98 |
{ Freq = fc.freq
|
99 |
Code = fc.code
|
100 |
Dad = dl.dad
|
101 |
Len = dl.len }
|
102 |
|
103 |
type
|
104 |
ltree_type = array[0..HEAP_SIZE-1] of ct_data; { literal and length tree }
|
105 |
dtree_type = array[0..2*D_CODES+1-1] of ct_data; { distance tree }
|
106 |
htree_type = array[0..2*BL_CODES+1-1] of ct_data; { Huffman tree for bit lengths }
|
107 |
{ generic tree type }
|
108 |
tree_type = array[0..(MaxMemBlock div SizeOf(ct_data))-1] of ct_data;
|
109 |
|
110 |
tree_ptr = ^tree_type;
|
111 |
ltree_ptr = ^ltree_type;
|
112 |
dtree_ptr = ^dtree_type;
|
113 |
htree_ptr = ^htree_type;
|
114 |
|
115 |
|
116 |
type
|
117 |
static_tree_desc_ptr = ^static_tree_desc;
|
118 |
static_tree_desc =
|
119 |
record
|
120 |
{const} static_tree : tree_ptr; { static tree or NIL }
|
121 |
{const} extra_bits : pzIntfArray; { extra bits for each code or NIL }
|
122 |
extra_base : int; { base index for extra_bits }
|
123 |
elems : int; { max number of elements in the tree }
|
124 |
max_length : int; { max bit length for the codes }
|
125 |
end;
|
126 |
|
127 |
tree_desc_ptr = ^tree_desc;
|
128 |
tree_desc = record
|
129 |
dyn_tree : tree_ptr; { the dynamic tree }
|
130 |
max_code : int; { largest code with non zero frequency }
|
131 |
stat_desc : static_tree_desc_ptr; { the corresponding static tree }
|
132 |
end;
|
133 |
|
134 |
type
|
135 |
Pos = ush;
|
136 |
Posf = Pos; {FAR}
|
137 |
IPos = uInt;
|
138 |
|
139 |
pPosf = ^Posf;
|
140 |
|
141 |
zPosfArray = array[0..(MaxMemBlock div SizeOf(Posf))-1] of Posf;
|
142 |
pzPosfArray = ^zPosfArray;
|
143 |
|
144 |
{ A Pos is an index in the character window. We use short instead of int to
|
145 |
save space in the various tables. IPos is used only for parameter passing.}
|
146 |
|
147 |
type
|
148 |
deflate_state_ptr = ^deflate_state;
|
149 |
deflate_state = record
|
150 |
strm : z_streamp; { pointer back to this zlib stream }
|
151 |
status : int; { as the name implies }
|
152 |
pending_buf : pzByteArray; { output still pending }
|
153 |
pending_buf_size : ulg; { size of pending_buf }
|
154 |
pending_out : pBytef; { next pending byte to output to the stream }
|
155 |
pending : int; { nb of bytes in the pending buffer }
|
156 |
noheader : int; { suppress zlib header and adler32 }
|
157 |
data_type : Byte; { UNKNOWN, BINARY or ASCII }
|
158 |
method : Byte; { STORED (for zip only) or DEFLATED }
|
159 |
last_flush : int; { value of flush param for previous deflate call }
|
160 |
|
161 |
{ used by deflate.pas: }
|
162 |
|
163 |
w_size : uInt; { LZ77 window size (32K by default) }
|
164 |
w_bits : uInt; { log2(w_size) (8..16) }
|
165 |
w_mask : uInt; { w_size - 1 }
|
166 |
|
167 |
window : pzByteArray;
|
168 |
{ Sliding window. Input bytes are read into the second half of the window,
|
169 |
and move to the first half later to keep a dictionary of at least wSize
|
170 |
bytes. With this organization, matches are limited to a distance of
|
171 |
wSize-MAX_MATCH bytes, but this ensures that IO is always
|
172 |
performed with a length multiple of the block size. Also, it limits
|
173 |
the window size to 64K, which is quite useful on MSDOS.
|
174 |
To do: use the user input buffer as sliding window. }
|
175 |
|
176 |
window_size : ulg;
|
177 |
{ Actual size of window: 2*wSize, except when the user input buffer
|
178 |
is directly used as sliding window. }
|
179 |
|
180 |
prev : pzPosfArray;
|
181 |
{ Link to older string with same hash index. To limit the size of this
|
182 |
array to 64K, this link is maintained only for the last 32K strings.
|
183 |
An index in this array is thus a window index modulo 32K. }
|
184 |
|
185 |
head : pzPosfArray; { Heads of the hash chains or NIL. }
|
186 |
|
187 |
ins_h : uInt; { hash index of string to be inserted }
|
188 |
hash_size : uInt; { number of elements in hash table }
|
189 |
hash_bits : uInt; { log2(hash_size) }
|
190 |
hash_mask : uInt; { hash_size-1 }
|
191 |
|
192 |
hash_shift : uInt;
|
193 |
{ Number of bits by which ins_h must be shifted at each input
|
194 |
step. It must be such that after MIN_MATCH steps, the oldest
|
195 |
byte no longer takes part in the hash key, that is:
|
196 |
hash_shift * MIN_MATCH >= hash_bits }
|
197 |
|
198 |
block_start : long;
|
199 |
{ Window position at the beginning of the current output block. Gets
|
200 |
negative when the window is moved backwards. }
|
201 |
|
202 |
match_length : uInt; { length of best match }
|
203 |
prev_match : IPos; { previous match }
|
204 |
match_available : boolean; { set if previous match exists }
|
205 |
strstart : uInt; { start of string to insert }
|
206 |
match_start : uInt; { start of matching string }
|
207 |
lookahead : uInt; { number of valid bytes ahead in window }
|
208 |
|
209 |
prev_length : uInt;
|
210 |
{ Length of the best match at previous step. Matches not greater than this
|
211 |
are discarded. This is used in the lazy match evaluation. }
|
212 |
|
213 |
max_chain_length : uInt;
|
214 |
{ To speed up deflation, hash chains are never searched beyond this
|
215 |
length. A higher limit improves compression ratio but degrades the
|
216 |
speed. }
|
217 |
|
218 |
{ moved to the end because Borland Pascal won't accept the following:
|
219 |
max_lazy_match : uInt;
|
220 |
max_insert_length : uInt absolute max_lazy_match;
|
221 |
}
|
222 |
|
223 |
level : int; { compression level (1..9) }
|
224 |
strategy : int; { favor or force Huffman coding}
|
225 |
|
226 |
good_match : uInt;
|
227 |
{ Use a faster search when the previous match is longer than this }
|
228 |
|
229 |
nice_match : int; { Stop searching when current match exceeds this }
|
230 |
|
231 |
{ used by trees.pas: }
|
232 |
{ Didn't use ct_data typedef below to supress compiler warning }
|
233 |
dyn_ltree : ltree_type; { literal and length tree }
|
234 |
dyn_dtree : dtree_type; { distance tree }
|
235 |
bl_tree : htree_type; { Huffman tree for bit lengths }
|
236 |
|
237 |
l_desc : tree_desc; { desc. for literal tree }
|
238 |
d_desc : tree_desc; { desc. for distance tree }
|
239 |
bl_desc : tree_desc; { desc. for bit length tree }
|
240 |
|
241 |
bl_count : array[0..MAX_BITS+1-1] of ush;
|
242 |
{ number of codes at each bit length for an optimal tree }
|
243 |
|
244 |
heap : array[0..2*L_CODES+1-1] of int; { heap used to build the Huffman trees }
|
245 |
heap_len : int; { number of elements in the heap }
|
246 |
heap_max : int; { element of largest frequency }
|
247 |
{ The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used.
|
248 |
The same heap array is used to build all trees. }
|
249 |
|
250 |
depth : array[0..2*L_CODES+1-1] of uch;
|
251 |
{ Depth of each subtree used as tie breaker for trees of equal frequency }
|
252 |
|
253 |
|
254 |
l_buf : puchfArray; { buffer for literals or lengths }
|
255 |
|
256 |
lit_bufsize : uInt;
|
257 |
{ Size of match buffer for literals/lengths. There are 4 reasons for
|
258 |
limiting lit_bufsize to 64K:
|
259 |
- frequencies can be kept in 16 bit counters
|
260 |
- if compression is not successful for the first block, all input
|
261 |
data is still in the window so we can still emit a stored block even
|
262 |
when input comes from standard input. (This can also be done for
|
263 |
all blocks if lit_bufsize is not greater than 32K.)
|
264 |
- if compression is not successful for a file smaller than 64K, we can
|
265 |
even emit a stored file instead of a stored block (saving 5 bytes).
|
266 |
This is applicable only for zip (not gzip or zlib).
|
267 |
- creating new Huffman trees less frequently may not provide fast
|
268 |
adaptation to changes in the input data statistics. (Take for
|
269 |
example a binary file with poorly compressible code followed by
|
270 |
a highly compressible string table.) Smaller buffer sizes give
|
271 |
fast adaptation but have of course the overhead of transmitting
|
272 |
trees more frequently.
|
273 |
- I can't count above 4 }
|
274 |
|
275 |
|
276 |
last_lit : uInt; { running index in l_buf }
|
277 |
|
278 |
d_buf : pushfArray;
|
279 |
{ Buffer for distances. To simplify the code, d_buf and l_buf have
|
280 |
the same number of elements. To use different lengths, an extra flag
|
281 |
array would be necessary. }
|
282 |
|
283 |
opt_len : ulg; { bit length of current block with optimal trees }
|
284 |
static_len : ulg; { bit length of current block with static trees }
|
285 |
compressed_len : ulg; { total bit length of compressed file }
|
286 |
matches : uInt; { number of string matches in current block }
|
287 |
last_eob_len : int; { bit length of EOB code for last block }
|
288 |
|
289 |
{$ifdef DEBUG}
|
290 |
bits_sent : ulg; { bit length of the compressed data }
|
291 |
{$endif}
|
292 |
|
293 |
bi_buf : ush;
|
294 |
{ Output buffer. bits are inserted starting at the bottom (least
|
295 |
significant bits). }
|
296 |
|
297 |
bi_valid : int;
|
298 |
{ Number of valid bits in bi_buf. All bits above the last valid bit
|
299 |
are always zero. }
|
300 |
|
301 |
case byte of
|
302 |
0:(max_lazy_match : uInt);
|
303 |
{ Attempt to find a better match only when the current match is strictly
|
304 |
smaller than this value. This mechanism is used only for compression
|
305 |
levels >= 4. }
|
306 |
|
307 |
1:(max_insert_length : uInt);
|
308 |
{ Insert new strings in the hash table only if the match length is not
|
309 |
greater than this length. This saves time but degrades compression.
|
310 |
max_insert_length is used only for compression levels <= 3. }
|
311 |
end;
|
312 |
|
313 |
procedure _tr_init (var s : deflate_state);
|
314 |
|
315 |
function _tr_tally (var s : deflate_state;
|
316 |
dist : unsigned;
|
317 |
lc : unsigned) : boolean;
|
318 |
|
319 |
function _tr_flush_block (var s : deflate_state;
|
320 |
buf : pcharf;
|
321 |
stored_len : ulg;
|
322 |
eof : boolean) : ulg;
|
323 |
|
324 |
procedure _tr_align(var s : deflate_state);
|
325 |
|
326 |
procedure _tr_stored_block(var s : deflate_state;
|
327 |
buf : pcharf;
|
328 |
stored_len : ulg;
|
329 |
eof : boolean);
|
330 |
|
331 |
implementation
|
332 |
|
333 |
{ #define GEN_TREES_H }
|
334 |
|
335 |
{$ifndef GEN_TREES_H}
|
336 |
{ header created automatically with -DGEN_TREES_H }
|
337 |
|
338 |
const
|
339 |
DIST_CODE_LEN = 512; { see definition of array dist_code below }
|
340 |
|
341 |
{ The static literal tree. Since the bit lengths are imposed, there is no
|
342 |
need for the L_CODES extra codes used during heap construction. However
|
343 |
The codes 286 and 287 are needed to build a canonical tree (see _tr_init
|
344 |
below). }
|
345 |
const
|
346 |
static_ltree : array[0..L_CODES+2-1] of ct_data = (
|
347 |
{ fc:(freq, code) dl:(dad,len) }
|
348 |
(fc:(freq: 12);dl:(len: 8)), (fc:(freq:140);dl:(len: 8)), (fc:(freq: 76);dl:(len: 8)),
|
349 |
(fc:(freq:204);dl:(len: 8)), (fc:(freq: 44);dl:(len: 8)), (fc:(freq:172);dl:(len: 8)),
|
350 |
(fc:(freq:108);dl:(len: 8)), (fc:(freq:236);dl:(len: 8)), (fc:(freq: 28);dl:(len: 8)),
|
351 |
(fc:(freq:156);dl:(len: 8)), (fc:(freq: 92);dl:(len: 8)), (fc:(freq:220);dl:(len: 8)),
|
352 |
(fc:(freq: 60);dl:(len: 8)), (fc:(freq:188);dl:(len: 8)), (fc:(freq:124);dl:(len: 8)),
|
353 |
(fc:(freq:252);dl:(len: 8)), (fc:(freq: 2);dl:(len: 8)), (fc:(freq:130);dl:(len: 8)),
|
354 |
(fc:(freq: 66);dl:(len: 8)), (fc:(freq:194);dl:(len: 8)), (fc:(freq: 34);dl:(len: 8)),
|
355 |
(fc:(freq:162);dl:(len: 8)), (fc:(freq: 98);dl:(len: 8)), (fc:(freq:226);dl:(len: 8)),
|
356 |
(fc:(freq: 18);dl:(len: 8)), (fc:(freq:146);dl:(len: 8)), (fc:(freq: 82);dl:(len: 8)),
|
357 |
(fc:(freq:210);dl:(len: 8)), (fc:(freq: 50);dl:(len: 8)), (fc:(freq:178);dl:(len: 8)),
|
358 |
(fc:(freq:114);dl:(len: 8)), (fc:(freq:242);dl:(len: 8)), (fc:(freq: 10);dl:(len: 8)),
|
359 |
(fc:(freq:138);dl:(len: 8)), (fc:(freq: 74);dl:(len: 8)), (fc:(freq:202);dl:(len: 8)),
|
360 |
(fc:(freq: 42);dl:(len: 8)), (fc:(freq:170);dl:(len: 8)), (fc:(freq:106);dl:(len: 8)),
|
361 |
(fc:(freq:234);dl:(len: 8)), (fc:(freq: 26);dl:(len: 8)), (fc:(freq:154);dl:(len: 8)),
|
362 |
(fc:(freq: 90);dl:(len: 8)), (fc:(freq:218);dl:(len: 8)), (fc:(freq: 58);dl:(len: 8)),
|
363 |
(fc:(freq:186);dl:(len: 8)), (fc:(freq:122);dl:(len: 8)), (fc:(freq:250);dl:(len: 8)),
|
364 |
(fc:(freq: 6);dl:(len: 8)), (fc:(freq:134);dl:(len: 8)), (fc:(freq: 70);dl:(len: 8)),
|
365 |
(fc:(freq:198);dl:(len: 8)), (fc:(freq: 38);dl:(len: 8)), (fc:(freq:166);dl:(len: 8)),
|
366 |
(fc:(freq:102);dl:(len: 8)), (fc:(freq:230);dl:(len: 8)), (fc:(freq: 22);dl:(len: 8)),
|
367 |
(fc:(freq:150);dl:(len: 8)), (fc:(freq: 86);dl:(len: 8)), (fc:(freq:214);dl:(len: 8)),
|
368 |
(fc:(freq: 54);dl:(len: 8)), (fc:(freq:182);dl:(len: 8)), (fc:(freq:118);dl:(len: 8)),
|
369 |
(fc:(freq:246);dl:(len: 8)), (fc:(freq: 14);dl:(len: 8)), (fc:(freq:142);dl:(len: 8)),
|
370 |
(fc:(freq: 78);dl:(len: 8)), (fc:(freq:206);dl:(len: 8)), (fc:(freq: 46);dl:(len: 8)),
|
371 |
(fc:(freq:174);dl:(len: 8)), (fc:(freq:110);dl:(len: 8)), (fc:(freq:238);dl:(len: 8)),
|
372 |
(fc:(freq: 30);dl:(len: 8)), (fc:(freq:158);dl:(len: 8)), (fc:(freq: 94);dl:(len: 8)),
|
373 |
(fc:(freq:222);dl:(len: 8)), (fc:(freq: 62);dl:(len: 8)), (fc:(freq:190);dl:(len: 8)),
|
374 |
(fc:(freq:126);dl:(len: 8)), (fc:(freq:254);dl:(len: 8)), (fc:(freq: 1);dl:(len: 8)),
|
375 |
(fc:(freq:129);dl:(len: 8)), (fc:(freq: 65);dl:(len: 8)), (fc:(freq:193);dl:(len: 8)),
|
376 |
(fc:(freq: 33);dl:(len: 8)), (fc:(freq:161);dl:(len: 8)), (fc:(freq: 97);dl:(len: 8)),
|
377 |
(fc:(freq:225);dl:(len: 8)), (fc:(freq: 17);dl:(len: 8)), (fc:(freq:145);dl:(len: 8)),
|
378 |
(fc:(freq: 81);dl:(len: 8)), (fc:(freq:209);dl:(len: 8)), (fc:(freq: 49);dl:(len: 8)),
|
379 |
(fc:(freq:177);dl:(len: 8)), (fc:(freq:113);dl:(len: 8)), (fc:(freq:241);dl:(len: 8)),
|
380 |
(fc:(freq: 9);dl:(len: 8)), (fc:(freq:137);dl:(len: 8)), (fc:(freq: 73);dl:(len: 8)),
|
381 |
(fc:(freq:201);dl:(len: 8)), (fc:(freq: 41);dl:(len: 8)), (fc:(freq:169);dl:(len: 8)),
|
382 |
(fc:(freq:105);dl:(len: 8)), (fc:(freq:233);dl:(len: 8)), (fc:(freq: 25);dl:(len: 8)),
|
383 |
(fc:(freq:153);dl:(len: 8)), (fc:(freq: 89);dl:(len: 8)), (fc:(freq:217);dl:(len: 8)),
|
384 |
(fc:(freq: 57);dl:(len: 8)), (fc:(freq:185);dl:(len: 8)), (fc:(freq:121);dl:(len: 8)),
|
385 |
(fc:(freq:249);dl:(len: 8)), (fc:(freq: 5);dl:(len: 8)), (fc:(freq:133);dl:(len: 8)),
|
386 |
(fc:(freq: 69);dl:(len: 8)), (fc:(freq:197);dl:(len: 8)), (fc:(freq: 37);dl:(len: 8)),
|
387 |
(fc:(freq:165);dl:(len: 8)), (fc:(freq:101);dl:(len: 8)), (fc:(freq:229);dl:(len: 8)),
|
388 |
(fc:(freq: 21);dl:(len: 8)), (fc:(freq:149);dl:(len: 8)), (fc:(freq: 85);dl:(len: 8)),
|
389 |
(fc:(freq:213);dl:(len: 8)), (fc:(freq: 53);dl:(len: 8)), (fc:(freq:181);dl:(len: 8)),
|
390 |
(fc:(freq:117);dl:(len: 8)), (fc:(freq:245);dl:(len: 8)), (fc:(freq: 13);dl:(len: 8)),
|
391 |
(fc:(freq:141);dl:(len: 8)), (fc:(freq: 77);dl:(len: 8)), (fc:(freq:205);dl:(len: 8)),
|
392 |
(fc:(freq: 45);dl:(len: 8)), (fc:(freq:173);dl:(len: 8)), (fc:(freq:109);dl:(len: 8)),
|
393 |
(fc:(freq:237);dl:(len: 8)), (fc:(freq: 29);dl:(len: 8)), (fc:(freq:157);dl:(len: 8)),
|
394 |
(fc:(freq: 93);dl:(len: 8)), (fc:(freq:221);dl:(len: 8)), (fc:(freq: 61);dl:(len: 8)),
|
395 |
(fc:(freq:189);dl:(len: 8)), (fc:(freq:125);dl:(len: 8)), (fc:(freq:253);dl:(len: 8)),
|
396 |
(fc:(freq: 19);dl:(len: 9)), (fc:(freq:275);dl:(len: 9)), (fc:(freq:147);dl:(len: 9)),
|
397 |
(fc:(freq:403);dl:(len: 9)), (fc:(freq: 83);dl:(len: 9)), (fc:(freq:339);dl:(len: 9)),
|
398 |
(fc:(freq:211);dl:(len: 9)), (fc:(freq:467);dl:(len: 9)), (fc:(freq: 51);dl:(len: 9)),
|
399 |
(fc:(freq:307);dl:(len: 9)), (fc:(freq:179);dl:(len: 9)), (fc:(freq:435);dl:(len: 9)),
|
400 |
(fc:(freq:115);dl:(len: 9)), (fc:(freq:371);dl:(len: 9)), (fc:(freq:243);dl:(len: 9)),
|
401 |
(fc:(freq:499);dl:(len: 9)), (fc:(freq: 11);dl:(len: 9)), (fc:(freq:267);dl:(len: 9)),
|
402 |
(fc:(freq:139);dl:(len: 9)), (fc:(freq:395);dl:(len: 9)), (fc:(freq: 75);dl:(len: 9)),
|
403 |
(fc:(freq:331);dl:(len: 9)), (fc:(freq:203);dl:(len: 9)), (fc:(freq:459);dl:(len: 9)),
|
404 |
(fc:(freq: 43);dl:(len: 9)), (fc:(freq:299);dl:(len: 9)), (fc:(freq:171);dl:(len: 9)),
|
405 |
(fc:(freq:427);dl:(len: 9)), (fc:(freq:107);dl:(len: 9)), (fc:(freq:363);dl:(len: 9)),
|
406 |
(fc:(freq:235);dl:(len: 9)), (fc:(freq:491);dl:(len: 9)), (fc:(freq: 27);dl:(len: 9)),
|
407 |
(fc:(freq:283);dl:(len: 9)), (fc:(freq:155);dl:(len: 9)), (fc:(freq:411);dl:(len: 9)),
|
408 |
(fc:(freq: 91);dl:(len: 9)), (fc:(freq:347);dl:(len: 9)), (fc:(freq:219);dl:(len: 9)),
|
409 |
(fc:(freq:475);dl:(len: 9)), (fc:(freq: 59);dl:(len: 9)), (fc:(freq:315);dl:(len: 9)),
|
410 |
(fc:(freq:187);dl:(len: 9)), (fc:(freq:443);dl:(len: 9)), (fc:(freq:123);dl:(len: 9)),
|
411 |
(fc:(freq:379);dl:(len: 9)), (fc:(freq:251);dl:(len: 9)), (fc:(freq:507);dl:(len: 9)),
|
412 |
(fc:(freq: 7);dl:(len: 9)), (fc:(freq:263);dl:(len: 9)), (fc:(freq:135);dl:(len: 9)),
|
413 |
(fc:(freq:391);dl:(len: 9)), (fc:(freq: 71);dl:(len: 9)), (fc:(freq:327);dl:(len: 9)),
|
414 |
(fc:(freq:199);dl:(len: 9)), (fc:(freq:455);dl:(len: 9)), (fc:(freq: 39);dl:(len: 9)),
|
415 |
(fc:(freq:295);dl:(len: 9)), (fc:(freq:167);dl:(len: 9)), (fc:(freq:423);dl:(len: 9)),
|
416 |
(fc:(freq:103);dl:(len: 9)), (fc:(freq:359);dl:(len: 9)), (fc:(freq:231);dl:(len: 9)),
|
417 |
(fc:(freq:487);dl:(len: 9)), (fc:(freq: 23);dl:(len: 9)), (fc:(freq:279);dl:(len: 9)),
|
418 |
(fc:(freq:151);dl:(len: 9)), (fc:(freq:407);dl:(len: 9)), (fc:(freq: 87);dl:(len: 9)),
|
419 |
(fc:(freq:343);dl:(len: 9)), (fc:(freq:215);dl:(len: 9)), (fc:(freq:471);dl:(len: 9)),
|
420 |
(fc:(freq: 55);dl:(len: 9)), (fc:(freq:311);dl:(len: 9)), (fc:(freq:183);dl:(len: 9)),
|
421 |
(fc:(freq:439);dl:(len: 9)), (fc:(freq:119);dl:(len: 9)), (fc:(freq:375);dl:(len: 9)),
|
422 |
(fc:(freq:247);dl:(len: 9)), (fc:(freq:503);dl:(len: 9)), (fc:(freq: 15);dl:(len: 9)),
|
423 |
(fc:(freq:271);dl:(len: 9)), (fc:(freq:143);dl:(len: 9)), (fc:(freq:399);dl:(len: 9)),
|
424 |
(fc:(freq: 79);dl:(len: 9)), (fc:(freq:335);dl:(len: 9)), (fc:(freq:207);dl:(len: 9)),
|
425 |
(fc:(freq:463);dl:(len: 9)), (fc:(freq: 47);dl:(len: 9)), (fc:(freq:303);dl:(len: 9)),
|
426 |
(fc:(freq:175);dl:(len: 9)), (fc:(freq:431);dl:(len: 9)), (fc:(freq:111);dl:(len: 9)),
|
427 |
(fc:(freq:367);dl:(len: 9)), (fc:(freq:239);dl:(len: 9)), (fc:(freq:495);dl:(len: 9)),
|
428 |
(fc:(freq: 31);dl:(len: 9)), (fc:(freq:287);dl:(len: 9)), (fc:(freq:159);dl:(len: 9)),
|
429 |
(fc:(freq:415);dl:(len: 9)), (fc:(freq: 95);dl:(len: 9)), (fc:(freq:351);dl:(len: 9)),
|
430 |
(fc:(freq:223);dl:(len: 9)), (fc:(freq:479);dl:(len: 9)), (fc:(freq: 63);dl:(len: 9)),
|
431 |
(fc:(freq:319);dl:(len: 9)), (fc:(freq:191);dl:(len: 9)), (fc:(freq:447);dl:(len: 9)),
|
432 |
(fc:(freq:127);dl:(len: 9)), (fc:(freq:383);dl:(len: 9)), (fc:(freq:255);dl:(len: 9)),
|
433 |
(fc:(freq:511);dl:(len: 9)), (fc:(freq: 0);dl:(len: 7)), (fc:(freq: 64);dl:(len: 7)),
|
434 |
(fc:(freq: 32);dl:(len: 7)), (fc:(freq: 96);dl:(len: 7)), (fc:(freq: 16);dl:(len: 7)),
|
435 |
(fc:(freq: 80);dl:(len: 7)), (fc:(freq: 48);dl:(len: 7)), (fc:(freq:112);dl:(len: 7)),
|
436 |
(fc:(freq: 8);dl:(len: 7)), (fc:(freq: 72);dl:(len: 7)), (fc:(freq: 40);dl:(len: 7)),
|
437 |
(fc:(freq:104);dl:(len: 7)), (fc:(freq: 24);dl:(len: 7)), (fc:(freq: 88);dl:(len: 7)),
|
438 |
(fc:(freq: 56);dl:(len: 7)), (fc:(freq:120);dl:(len: 7)), (fc:(freq: 4);dl:(len: 7)),
|
439 |
(fc:(freq: 68);dl:(len: 7)), (fc:(freq: 36);dl:(len: 7)), (fc:(freq:100);dl:(len: 7)),
|
440 |
(fc:(freq: 20);dl:(len: 7)), (fc:(freq: 84);dl:(len: 7)), (fc:(freq: 52);dl:(len: 7)),
|
441 |
(fc:(freq:116);dl:(len: 7)), (fc:(freq: 3);dl:(len: 8)), (fc:(freq:131);dl:(len: 8)),
|
442 |
(fc:(freq: 67);dl:(len: 8)), (fc:(freq:195);dl:(len: 8)), (fc:(freq: 35);dl:(len: 8)),
|
443 |
(fc:(freq:163);dl:(len: 8)), (fc:(freq: 99);dl:(len: 8)), (fc:(freq:227);dl:(len: 8))
|
444 |
);
|
445 |
|
446 |
|
447 |
{ The static distance tree. (Actually a trivial tree since all lens use
|
448 |
5 bits.) }
|
449 |
static_dtree : array[0..D_CODES-1] of ct_data = (
|
450 |
(fc:(freq: 0); dl:(len:5)), (fc:(freq:16); dl:(len:5)), (fc:(freq: 8); dl:(len:5)),
|
451 |
(fc:(freq:24); dl:(len:5)), (fc:(freq: 4); dl:(len:5)), (fc:(freq:20); dl:(len:5)),
|
452 |
(fc:(freq:12); dl:(len:5)), (fc:(freq:28); dl:(len:5)), (fc:(freq: 2); dl:(len:5)),
|
453 |
(fc:(freq:18); dl:(len:5)), (fc:(freq:10); dl:(len:5)), (fc:(freq:26); dl:(len:5)),
|
454 |
(fc:(freq: 6); dl:(len:5)), (fc:(freq:22); dl:(len:5)), (fc:(freq:14); dl:(len:5)),
|
455 |
(fc:(freq:30); dl:(len:5)), (fc:(freq: 1); dl:(len:5)), (fc:(freq:17); dl:(len:5)),
|
456 |
(fc:(freq: 9); dl:(len:5)), (fc:(freq:25); dl:(len:5)), (fc:(freq: 5); dl:(len:5)),
|
457 |
(fc:(freq:21); dl:(len:5)), (fc:(freq:13); dl:(len:5)), (fc:(freq:29); dl:(len:5)),
|
458 |
(fc:(freq: 3); dl:(len:5)), (fc:(freq:19); dl:(len:5)), (fc:(freq:11); dl:(len:5)),
|
459 |
(fc:(freq:27); dl:(len:5)), (fc:(freq: 7); dl:(len:5)), (fc:(freq:23); dl:(len:5))
|
460 |
);
|
461 |
|
462 |
{ Distance codes. The first 256 values correspond to the distances
|
463 |
3 .. 258, the last 256 values correspond to the top 8 bits of
|
464 |
the 15 bit distances. }
|
465 |
_dist_code : array[0..DIST_CODE_LEN-1] of uch = (
|
466 |
0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8,
|
467 |
8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10,
|
468 |
10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
|
469 |
11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
|
470 |
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13,
|
471 |
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
|
472 |
13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
|
473 |
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
|
474 |
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
|
475 |
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,
|
476 |
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
|
477 |
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
|
478 |
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17,
|
479 |
18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,
|
480 |
23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
|
481 |
24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
|
482 |
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
|
483 |
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,
|
484 |
27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
|
485 |
27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
|
486 |
28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
|
487 |
28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
|
488 |
28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
|
489 |
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
|
490 |
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
|
491 |
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
|
492 |
);
|
493 |
|
494 |
{ length code for each normalized match length (0 == MIN_MATCH) }
|
495 |
_length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of uch = (
|
496 |
0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12,
|
497 |
13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,
|
498 |
17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,
|
499 |
19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
|
500 |
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,
|
501 |
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,
|
502 |
23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
|
503 |
24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
|
504 |
25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
|
505 |
25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,
|
506 |
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
|
507 |
26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
|
508 |
27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
|
509 |
);
|
510 |
|
511 |
|
512 |
{ First normalized length for each code (0 = MIN_MATCH) }
|
513 |
base_length : array[0..LENGTH_CODES-1] of int = (
|
514 |
0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
|
515 |
64, 80, 96, 112, 128, 160, 192, 224, 0
|
516 |
);
|
517 |
|
518 |
|
519 |
{ First normalized distance for each code (0 = distance of 1) }
|
520 |
base_dist : array[0..D_CODES-1] of int = (
|
521 |
0, 1, 2, 3, 4, 6, 8, 12, 16, 24,
|
522 |
32, 48, 64, 96, 128, 192, 256, 384, 512, 768,
|
523 |
1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576
|
524 |
);
|
525 |
{$endif}
|
526 |
|
527 |
{ Output a byte on the stream.
|
528 |
IN assertion: there is enough room in pending_buf.
|
529 |
macro put_byte(s, c)
|
530 |
begin
|
531 |
s^.pending_buf^[s^.pending] := (c);
|
532 |
Inc(s^.pending);
|
533 |
end
|
534 |
}
|
535 |
|
536 |
const
|
537 |
MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);
|
538 |
{ Minimum amount of lookahead, except at the end of the input file.
|
539 |
See deflate.c for comments about the MIN_MATCH+1. }
|
540 |
|
541 |
{macro d_code(dist)
|
542 |
if (dist) < 256 then
|
543 |
:= _dist_code[dist]
|
544 |
else
|
545 |
:= _dist_code[256+((dist) shr 7)]);
|
546 |
Mapping from a distance to a distance code. dist is the distance - 1 and
|
547 |
must not have side effects. _dist_code[256] and _dist_code[257] are never
|
548 |
used. }
|
549 |
|
550 |
{$ifndef ORG_DEBUG}
|
551 |
{ Inline versions of _tr_tally for speed: }
|
552 |
|
553 |
#if defined(GEN_TREES_H) || !defined(STDC)
|
554 |
extern uch _length_code[];
|
555 |
extern uch _dist_code[];
|
556 |
#else
|
557 |
extern const uch _length_code[];
|
558 |
extern const uch _dist_code[];
|
559 |
#endif
|
560 |
|
561 |
macro _tr_tally_lit(s, c, flush)
|
562 |
var
|
563 |
cc : uch;
|
564 |
begin
|
565 |
cc := (c);
|
566 |
s^.d_buf[s^.last_lit] := 0;
|
567 |
s^.l_buf[s^.last_lit] := cc;
|
568 |
Inc(s^.last_lit);
|
569 |
Inc(s^.dyn_ltree[cc].fc.Freq);
|
570 |
flush := (s^.last_lit = s^.lit_bufsize-1);
|
571 |
end;
|
572 |
|
573 |
macro _tr_tally_dist(s, distance, length, flush) \
|
574 |
var
|
575 |
len : uch;
|
576 |
dist : ush;
|
577 |
begin
|
578 |
len := (length);
|
579 |
dist := (distance);
|
580 |
s^.d_buf[s^.last_lit] := dist;
|
581 |
s^.l_buf[s^.last_lit] = len;
|
582 |
Inc(s^.last_lit);
|
583 |
Dec(dist);
|
584 |
Inc(s^.dyn_ltree[_length_code[len]+LITERALS+1].fc.Freq);
|
585 |
Inc(s^.dyn_dtree[d_code(dist)].Freq);
|
586 |
flush := (s^.last_lit = s^.lit_bufsize-1);
|
587 |
end;
|
588 |
|
589 |
{$endif}
|
590 |
|
591 |
{ ===========================================================================
|
592 |
Constants }
|
593 |
|
594 |
const
|
595 |
MAX_BL_BITS = 7;
|
596 |
{ Bit length codes must not exceed MAX_BL_BITS bits }
|
597 |
|
598 |
const
|
599 |
END_BLOCK = 256;
|
600 |
{ end of block literal code }
|
601 |
|
602 |
const
|
603 |
REP_3_6 = 16;
|
604 |
{ repeat previous bit length 3-6 times (2 bits of repeat count) }
|
605 |
|
606 |
const
|
607 |
REPZ_3_10 = 17;
|
608 |
{ repeat a zero length 3-10 times (3 bits of repeat count) }
|
609 |
|
610 |
const
|
611 |
REPZ_11_138 = 18;
|
612 |
{ repeat a zero length 11-138 times (7 bits of repeat count) }
|
613 |
|
614 |
{local}
|
615 |
const
|
616 |
extra_lbits : array[0..LENGTH_CODES-1] of int
|
617 |
{ extra bits for each length code }
|
618 |
= (0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0);
|
619 |
|
620 |
{local}
|
621 |
const
|
622 |
extra_dbits : array[0..D_CODES-1] of int
|
623 |
{ extra bits for each distance code }
|
624 |
= (0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13);
|
625 |
|
626 |
{local}
|
627 |
const
|
628 |
extra_blbits : array[0..BL_CODES-1] of int { extra bits for each bit length code }
|
629 |
= (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7);
|
630 |
|
631 |
{local}
|
632 |
const
|
633 |
bl_order : array[0..BL_CODES-1] of uch
|
634 |
= (16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15);
|
635 |
{ The lengths of the bit length codes are sent in order of decreasing
|
636 |
probability, to avoid transmitting the lengths for unused bit length codes.
|
637 |
}
|
638 |
|
639 |
const
|
640 |
Buf_size = (8 * 2*sizeof(char));
|
641 |
{ Number of bits used within bi_buf. (bi_buf might be implemented on
|
642 |
more than 16 bits on some systems.) }
|
643 |
|
644 |
{ ===========================================================================
|
645 |
Local data. These are initialized only once. }
|
646 |
|
647 |
|
648 |
{$ifdef GEN_TREES_H)}
|
649 |
{ non ANSI compilers may not accept trees.h }
|
650 |
|
651 |
const
|
652 |
DIST_CODE_LEN = 512; { see definition of array dist_code below }
|
653 |
|
654 |
{local}
|
655 |
var
|
656 |
static_ltree : array[0..L_CODES+2-1] of ct_data;
|
657 |
{ The static literal tree. Since the bit lengths are imposed, there is no
|
658 |
need for the L_CODES extra codes used during heap construction. However
|
659 |
The codes 286 and 287 are needed to build a canonical tree (see _tr_init
|
660 |
below). }
|
661 |
|
662 |
{local}
|
663 |
static_dtree : array[0..D_CODES-1] of ct_data;
|
664 |
{ The static distance tree. (Actually a trivial tree since all codes use
|
665 |
5 bits.) }
|
666 |
|
667 |
_dist_code : array[0..DIST_CODE_LEN-1] of uch;
|
668 |
{ Distance codes. The first 256 values correspond to the distances
|
669 |
3 .. 258, the last 256 values correspond to the top 8 bits of
|
670 |
the 15 bit distances. }
|
671 |
|
672 |
_length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of uch;
|
673 |
{ length code for each normalized match length (0 == MIN_MATCH) }
|
674 |
|
675 |
{local}
|
676 |
base_length : array[0..LENGTH_CODES-1] of int;
|
677 |
{ First normalized length for each code (0 = MIN_MATCH) }
|
678 |
|
679 |
{local}
|
680 |
base_dist : array[0..D_CODES-1] of int;
|
681 |
{ First normalized distance for each code (0 = distance of 1) }
|
682 |
|
683 |
{$endif} { GEN_TREES_H }
|
684 |
|
685 |
{local}
|
686 |
const
|
687 |
static_l_desc : static_tree_desc =
|
688 |
(static_tree: {tree_ptr}(@(static_ltree)); { pointer to array of ct_data }
|
689 |
extra_bits: {pzIntfArray}(@(extra_lbits)); { pointer to array of int }
|
690 |
extra_base: LITERALS+1;
|
691 |
elems: L_CODES;
|
692 |
max_length: MAX_BITS);
|
693 |
|
694 |
{local}
|
695 |
const
|
696 |
static_d_desc : static_tree_desc =
|
697 |
(static_tree: {tree_ptr}(@(static_dtree));
|
698 |
extra_bits: {pzIntfArray}(@(extra_dbits));
|
699 |
extra_base : 0;
|
700 |
elems: D_CODES;
|
701 |
max_length: MAX_BITS);
|
702 |
|
703 |
{local}
|
704 |
const
|
705 |
static_bl_desc : static_tree_desc =
|
706 |
(static_tree: {tree_ptr}(NIL);
|
707 |
extra_bits: {pzIntfArray}@(extra_blbits);
|
708 |
extra_base : 0;
|
709 |
elems: BL_CODES;
|
710 |
max_length: MAX_BL_BITS);
|
711 |
|
712 |
(* ===========================================================================
|
713 |
Local (static) routines in this file. }
|
714 |
|
715 |
procedure tr_static_init;
|
716 |
procedure init_block(var deflate_state);
|
717 |
procedure pqdownheap(var s : deflate_state;
|
718 |
var tree : ct_data;
|
719 |
k : int);
|
720 |
procedure gen_bitlen(var s : deflate_state;
|
721 |
var desc : tree_desc);
|
722 |
procedure gen_codes(var tree : ct_data;
|
723 |
max_code : int;
|
724 |
bl_count : pushf);
|
725 |
procedure build_tree(var s : deflate_state;
|
726 |
var desc : tree_desc);
|
727 |
procedure scan_tree(var s : deflate_state;
|
728 |
var tree : ct_data;
|
729 |
max_code : int);
|
730 |
procedure send_tree(var s : deflate_state;
|
731 |
var tree : ct_data;
|
732 |
max_code : int);
|
733 |
function build_bl_tree(var deflate_state) : int;
|
734 |
procedure send_all_trees(var deflate_state;
|
735 |
lcodes : int;
|
736 |
dcodes : int;
|
737 |
blcodes : int);
|
738 |
procedure compress_block(var s : deflate_state;
|
739 |
var ltree : ct_data;
|
740 |
var dtree : ct_data);
|
741 |
procedure set_data_type(var s : deflate_state);
|
742 |
function bi_reverse(value : unsigned;
|
743 |
length : int) : unsigned;
|
744 |
procedure bi_windup(var deflate_state);
|
745 |
procedure bi_flush(var deflate_state);
|
746 |
procedure copy_block(var deflate_state;
|
747 |
buf : pcharf;
|
748 |
len : unsigned;
|
749 |
header : int);
|
750 |
*)
|
751 |
|
752 |
{$ifdef GEN_TREES_H}
|
753 |
{local}
|
754 |
procedure gen_trees_header;
|
755 |
{$endif}
|
756 |
|
757 |
(*
|
758 |
{ ===========================================================================
|
759 |
Output a short LSB first on the stream.
|
760 |
IN assertion: there is enough room in pendingBuf. }
|
761 |
|
762 |
macro put_short(s, w)
|
763 |
begin
|
764 |
{put_byte(s, (uch)((w) & 0xff));}
|
765 |
s.pending_buf^[s.pending] := uch((w) and $ff);
|
766 |
Inc(s.pending);
|
767 |
|
768 |
{put_byte(s, (uch)((ush)(w) >> 8));}
|
769 |
s.pending_buf^[s.pending] := uch(ush(w) shr 8);;
|
770 |
Inc(s.pending);
|
771 |
end
|
772 |
*)
|
773 |
|
774 |
{ ===========================================================================
|
775 |
Send a value on a given number of bits.
|
776 |
IN assertion: length <= 16 and value fits in length bits. }
|
777 |
|
778 |
{$ifdef ORG_DEBUG}
|
779 |
|
780 |
{local}
|
781 |
procedure send_bits(var s : deflate_state;
|
782 |
value : int; { value to send }
|
783 |
length : int); { number of bits }
|
784 |
begin
|
785 |
{$ifdef DEBUG}
|
786 |
Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value));
|
787 |
Assert((length > 0) and (length <= 15), 'invalid length');
|
788 |
Inc(s.bits_sent, ulg(length));
|
789 |
{$ENDIF}
|
790 |
|
791 |
{ If not enough room in bi_buf, use (valid) bits from bi_buf and
|
792 |
(16 - bi_valid) bits from value, leaving (width - (16-bi_valid))
|
793 |
unused bits in value. }
|
794 |
{$IFOPT Q+} {$Q-} {$DEFINE NoOverflowCheck} {$ENDIF}
|
795 |
{$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}
|
796 |
if (s.bi_valid > int(Buf_size) - length) then
|
797 |
begin
|
798 |
s.bi_buf := s.bi_buf or int(value shl s.bi_valid);
|
799 |
{put_short(s, s.bi_buf);}
|
800 |
s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);
|
801 |
Inc(s.pending);
|
802 |
s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;
|
803 |
Inc(s.pending);
|
804 |
|
805 |
s.bi_buf := ush(value) shr (Buf_size - s.bi_valid);
|
806 |
Inc(s.bi_valid, length - Buf_size);
|
807 |
end
|
808 |
else
|
809 |
begin
|
810 |
s.bi_buf := s.bi_buf or int(value shl s.bi_valid);
|
811 |
Inc(s.bi_valid, length);
|
812 |
end;
|
813 |
{$IFDEF NoOverflowCheck} {$Q+} {$UNDEF NoOverflowCheck} {$ENDIF}
|
814 |
{$IFDEF NoRangeCheck} {$Q+} {$UNDEF NoRangeCheck} {$ENDIF}
|
815 |
end;
|
816 |
|
817 |
{$else} { !DEBUG }
|
818 |
|
819 |
|
820 |
macro send_code(s, c, tree)
|
821 |
begin
|
822 |
send_bits(s, tree[c].Code, tree[c].Len);
|
823 |
{ Send a code of the given tree. c and tree must not have side effects }
|
824 |
end
|
825 |
|
826 |
macro send_bits(s, value, length) \
|
827 |
begin int len := length;\
|
828 |
if (s^.bi_valid > (int)Buf_size - len) begin\
|
829 |
int val := value;\
|
830 |
s^.bi_buf |= (val << s^.bi_valid);\
|
831 |
{put_short(s, s.bi_buf);}
|
832 |
s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);
|
833 |
Inc(s.pending);
|
834 |
s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;
|
835 |
Inc(s.pending);
|
836 |
|
837 |
s^.bi_buf := (ush)val >> (Buf_size - s^.bi_valid);\
|
838 |
s^.bi_valid += len - Buf_size;\
|
839 |
end else begin\
|
840 |
s^.bi_buf |= (value) << s^.bi_valid;\
|
841 |
s^.bi_valid += len;\
|
842 |
end\
|
843 |
end;
|
844 |
{$endif} { DEBUG }
|
845 |
|
846 |
{ ===========================================================================
|
847 |
Reverse the first len bits of a code, using straightforward code (a faster
|
848 |
method would use a table)
|
849 |
IN assertion: 1 <= len <= 15 }
|
850 |
|
851 |
{local}
|
852 |
function bi_reverse(code : unsigned; { the value to invert }
|
853 |
len : int) : unsigned; { its bit length }
|
854 |
|
855 |
var
|
856 |
res : unsigned; {register}
|
857 |
begin
|
858 |
res := 0;
|
859 |
repeat
|
860 |
res := res or (code and 1);
|
861 |
code := code shr 1;
|
862 |
res := res shl 1;
|
863 |
Dec(len);
|
864 |
until (len <= 0);
|
865 |
bi_reverse := res shr 1;
|
866 |
end;
|
867 |
|
868 |
{ ===========================================================================
|
869 |
Generate the codes for a given tree and bit counts (which need not be
|
870 |
optimal).
|
871 |
IN assertion: the array bl_count contains the bit length statistics for
|
872 |
the given tree and the field len is set for all tree elements.
|
873 |
OUT assertion: the field code is set for all tree elements of non
|
874 |
zero code length. }
|
875 |
|
876 |
{local}
|
877 |
procedure gen_codes(tree : tree_ptr; { the tree to decorate }
|
878 |
max_code : int; { largest code with non zero frequency }
|
879 |
var bl_count : array of ushf); { number of codes at each bit length }
|
880 |
|
881 |
var
|
882 |
next_code : array[0..MAX_BITS+1-1] of ush; { next code value for each bit length }
|
883 |
code : ush; { running code value }
|
884 |
bits : int; { bit index }
|
885 |
n : int; { code index }
|
886 |
var
|
887 |
len : int;
|
888 |
begin
|
889 |
code := 0;
|
890 |
|
891 |
{ The distribution counts are first used to generate the code values
|
892 |
without bit reversal. }
|
893 |
|
894 |
for bits := 1 to MAX_BITS do
|
895 |
begin
|
896 |
code := ((code + bl_count[bits-1]) shl 1);
|
897 |
next_code[bits] := code;
|
898 |
end;
|
899 |
{ Check that the bit counts in bl_count are consistent. The last code
|
900 |
must be all ones. }
|
901 |
|
902 |
{$IFDEF DEBUG}
|
903 |
Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1,
|
904 |
'inconsistent bit counts');
|
905 |
Tracev(#13'gen_codes: max_code '+IntToStr(max_code));
|
906 |
{$ENDIF}
|
907 |
|
908 |
for n := 0 to max_code do
|
909 |
begin
|
910 |
len := tree^[n].dl.Len;
|
911 |
if (len = 0) then
|
912 |
continue;
|
913 |
{ Now reverse the bits }
|
914 |
tree^[n].fc.Code := bi_reverse(next_code[len], len);
|
915 |
Inc(next_code[len]);
|
916 |
{$ifdef DEBUG}
|
917 |
if (n>31) and (n<128) then
|
918 |
Tracecv(tree <> tree_ptr(@static_ltree),
|
919 |
(^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
|
920 |
IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))
|
921 |
else
|
922 |
Tracecv(tree <> tree_ptr(@static_ltree),
|
923 |
(^M'n #'+IntToStr(n)+' l '+IntToStr(len)+' c '+
|
924 |
IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'));
|
925 |
{$ENDIF}
|
926 |
end;
|
927 |
end;
|
928 |
|
929 |
{ ===========================================================================
|
930 |
Genererate the file trees.h describing the static trees. }
|
931 |
{$ifdef GEN_TREES_H}
|
932 |
|
933 |
macro SEPARATOR(i, last, width)
|
934 |
if (i) = (last) then
|
935 |
( ^M');'^M^M
|
936 |
else \
|
937 |
if (i) mod (width) = (width)-1 then
|
938 |
','^M
|
939 |
else
|
940 |
', '
|
941 |
|
942 |
procedure gen_trees_header;
|
943 |
var
|
944 |
header : system.text;
|
945 |
i : int;
|
946 |
begin
|
947 |
system.assign(header, 'trees.inc');
|
948 |
{$I-}
|
949 |
ReWrite(header);
|
950 |
{$I+}
|
951 |
Assert (IOresult <> 0, 'Can''t open trees.h');
|
952 |
WriteLn(header,
|
953 |
'{ header created automatically with -DGEN_TREES_H }'^M);
|
954 |
|
955 |
WriteLn(header, 'local const ct_data static_ltree[L_CODES+2] := (');
|
956 |
for i := 0 to L_CODES+2-1 do
|
957 |
begin
|
958 |
WriteLn(header, '((%3u),(%3u))%s', static_ltree[i].Code,
|
959 |
static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
|
960 |
end;
|
961 |
|
962 |
WriteLn(header, 'local const ct_data static_dtree[D_CODES] := (');
|
963 |
for i := 0 to D_CODES-1 do
|
964 |
begin
|
965 |
WriteLn(header, '((%2u),(%2u))%s', static_dtree[i].Code,
|
966 |
static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
|
967 |
end;
|
968 |
|
969 |
WriteLn(header, 'const uch _dist_code[DIST_CODE_LEN] := (');
|
970 |
for i := 0 to DIST_CODE_LEN-1 do
|
971 |
begin
|
972 |
WriteLn(header, '%2u%s', _dist_code[i],
|
973 |
SEPARATOR(i, DIST_CODE_LEN-1, 20));
|
974 |
end;
|
975 |
|
976 |
WriteLn(header, 'const uch _length_code[MAX_MATCH-MIN_MATCH+1]= (');
|
977 |
for i := 0 to MAX_MATCH-MIN_MATCH+1-1 do
|
978 |
begin
|
979 |
WriteLn(header, '%2u%s', _length_code[i],
|
980 |
SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
|
981 |
end;
|
982 |
|
983 |
WriteLn(header, 'local const int base_length[LENGTH_CODES] := (');
|
984 |
for i := 0 to LENGTH_CODES-1 do
|
985 |
begin
|
986 |
WriteLn(header, '%1u%s', base_length[i],
|
987 |
SEPARATOR(i, LENGTH_CODES-1, 20));
|
988 |
end;
|
989 |
|
990 |
WriteLn(header, 'local const int base_dist[D_CODES] := (');
|
991 |
for i := 0 to D_CODES-1 do
|
992 |
begin
|
993 |
WriteLn(header, '%5u%s', base_dist[i],
|
994 |
SEPARATOR(i, D_CODES-1, 10));
|
995 |
end;
|
996 |
|
997 |
close(header);
|
998 |
end;
|
999 |
{$endif} { GEN_TREES_H }
|
1000 |
|
1001 |
|
1002 |
{ ===========================================================================
|
1003 |
Initialize the various 'constant' tables. }
|
1004 |
|
1005 |
{local}
|
1006 |
procedure tr_static_init;
|
1007 |
|
1008 |
{$ifdef GEN_TREES_H}
|
1009 |
const
|
1010 |
static_init_done : boolean = FALSE;
|
1011 |
var
|
1012 |
n : int; { iterates over tree elements }
|
1013 |
bits : int; { bit counter }
|
1014 |
length : int; { length value }
|
1015 |
code : int; { code value }
|
1016 |
dist : int; { distance index }
|
1017 |
bl_count : array[0..MAX_BITS+1-1] of ush;
|
1018 |
{ number of codes at each bit length for an optimal tree }
|
1019 |
begin
|
1020 |
if (static_init_done) then
|
1021 |
exit;
|
1022 |
|
1023 |
{ Initialize the mapping length (0..255) -> length code (0..28) }
|
1024 |
length := 0;
|
1025 |
for code := 0 to LENGTH_CODES-1-1 do
|
1026 |
begin
|
1027 |
base_length[code] := length;
|
1028 |
for n := 0 to (1 shl extra_lbits[code])-1 do
|
1029 |
begin
|
1030 |
_length_code[length] := uch(code);
|
1031 |
Inc(length);
|
1032 |
end;
|
1033 |
end;
|
1034 |
Assert (length = 256, 'tr_static_init: length <> 256');
|
1035 |
{ Note that the length 255 (match length 258) can be represented
|
1036 |
in two different ways: code 284 + 5 bits or code 285, so we
|
1037 |
overwrite length_code[255] to use the best encoding: }
|
1038 |
|
1039 |
_length_code[length-1] := uch(code);
|
1040 |
|
1041 |
{ Initialize the mapping dist (0..32K) -> dist code (0..29) }
|
1042 |
dist := 0;
|
1043 |
for code := 0 to 16-1 do
|
1044 |
begin
|
1045 |
base_dist[code] := dist;
|
1046 |
for n := 0 to (1 shl extra_dbits[code])-1 do
|
1047 |
begin
|
1048 |
_dist_code[dist] := uch(code);
|
1049 |
Inc(dist);
|
1050 |
end;
|
1051 |
end;
|
1052 |
Assert (dist = 256, 'tr_static_init: dist <> 256');
|
1053 |
dist := dist shr 7; { from now on, all distances are divided by 128 }
|
1054 |
for code := 16 to D_CODES-1 do
|
1055 |
begin
|
1056 |
base_dist[code] := dist shl 7;
|
1057 |
for n := 0 to (1 shl (extra_dbits[code]-7))-1 do
|
1058 |
begin
|
1059 |
_dist_code[256 + dist] := uch(code);
|
1060 |
Inc(dist);
|
1061 |
end;
|
1062 |
end;
|
1063 |
Assert (dist = 256, 'tr_static_init: 256+dist <> 512');
|
1064 |
|
1065 |
{ Construct the codes of the static literal tree }
|
1066 |
for bits := 0 to MAX_BITS do
|
1067 |
bl_count[bits] := 0;
|
1068 |
n := 0;
|
1069 |
while (n <= 143) do
|
1070 |
begin
|
1071 |
static_ltree[n].dl.Len := 8;
|
1072 |
Inc(n);
|
1073 |
Inc(bl_count[8]);
|
1074 |
end;
|
1075 |
while (n <= 255) do
|
1076 |
begin
|
1077 |
static_ltree[n].dl.Len := 9;
|
1078 |
Inc(n);
|
1079 |
Inc(bl_count[9]);
|
1080 |
end;
|
1081 |
while (n <= 279) do
|
1082 |
begin
|
1083 |
static_ltree[n].dl.Len := 7;
|
1084 |
Inc(n);
|
1085 |
Inc(bl_count[7]);
|
1086 |
end;
|
1087 |
while (n <= 287) do
|
1088 |
begin
|
1089 |
static_ltree[n].dl.Len := 8;
|
1090 |
Inc(n);
|
1091 |
Inc(bl_count[8]);
|
1092 |
end;
|
1093 |
|
1094 |
{ Codes 286 and 287 do not exist, but we must include them in the
|
1095 |
tree construction to get a canonical Huffman tree (longest code
|
1096 |
all ones) }
|
1097 |
|
1098 |
gen_codes(tree_ptr(@static_ltree), L_CODES+1, bl_count);
|
1099 |
|
1100 |
{ The static distance tree is trivial: }
|
1101 |
for n := 0 to D_CODES-1 do
|
1102 |
begin
|
1103 |
static_dtree[n].dl.Len := 5;
|
1104 |
static_dtree[n].fc.Code := bi_reverse(unsigned(n), 5);
|
1105 |
end;
|
1106 |
static_init_done := TRUE;
|
1107 |
|
1108 |
gen_trees_header; { save to include file }
|
1109 |
{$else}
|
1110 |
begin
|
1111 |
{$endif} { GEN_TREES_H) }
|
1112 |
end;
|
1113 |
|
1114 |
{ ===========================================================================
|
1115 |
Initialize a new block. }
|
1116 |
{local}
|
1117 |
|
1118 |
procedure init_block(var s : deflate_state);
|
1119 |
var
|
1120 |
n : int; { iterates over tree elements }
|
1121 |
begin
|
1122 |
{ Initialize the trees. }
|
1123 |
for n := 0 to L_CODES-1 do
|
1124 |
s.dyn_ltree[n].fc.Freq := 0;
|
1125 |
for n := 0 to D_CODES-1 do
|
1126 |
s.dyn_dtree[n].fc.Freq := 0;
|
1127 |
for n := 0 to BL_CODES-1 do
|
1128 |
s.bl_tree[n].fc.Freq := 0;
|
1129 |
|
1130 |
s.dyn_ltree[END_BLOCK].fc.Freq := 1;
|
1131 |
s.static_len := Long(0);
|
1132 |
s.opt_len := Long(0);
|
1133 |
s.matches := 0;
|
1134 |
s.last_lit := 0;
|
1135 |
end;
|
1136 |
|
1137 |
const
|
1138 |
SMALLEST = 1;
|
1139 |
{ Index within the heap array of least frequent node in the Huffman tree }
|
1140 |
|
1141 |
{ ===========================================================================
|
1142 |
Initialize the tree data structures for a new zlib stream. }
|
1143 |
procedure _tr_init(var s : deflate_state);
|
1144 |
begin
|
1145 |
tr_static_init;
|
1146 |
|
1147 |
s.compressed_len := Long(0);
|
1148 |
|
1149 |
s.l_desc.dyn_tree := tree_ptr(@s.dyn_ltree);
|
1150 |
s.l_desc.stat_desc := @static_l_desc;
|
1151 |
|
1152 |
s.d_desc.dyn_tree := tree_ptr(@s.dyn_dtree);
|
1153 |
s.d_desc.stat_desc := @static_d_desc;
|
1154 |
|
1155 |
s.bl_desc.dyn_tree := tree_ptr(@s.bl_tree);
|
1156 |
s.bl_desc.stat_desc := @static_bl_desc;
|
1157 |
|
1158 |
s.bi_buf := 0;
|
1159 |
s.bi_valid := 0;
|
1160 |
s.last_eob_len := 8; { enough lookahead for inflate }
|
1161 |
{$ifdef DEBUG}
|
1162 |
s.bits_sent := Long(0);
|
1163 |
{$endif}
|
1164 |
|
1165 |
{ Initialize the first block of the first file: }
|
1166 |
init_block(s);
|
1167 |
end;
|
1168 |
|
1169 |
{ ===========================================================================
|
1170 |
Remove the smallest element from the heap and recreate the heap with
|
1171 |
one less element. Updates heap and heap_len.
|
1172 |
|
1173 |
macro pqremove(s, tree, top)
|
1174 |
begin
|
1175 |
top := s.heap[SMALLEST];
|
1176 |
s.heap[SMALLEST] := s.heap[s.heap_len];
|
1177 |
Dec(s.heap_len);
|
1178 |
pqdownheap(s, tree, SMALLEST);
|
1179 |
end
|
1180 |
}
|
1181 |
|
1182 |
{ ===========================================================================
|
1183 |
Compares to subtrees, using the tree depth as tie breaker when
|
1184 |
the subtrees have equal frequency. This minimizes the worst case length.
|
1185 |
|
1186 |
macro smaller(tree, n, m, depth)
|
1187 |
( (tree[n].Freq < tree[m].Freq) or
|
1188 |
((tree[n].Freq = tree[m].Freq) and (depth[n] <= depth[m])) )
|
1189 |
}
|
1190 |
|
1191 |
{ ===========================================================================
|
1192 |
Restore the heap property by moving down the tree starting at node k,
|
1193 |
exchanging a node with the smallest of its two sons if necessary, stopping
|
1194 |
when the heap property is re-established (each father smaller than its
|
1195 |
two sons). }
|
1196 |
{local}
|
1197 |
|
1198 |
procedure pqdownheap(var s : deflate_state;
|
1199 |
var tree : tree_type; { the tree to restore }
|
1200 |
k : int); { node to move down }
|
1201 |
var
|
1202 |
v : int;
|
1203 |
j : int;
|
1204 |
begin
|
1205 |
v := s.heap[k];
|
1206 |
j := k shl 1; { left son of k }
|
1207 |
while (j <= s.heap_len) do
|
1208 |
begin
|
1209 |
{ Set j to the smallest of the two sons: }
|
1210 |
if (j < s.heap_len) and
|
1211 |
{smaller(tree, s.heap[j+1], s.heap[j], s.depth)}
|
1212 |
( (tree[s.heap[j+1]].fc.Freq < tree[s.heap[j]].fc.Freq) or
|
1213 |
((tree[s.heap[j+1]].fc.Freq = tree[s.heap[j]].fc.Freq) and
|
1214 |
(s.depth[s.heap[j+1]] <= s.depth[s.heap[j]])) ) then
|
1215 |
begin
|
1216 |
Inc(j);
|
1217 |
end;
|
1218 |
{ Exit if v is smaller than both sons }
|
1219 |
if {(smaller(tree, v, s.heap[j], s.depth))}
|
1220 |
( (tree[v].fc.Freq < tree[s.heap[j]].fc.Freq) or
|
1221 |
((tree[v].fc.Freq = tree[s.heap[j]].fc.Freq) and
|
1222 |
(s.depth[v] <= s.depth[s.heap[j]])) ) then
|
1223 |
break;
|
1224 |
{ Exchange v with the smallest son }
|
1225 |
s.heap[k] := s.heap[j];
|
1226 |
k := j;
|
1227 |
|
1228 |
{ And continue down the tree, setting j to the left son of k }
|
1229 |
j := j shl 1;
|
1230 |
end;
|
1231 |
s.heap[k] := v;
|
1232 |
end;
|
1233 |
|
1234 |
{ ===========================================================================
|
1235 |
Compute the optimal bit lengths for a tree and update the total bit length
|
1236 |
for the current block.
|
1237 |
IN assertion: the fields freq and dad are set, heap[heap_max] and
|
1238 |
above are the tree nodes sorted by increasing frequency.
|
1239 |
OUT assertions: the field len is set to the optimal bit length, the
|
1240 |
array bl_count contains the frequencies for each bit length.
|
1241 |
The length opt_len is updated; static_len is also updated if stree is
|
1242 |
not null. }
|
1243 |
|
1244 |
{local}
|
1245 |
procedure gen_bitlen(var s : deflate_state;
|
1246 |
var desc : tree_desc); { the tree descriptor }
|
1247 |
var
|
1248 |
tree : tree_ptr;
|
1249 |
max_code : int;
|
1250 |
stree : tree_ptr; {const}
|
1251 |
extra : pzIntfArray; {const}
|
1252 |
base : int;
|
1253 |
max_length : int;
|
1254 |
h : int; { heap index }
|
1255 |
n, m : int; { iterate over the tree elements }
|
1256 |
bits : int; { bit length }
|
1257 |
xbits : int; { extra bits }
|
1258 |
f : ush; { frequency }
|
1259 |
overflow : int; { number of elements with bit length too large }
|
1260 |
begin
|
1261 |
tree := desc.dyn_tree;
|
1262 |
max_code := desc.max_code;
|
1263 |
stree := desc.stat_desc^.static_tree;
|
1264 |
extra := desc.stat_desc^.extra_bits;
|
1265 |
base := desc.stat_desc^.extra_base;
|
1266 |
max_length := desc.stat_desc^.max_length;
|
1267 |
overflow := 0;
|
1268 |
|
1269 |
for bits := 0 to MAX_BITS do
|
1270 |
s.bl_count[bits] := 0;
|
1271 |
|
1272 |
{ In a first pass, compute the optimal bit lengths (which may
|
1273 |
overflow in the case of the bit length tree). }
|
1274 |
|
1275 |
tree^[s.heap[s.heap_max]].dl.Len := 0; { root of the heap }
|
1276 |
|
1277 |
for h := s.heap_max+1 to HEAP_SIZE-1 do
|
1278 |
begin
|
1279 |
n := s.heap[h];
|
1280 |
bits := tree^[tree^[n].dl.Dad].dl.Len + 1;
|
1281 |
if (bits > max_length) then
|
1282 |
begin
|
1283 |
bits := max_length;
|
1284 |
Inc(overflow);
|
1285 |
end;
|
1286 |
tree^[n].dl.Len := ush(bits);
|
1287 |
{ We overwrite tree[n].dl.Dad which is no longer needed }
|
1288 |
|
1289 |
if (n > max_code) then
|
1290 |
continue; { not a leaf node }
|
1291 |
|
1292 |
Inc(s.bl_count[bits]);
|
1293 |
xbits := 0;
|
1294 |
if (n >= base) then
|
1295 |
xbits := extra^[n-base];
|
1296 |
f := tree^[n].fc.Freq;
|
1297 |
Inc(s.opt_len, ulg(f) * (bits + xbits));
|
1298 |
if (stree <> NIL) then
|
1299 |
Inc(s.static_len, ulg(f) * (stree^[n].dl.Len + xbits));
|
1300 |
end;
|
1301 |
if (overflow = 0) then
|
1302 |
exit;
|
1303 |
{$ifdef DEBUG}
|
1304 |
Tracev(^M'bit length overflow');
|
1305 |
{$endif}
|
1306 |
{ This happens for example on obj2 and pic of the Calgary corpus }
|
1307 |
|
1308 |
{ Find the first bit length which could increase: }
|
1309 |
repeat
|
1310 |
bits := max_length-1;
|
1311 |
while (s.bl_count[bits] = 0) do
|
1312 |
Dec(bits);
|
1313 |
Dec(s.bl_count[bits]); { move one leaf down the tree }
|
1314 |
Inc(s.bl_count[bits+1], 2); { move one overflow item as its brother }
|
1315 |
Dec(s.bl_count[max_length]);
|
1316 |
{ The brother of the overflow item also moves one step up,
|
1317 |
but this does not affect bl_count[max_length] }
|
1318 |
|
1319 |
Dec(overflow, 2);
|
1320 |
until (overflow <= 0);
|
1321 |
|
1322 |
{ Now recompute all bit lengths, scanning in increasing frequency.
|
1323 |
h is still equal to HEAP_SIZE. (It is simpler to reconstruct all
|
1324 |
lengths instead of fixing only the wrong ones. This idea is taken
|
1325 |
from 'ar' written by Haruhiko Okumura.) }
|
1326 |
h := HEAP_SIZE; { Delphi3: compiler warning w/o this }
|
1327 |
for bits := max_length downto 1 do
|
1328 |
begin
|
1329 |
n := s.bl_count[bits];
|
1330 |
while (n <> 0) do
|
1331 |
begin
|
1332 |
Dec(h);
|
1333 |
m := s.heap[h];
|
1334 |
if (m > max_code) then
|
1335 |
continue;
|
1336 |
if (tree^[m].dl.Len <> unsigned(bits)) then
|
1337 |
begin
|
1338 |
{$ifdef DEBUG}
|
1339 |
Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)
|
1340 |
+'.'+IntToStr(bits));
|
1341 |
{$ENDIF}
|
1342 |
Inc(s.opt_len, (long(bits) - long(tree^[m].dl.Len))
|
1343 |
* long(tree^[m].fc.Freq) );
|
1344 |
tree^[m].dl.Len := ush(bits);
|
1345 |
end;
|
1346 |
Dec(n);
|
1347 |
end;
|
1348 |
end;
|
1349 |
end;
|
1350 |
|
1351 |
{ ===========================================================================
|
1352 |
Construct one Huffman tree and assigns the code bit strings and lengths.
|
1353 |
Update the total bit length for the current block.
|
1354 |
IN assertion: the field freq is set for all tree elements.
|
1355 |
OUT assertions: the fields len and code are set to the optimal bit length
|
1356 |
and corresponding code. The length opt_len is updated; static_len is
|
1357 |
also updated if stree is not null. The field max_code is set. }
|
1358 |
|
1359 |
{local}
|
1360 |
procedure build_tree(var s : deflate_state;
|
1361 |
var desc : tree_desc); { the tree descriptor }
|
1362 |
|
1363 |
var
|
1364 |
tree : tree_ptr;
|
1365 |
stree : tree_ptr; {const}
|
1366 |
elems : int;
|
1367 |
n, m : int; { iterate over heap elements }
|
1368 |
max_code : int; { largest code with non zero frequency }
|
1369 |
node : int; { new node being created }
|
1370 |
begin
|
1371 |
tree := desc.dyn_tree;
|
1372 |
stree := desc.stat_desc^.static_tree;
|
1373 |
elems := desc.stat_desc^.elems;
|
1374 |
max_code := -1;
|
1375 |
|
1376 |
{ Construct the initial heap, with least frequent element in
|
1377 |
heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1].
|
1378 |
heap[0] is not used. }
|
1379 |
s.heap_len := 0;
|
1380 |
s.heap_max := HEAP_SIZE;
|
1381 |
|
1382 |
for n := 0 to elems-1 do
|
1383 |
begin
|
1384 |
if (tree^[n].fc.Freq <> 0) then
|
1385 |
begin
|
1386 |
max_code := n;
|
1387 |
Inc(s.heap_len);
|
1388 |
s.heap[s.heap_len] := n;
|
1389 |
s.depth[n] := 0;
|
1390 |
end
|
1391 |
else
|
1392 |
begin
|
1393 |
tree^[n].dl.Len := 0;
|
1394 |
end;
|
1395 |
end;
|
1396 |
|
1397 |
{ The pkzip format requires that at least one distance code exists,
|
1398 |
and that at least one bit should be sent even if there is only one
|
1399 |
possible code. So to avoid special checks later on we force at least
|
1400 |
two codes of non zero frequency. }
|
1401 |
|
1402 |
while (s.heap_len < 2) do
|
1403 |
begin
|
1404 |
Inc(s.heap_len);
|
1405 |
if (max_code < 2) then
|
1406 |
begin
|
1407 |
Inc(max_code);
|
1408 |
s.heap[s.heap_len] := max_code;
|
1409 |
node := max_code;
|
1410 |
end
|
1411 |
else
|
1412 |
begin
|
1413 |
s.heap[s.heap_len] := 0;
|
1414 |
node := 0;
|
1415 |
end;
|
1416 |
tree^[node].fc.Freq := 1;
|
1417 |
s.depth[node] := 0;
|
1418 |
Dec(s.opt_len);
|
1419 |
if (stree <> NIL) then
|
1420 |
Dec(s.static_len, stree^[node].dl.Len);
|
1421 |
{ node is 0 or 1 so it does not have extra bits }
|
1422 |
end;
|
1423 |
desc.max_code := max_code;
|
1424 |
|
1425 |
{ The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,
|
1426 |
establish sub-heaps of increasing lengths: }
|
1427 |
|
1428 |
for n := s.heap_len div 2 downto 1 do
|
1429 |
pqdownheap(s, tree^, n);
|
1430 |
|
1431 |
{ Construct the Huffman tree by repeatedly combining the least two
|
1432 |
frequent nodes. }
|
1433 |
|
1434 |
node := elems; { next internal node of the tree }
|
1435 |
repeat
|
1436 |
{pqremove(s, tree, n);} { n := node of least frequency }
|
1437 |
n := s.heap[SMALLEST];
|
1438 |
s.heap[SMALLEST] := s.heap[s.heap_len];
|
1439 |
Dec(s.heap_len);
|
1440 |
pqdownheap(s, tree^, SMALLEST);
|
1441 |
|
1442 |
m := s.heap[SMALLEST]; { m := node of next least frequency }
|
1443 |
|
1444 |
Dec(s.heap_max);
|
1445 |
s.heap[s.heap_max] := n; { keep the nodes sorted by frequency }
|
1446 |
Dec(s.heap_max);
|
1447 |
s.heap[s.heap_max] := m;
|
1448 |
|
1449 |
{ Create a new node father of n and m }
|
1450 |
tree^[node].fc.Freq := tree^[n].fc.Freq + tree^[m].fc.Freq;
|
1451 |
{ maximum }
|
1452 |
if (s.depth[n] >= s.depth[m]) then
|
1453 |
s.depth[node] := uch (s.depth[n] + 1)
|
1454 |
else
|
1455 |
s.depth[node] := uch (s.depth[m] + 1);
|
1456 |
|
1457 |
tree^[m].dl.Dad := ush(node);
|
1458 |
tree^[n].dl.Dad := ush(node);
|
1459 |
{$ifdef DUMP_BL_TREE}
|
1460 |
if (tree = tree_ptr(@s.bl_tree)) then
|
1461 |
begin
|
1462 |
WriteLn(#13'node ',node,'(',tree^[node].fc.Freq,') sons ',n,
|
1463 |
'(',tree^[n].fc.Freq,') ', m, '(',tree^[m].fc.Freq,')');
|
1464 |
end;
|
1465 |
{$endif}
|
1466 |
{ and insert the new node in the heap }
|
1467 |
s.heap[SMALLEST] := node;
|
1468 |
Inc(node);
|
1469 |
pqdownheap(s, tree^, SMALLEST);
|
1470 |
|
1471 |
until (s.heap_len < 2);
|
1472 |
|
1473 |
Dec(s.heap_max);
|
1474 |
s.heap[s.heap_max] := s.heap[SMALLEST];
|
1475 |
|
1476 |
{ At this point, the fields freq and dad are set. We can now
|
1477 |
generate the bit lengths. }
|
1478 |
|
1479 |
gen_bitlen(s, desc);
|
1480 |
|
1481 |
{ The field len is now set, we can generate the bit codes }
|
1482 |
gen_codes (tree, max_code, s.bl_count);
|
1483 |
end;
|
1484 |
|
1485 |
{ ===========================================================================
|
1486 |
Scan a literal or distance tree to determine the frequencies of the codes
|
1487 |
in the bit length tree. }
|
1488 |
|
1489 |
{local}
|
1490 |
procedure scan_tree(var s : deflate_state;
|
1491 |
var tree : array of ct_data; { the tree to be scanned }
|
1492 |
max_code : int); { and its largest code of non zero frequency }
|
1493 |
var
|
1494 |
n : int; { iterates over all tree elements }
|
1495 |
prevlen : int; { last emitted length }
|
1496 |
curlen : int; { length of current code }
|
1497 |
nextlen : int; { length of next code }
|
1498 |
count : int; { repeat count of the current code }
|
1499 |
max_count : int; { max repeat count }
|
1500 |
min_count : int; { min repeat count }
|
1501 |
begin
|
1502 |
prevlen := -1;
|
1503 |
nextlen := tree[0].dl.Len;
|
1504 |
count := 0;
|
1505 |
max_count := 7;
|
1506 |
min_count := 4;
|
1507 |
|
1508 |
if (nextlen = 0) then
|
1509 |
begin
|
1510 |
max_count := 138;
|
1511 |
min_count := 3;
|
1512 |
end;
|
1513 |
tree[max_code+1].dl.Len := ush($ffff); { guard }
|
1514 |
|
1515 |
for n := 0 to max_code do
|
1516 |
begin
|
1517 |
curlen := nextlen;
|
1518 |
nextlen := tree[n+1].dl.Len;
|
1519 |
Inc(count);
|
1520 |
if (count < max_count) and (curlen = nextlen) then
|
1521 |
continue
|
1522 |
else
|
1523 |
if (count < min_count) then
|
1524 |
Inc(s.bl_tree[curlen].fc.Freq, count)
|
1525 |
else
|
1526 |
if (curlen <> 0) then
|
1527 |
begin
|
1528 |
if (curlen <> prevlen) then
|
1529 |
Inc(s.bl_tree[curlen].fc.Freq);
|
1530 |
Inc(s.bl_tree[REP_3_6].fc.Freq);
|
1531 |
end
|
1532 |
else
|
1533 |
if (count <= 10) then
|
1534 |
Inc(s.bl_tree[REPZ_3_10].fc.Freq)
|
1535 |
else
|
1536 |
Inc(s.bl_tree[REPZ_11_138].fc.Freq);
|
1537 |
|
1538 |
count := 0;
|
1539 |
prevlen := curlen;
|
1540 |
if (nextlen = 0) then
|
1541 |
begin
|
1542 |
max_count := 138;
|
1543 |
min_count := 3;
|
1544 |
end
|
1545 |
else
|
1546 |
if (curlen = nextlen) then
|
1547 |
begin
|
1548 |
max_count := 6;
|
1549 |
min_count := 3;
|
1550 |
end
|
1551 |
else
|
1552 |
begin
|
1553 |
max_count := 7;
|
1554 |
min_count := 4;
|
1555 |
end;
|
1556 |
end;
|
1557 |
end;
|
1558 |
|
1559 |
{ ===========================================================================
|
1560 |
Send a literal or distance tree in compressed form, using the codes in
|
1561 |
bl_tree. }
|
1562 |
|
1563 |
{local}
|
1564 |
procedure send_tree(var s : deflate_state;
|
1565 |
var tree : array of ct_data; { the tree to be scanned }
|
1566 |
max_code : int); { and its largest code of non zero frequency }
|
1567 |
|
1568 |
var
|
1569 |
n : int; { iterates over all tree elements }
|
1570 |
prevlen : int; { last emitted length }
|
1571 |
curlen : int; { length of current code }
|
1572 |
nextlen : int; { length of next code }
|
1573 |
count : int; { repeat count of the current code }
|
1574 |
max_count : int; { max repeat count }
|
1575 |
min_count : int; { min repeat count }
|
1576 |
begin
|
1577 |
prevlen := -1;
|
1578 |
nextlen := tree[0].dl.Len;
|
1579 |
count := 0;
|
1580 |
max_count := 7;
|
1581 |
min_count := 4;
|
1582 |
|
1583 |
{ tree[max_code+1].dl.Len := -1; } { guard already set }
|
1584 |
if (nextlen = 0) then
|
1585 |
begin
|
1586 |
max_count := 138;
|
1587 |
min_count := 3;
|
1588 |
end;
|
1589 |
|
1590 |
for n := 0 to max_code do
|
1591 |
begin
|
1592 |
curlen := nextlen;
|
1593 |
nextlen := tree[n+1].dl.Len;
|
1594 |
Inc(count);
|
1595 |
if (count < max_count) and (curlen = nextlen) then
|
1596 |
continue
|
1597 |
else
|
1598 |
if (count < min_count) then
|
1599 |
begin
|
1600 |
repeat
|
1601 |
{$ifdef DEBUG}
|
1602 |
Tracevvv(#13'cd '+IntToStr(curlen));
|
1603 |
{$ENDIF}
|
1604 |
send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
|
1605 |
Dec(count);
|
1606 |
until (count = 0);
|
1607 |
end
|
1608 |
else
|
1609 |
if (curlen <> 0) then
|
1610 |
begin
|
1611 |
if (curlen <> prevlen) then
|
1612 |
begin
|
1613 |
{$ifdef DEBUG}
|
1614 |
Tracevvv(#13'cd '+IntToStr(curlen));
|
1615 |
{$ENDIF}
|
1616 |
send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
|
1617 |
Dec(count);
|
1618 |
end;
|
1619 |
{$IFDEF DEBUG}
|
1620 |
Assert((count >= 3) and (count <= 6), ' 3_6?');
|
1621 |
{$ENDIF}
|
1622 |
{$ifdef DEBUG}
|
1623 |
Tracevvv(#13'cd '+IntToStr(REP_3_6));
|
1624 |
{$ENDIF}
|
1625 |
send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len);
|
1626 |
send_bits(s, count-3, 2);
|
1627 |
end
|
1628 |
else
|
1629 |
if (count <= 10) then
|
1630 |
begin
|
1631 |
{$ifdef DEBUG}
|
1632 |
Tracevvv(#13'cd '+IntToStr(REPZ_3_10));
|
1633 |
{$ENDIF}
|
1634 |
send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len);
|
1635 |
send_bits(s, count-3, 3);
|
1636 |
end
|
1637 |
else
|
1638 |
begin
|
1639 |
{$ifdef DEBUG}
|
1640 |
Tracevvv(#13'cd '+IntToStr(REPZ_11_138));
|
1641 |
{$ENDIF}
|
1642 |
send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len);
|
1643 |
send_bits(s, count-11, 7);
|
1644 |
end;
|
1645 |
count := 0;
|
1646 |
prevlen := curlen;
|
1647 |
if (nextlen = 0) then
|
1648 |
begin
|
1649 |
max_count := 138;
|
1650 |
min_count := 3;
|
1651 |
end
|
1652 |
else
|
1653 |
if (curlen = nextlen) then
|
1654 |
begin
|
1655 |
max_count := 6;
|
1656 |
min_count := 3;
|
1657 |
end
|
1658 |
else
|
1659 |
begin
|
1660 |
max_count := 7;
|
1661 |
min_count := 4;
|
1662 |
end;
|
1663 |
end;
|
1664 |
end;
|
1665 |
|
1666 |
{ ===========================================================================
|
1667 |
Construct the Huffman tree for the bit lengths and return the index in
|
1668 |
bl_order of the last bit length code to send. }
|
1669 |
|
1670 |
{local}
|
1671 |
function build_bl_tree(var s : deflate_state) : int;
|
1672 |
var
|
1673 |
max_blindex : int; { index of last bit length code of non zero freq }
|
1674 |
begin
|
1675 |
{ Determine the bit length frequencies for literal and distance trees }
|
1676 |
scan_tree(s, s.dyn_ltree, s.l_desc.max_code);
|
1677 |
scan_tree(s, s.dyn_dtree, s.d_desc.max_code);
|
1678 |
|
1679 |
{ Build the bit length tree: }
|
1680 |
build_tree(s, s.bl_desc);
|
1681 |
{ opt_len now includes the length of the tree representations, except
|
1682 |
the lengths of the bit lengths codes and the 5+5+4 bits for the counts. }
|
1683 |
|
1684 |
{ Determine the number of bit length codes to send. The pkzip format
|
1685 |
requires that at least 4 bit length codes be sent. (appnote.txt says
|
1686 |
3 but the actual value used is 4.) }
|
1687 |
|
1688 |
for max_blindex := BL_CODES-1 downto 3 do
|
1689 |
begin
|
1690 |
if (s.bl_tree[bl_order[max_blindex]].dl.Len <> 0) then
|
1691 |
break;
|
1692 |
end;
|
1693 |
{ Update opt_len to include the bit length tree and counts }
|
1694 |
Inc(s.opt_len, 3*(max_blindex+1) + 5+5+4);
|
1695 |
{$ifdef DEBUG}
|
1696 |
Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}');
|
1697 |
{$ENDIF}
|
1698 |
|
1699 |
build_bl_tree := max_blindex;
|
1700 |
end;
|
1701 |
|
1702 |
{ ===========================================================================
|
1703 |
Send the header for a block using dynamic Huffman trees: the counts, the
|
1704 |
lengths of the bit length codes, the literal tree and the distance tree.
|
1705 |
IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. }
|
1706 |
|
1707 |
{local}
|
1708 |
procedure send_all_trees(var s : deflate_state;
|
1709 |
lcodes : int;
|
1710 |
dcodes : int;
|
1711 |
blcodes : int); { number of codes for each tree }
|
1712 |
var
|
1713 |
rank : int; { index in bl_order }
|
1714 |
begin
|
1715 |
{$IFDEF DEBUG}
|
1716 |
Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4),
|
1717 |
'not enough codes');
|
1718 |
Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES)
|
1719 |
and (blcodes <= BL_CODES), 'too many codes');
|
1720 |
Tracev(^M'bl counts: ');
|
1721 |
{$ENDIF}
|
1722 |
send_bits(s, lcodes-257, 5); { not +255 as stated in appnote.txt }
|
1723 |
send_bits(s, dcodes-1, 5);
|
1724 |
send_bits(s, blcodes-4, 4); { not -3 as stated in appnote.txt }
|
1725 |
for rank := 0 to blcodes-1 do
|
1726 |
begin
|
1727 |
{$ifdef DEBUG}
|
1728 |
Tracev(^M'bl code '+IntToStr(bl_order[rank]));
|
1729 |
{$ENDIF}
|
1730 |
send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3);
|
1731 |
end;
|
1732 |
{$ifdef DEBUG}
|
1733 |
Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent));
|
1734 |
{$ENDIF}
|
1735 |
|
1736 |
send_tree(s, s.dyn_ltree, lcodes-1); { literal tree }
|
1737 |
{$ifdef DEBUG}
|
1738 |
Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent));
|
1739 |
{$ENDIF}
|
1740 |
|
1741 |
send_tree(s, s.dyn_dtree, dcodes-1); { distance tree }
|
1742 |
{$ifdef DEBUG}
|
1743 |
Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent));
|
1744 |
{$ENDIF}
|
1745 |
end;
|
1746 |
|
1747 |
{ ===========================================================================
|
1748 |
Flush the bit buffer and align the output on a byte boundary }
|
1749 |
|
1750 |
{local}
|
1751 |
procedure bi_windup(var s : deflate_state);
|
1752 |
begin
|
1753 |
if (s.bi_valid > 8) then
|
1754 |
begin
|
1755 |
{put_short(s, s.bi_buf);}
|
1756 |
s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);
|
1757 |
Inc(s.pending);
|
1758 |
s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;
|
1759 |
Inc(s.pending);
|
1760 |
end
|
1761 |
else
|
1762 |
if (s.bi_valid > 0) then
|
1763 |
begin
|
1764 |
{put_byte(s, (Byte)s^.bi_buf);}
|
1765 |
s.pending_buf^[s.pending] := Byte(s.bi_buf);
|
1766 |
Inc(s.pending);
|
1767 |
end;
|
1768 |
s.bi_buf := 0;
|
1769 |
s.bi_valid := 0;
|
1770 |
{$ifdef DEBUG}
|
1771 |
s.bits_sent := (s.bits_sent+7) and (not 7);
|
1772 |
{$endif}
|
1773 |
end;
|
1774 |
|
1775 |
{ ===========================================================================
|
1776 |
Copy a stored block, storing first the length and its
|
1777 |
one's complement if requested. }
|
1778 |
|
1779 |
{local}
|
1780 |
procedure copy_block(var s : deflate_state;
|
1781 |
buf : pcharf; { the input data }
|
1782 |
len : unsigned; { its length }
|
1783 |
header : boolean); { true if block header must be written }
|
1784 |
begin
|
1785 |
bi_windup(s); { align on byte boundary }
|
1786 |
s.last_eob_len := 8; { enough lookahead for inflate }
|
1787 |
|
1788 |
if (header) then
|
1789 |
begin
|
1790 |
{put_short(s, (ush)len);}
|
1791 |
s.pending_buf^[s.pending] := uch(ush(len) and $ff);
|
1792 |
Inc(s.pending);
|
1793 |
s.pending_buf^[s.pending] := uch(ush(len) shr 8);;
|
1794 |
Inc(s.pending);
|
1795 |
{put_short(s, (ush)~len);}
|
1796 |
s.pending_buf^[s.pending] := uch(ush(not len) and $ff);
|
1797 |
Inc(s.pending);
|
1798 |
s.pending_buf^[s.pending] := uch(ush(not len) shr 8);;
|
1799 |
Inc(s.pending);
|
1800 |
|
1801 |
{$ifdef DEBUG}
|
1802 |
Inc(s.bits_sent, 2*16);
|
1803 |
{$endif}
|
1804 |
end;
|
1805 |
{$ifdef DEBUG}
|
1806 |
Inc(s.bits_sent, ulg(len shl 3));
|
1807 |
{$endif}
|
1808 |
while (len <> 0) do
|
1809 |
begin
|
1810 |
Dec(len);
|
1811 |
{put_byte(s, *buf++);}
|
1812 |
s.pending_buf^[s.pending] := buf^;
|
1813 |
Inc(buf);
|
1814 |
Inc(s.pending);
|
1815 |
end;
|
1816 |
end;
|
1817 |
|
1818 |
|
1819 |
{ ===========================================================================
|
1820 |
Send a stored block }
|
1821 |
|
1822 |
procedure _tr_stored_block(var s : deflate_state;
|
1823 |
buf : pcharf; { input block }
|
1824 |
stored_len : ulg; { length of input block }
|
1825 |
eof : boolean); { true if this is the last block for a file }
|
1826 |
|
1827 |
begin
|
1828 |
send_bits(s, (STORED_BLOCK shl 1)+ord(eof), 3); { send block type }
|
1829 |
s.compressed_len := (s.compressed_len + 3 + 7) and ulg(not Long(7));
|
1830 |
Inc(s.compressed_len, (stored_len + 4) shl 3);
|
1831 |
|
1832 |
copy_block(s, buf, unsigned(stored_len), TRUE); { with header }
|
1833 |
end;
|
1834 |
|
1835 |
{ ===========================================================================
|
1836 |
Flush the bit buffer, keeping at most 7 bits in it. }
|
1837 |
|
1838 |
{local}
|
1839 |
procedure bi_flush(var s : deflate_state);
|
1840 |
begin
|
1841 |
if (s.bi_valid = 16) then
|
1842 |
begin
|
1843 |
{put_short(s, s.bi_buf);}
|
1844 |
s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);
|
1845 |
Inc(s.pending);
|
1846 |
s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;
|
1847 |
Inc(s.pending);
|
1848 |
|
1849 |
s.bi_buf := 0;
|
1850 |
s.bi_valid := 0;
|
1851 |
end
|
1852 |
else
|
1853 |
if (s.bi_valid >= 8) then
|
1854 |
begin
|
1855 |
{put_byte(s, (Byte)s^.bi_buf);}
|
1856 |
s.pending_buf^[s.pending] := Byte(s.bi_buf);
|
1857 |
Inc(s.pending);
|
1858 |
|
1859 |
s.bi_buf := s.bi_buf shr 8;
|
1860 |
Dec(s.bi_valid, 8);
|
1861 |
end;
|
1862 |
end;
|
1863 |
|
1864 |
|
1865 |
{ ===========================================================================
|
1866 |
Send one empty static block to give enough lookahead for inflate.
|
1867 |
This takes 10 bits, of which 7 may remain in the bit buffer.
|
1868 |
The current inflate code requires 9 bits of lookahead. If the
|
1869 |
last two codes for the previous block (real code plus EOB) were coded
|
1870 |
on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode
|
1871 |
the last real code. In this case we send two empty static blocks instead
|
1872 |
of one. (There are no problems if the previous block is stored or fixed.)
|
1873 |
To simplify the code, we assume the worst case of last real code encoded
|
1874 |
on one bit only. }
|
1875 |
|
1876 |
procedure _tr_align(var s : deflate_state);
|
1877 |
begin
|
1878 |
send_bits(s, STATIC_TREES shl 1, 3);
|
1879 |
{$ifdef DEBUG}
|
1880 |
Tracevvv(#13'cd '+IntToStr(END_BLOCK));
|
1881 |
{$ENDIF}
|
1882 |
send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
|
1883 |
Inc(s.compressed_len, Long(10)); { 3 for block type, 7 for EOB }
|
1884 |
bi_flush(s);
|
1885 |
{ Of the 10 bits for the empty block, we have already sent
|
1886 |
(10 - bi_valid) bits. The lookahead for the last real code (before
|
1887 |
the EOB of the previous block) was thus at least one plus the length
|
1888 |
of the EOB plus what we have just sent of the empty static block. }
|
1889 |
if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then
|
1890 |
begin
|
1891 |
send_bits(s, STATIC_TREES shl 1, 3);
|
1892 |
{$ifdef DEBUG}
|
1893 |
Tracevvv(#13'cd '+IntToStr(END_BLOCK));
|
1894 |
{$ENDIF}
|
1895 |
send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
|
1896 |
Inc(s.compressed_len, Long(10));
|
1897 |
bi_flush(s);
|
1898 |
end;
|
1899 |
s.last_eob_len := 7;
|
1900 |
end;
|
1901 |
|
1902 |
{ ===========================================================================
|
1903 |
Set the data type to ASCII or BINARY, using a crude approximation:
|
1904 |
binary if more than 20% of the bytes are <= 6 or >= 128, ascii otherwise.
|
1905 |
IN assertion: the fields freq of dyn_ltree are set and the total of all
|
1906 |
frequencies does not exceed 64K (to fit in an int on 16 bit machines). }
|
1907 |
|
1908 |
{local}
|
1909 |
procedure set_data_type(var s : deflate_state);
|
1910 |
var
|
1911 |
n : int;
|
1912 |
ascii_freq : unsigned;
|
1913 |
bin_freq : unsigned;
|
1914 |
begin
|
1915 |
n := 0;
|
1916 |
ascii_freq := 0;
|
1917 |
bin_freq := 0;
|
1918 |
|
1919 |
while (n < 7) do
|
1920 |
begin
|
1921 |
Inc(bin_freq, s.dyn_ltree[n].fc.Freq);
|
1922 |
Inc(n);
|
1923 |
end;
|
1924 |
while (n < 128) do
|
1925 |
begin
|
1926 |
Inc(ascii_freq, s.dyn_ltree[n].fc.Freq);
|
1927 |
Inc(n);
|
1928 |
end;
|
1929 |
while (n < LITERALS) do
|
1930 |
begin
|
1931 |
Inc(bin_freq, s.dyn_ltree[n].fc.Freq);
|
1932 |
Inc(n);
|
1933 |
end;
|
1934 |
if (bin_freq > (ascii_freq shr 2)) then
|
1935 |
s.data_type := Byte(Z_BINARY)
|
1936 |
else
|
1937 |
s.data_type := Byte(Z_ASCII);
|
1938 |
end;
|
1939 |
|
1940 |
{ ===========================================================================
|
1941 |
Send the block data compressed using the given Huffman trees }
|
1942 |
|
1943 |
{local}
|
1944 |
procedure compress_block(var s : deflate_state;
|
1945 |
var ltree : array of ct_data; { literal tree }
|
1946 |
var dtree : array of ct_data); { distance tree }
|
1947 |
var
|
1948 |
dist : unsigned; { distance of matched string }
|
1949 |
lc : int; { match length or unmatched char (if dist == 0) }
|
1950 |
lx : unsigned; { running index in l_buf }
|
1951 |
code : unsigned; { the code to send }
|
1952 |
extra : int; { number of extra bits to send }
|
1953 |
begin
|
1954 |
lx := 0;
|
1955 |
if (s.last_lit <> 0) then
|
1956 |
repeat
|
1957 |
dist := s.d_buf^[lx];
|
1958 |
lc := s.l_buf^[lx];
|
1959 |
Inc(lx);
|
1960 |
if (dist = 0) then
|
1961 |
begin
|
1962 |
{ send a literal byte }
|
1963 |
{$ifdef DEBUG}
|
1964 |
Tracevvv(#13'cd '+IntToStr(lc));
|
1965 |
Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
|
1966 |
{$ENDIF}
|
1967 |
send_bits(s, ltree[lc].fc.Code, ltree[lc].dl.Len);
|
1968 |
end
|
1969 |
else
|
1970 |
begin
|
1971 |
{ Here, lc is the match length - MIN_MATCH }
|
1972 |
code := _length_code[lc];
|
1973 |
{ send the length code }
|
1974 |
{$ifdef DEBUG}
|
1975 |
Tracevvv(#13'cd '+IntToStr(code+LITERALS+1));
|
1976 |
{$ENDIF}
|
1977 |
send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len);
|
1978 |
extra := extra_lbits[code];
|
1979 |
if (extra <> 0) then
|
1980 |
begin
|
1981 |
Dec(lc, base_length[code]);
|
1982 |
send_bits(s, lc, extra); { send the extra length bits }
|
1983 |
end;
|
1984 |
Dec(dist); { dist is now the match distance - 1 }
|
1985 |
{code := d_code(dist);}
|
1986 |
if (dist < 256) then
|
1987 |
code := _dist_code[dist]
|
1988 |
else
|
1989 |
code := _dist_code[256+(dist shr 7)];
|
1990 |
|
1991 |
{$IFDEF DEBUG}
|
1992 |
Assert (code < D_CODES, 'bad d_code');
|
1993 |
{$ENDIF}
|
1994 |
|
1995 |
{ send the distance code }
|
1996 |
{$ifdef DEBUG}
|
1997 |
Tracevvv(#13'cd '+IntToStr(code));
|
1998 |
{$ENDIF}
|
1999 |
send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len);
|
2000 |
extra := extra_dbits[code];
|
2001 |
if (extra <> 0) then
|
2002 |
begin
|
2003 |
Dec(dist, base_dist[code]);
|
2004 |
send_bits(s, dist, extra); { send the extra distance bits }
|
2005 |
end;
|
2006 |
end; { literal or match pair ? }
|
2007 |
|
2008 |
{ Check that the overlay between pending_buf and d_buf+l_buf is ok: }
|
2009 |
{$IFDEF DEBUG}
|
2010 |
Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow');
|
2011 |
{$ENDIF}
|
2012 |
until (lx >= s.last_lit);
|
2013 |
|
2014 |
{$ifdef DEBUG}
|
2015 |
Tracevvv(#13'cd '+IntToStr(END_BLOCK));
|
2016 |
{$ENDIF}
|
2017 |
send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len);
|
2018 |
s.last_eob_len := ltree[END_BLOCK].dl.Len;
|
2019 |
end;
|
2020 |
|
2021 |
|
2022 |
{ ===========================================================================
|
2023 |
Determine the best encoding for the current block: dynamic trees, static
|
2024 |
trees or store, and output the encoded block to the zip file. This function
|
2025 |
returns the total compressed length for the file so far. }
|
2026 |
|
2027 |
function _tr_flush_block (var s : deflate_state;
|
2028 |
buf : pcharf; { input block, or NULL if too old }
|
2029 |
stored_len : ulg; { length of input block }
|
2030 |
eof : boolean) : ulg; { true if this is the last block for a file }
|
2031 |
var
|
2032 |
opt_lenb, static_lenb : ulg; { opt_len and static_len in bytes }
|
2033 |
max_blindex : int; { index of last bit length code of non zero freq }
|
2034 |
begin
|
2035 |
max_blindex := 0;
|
2036 |
|
2037 |
{ Build the Huffman trees unless a stored block is forced }
|
2038 |
if (s.level > 0) then
|
2039 |
begin
|
2040 |
{ Check if the file is ascii or binary }
|
2041 |
if (s.data_type = Z_UNKNOWN) then
|
2042 |
set_data_type(s);
|
2043 |
|
2044 |
{ Construct the literal and distance trees }
|
2045 |
build_tree(s, s.l_desc);
|
2046 |
{$ifdef DEBUG}
|
2047 |
Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
|
2048 |
{$ENDIF}
|
2049 |
|
2050 |
build_tree(s, s.d_desc);
|
2051 |
{$ifdef DEBUG}
|
2052 |
Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
|
2053 |
{$ENDIF}
|
2054 |
{ At this point, opt_len and static_len are the total bit lengths of
|
2055 |
the compressed block data, excluding the tree representations. }
|
2056 |
|
2057 |
{ Build the bit length tree for the above two trees, and get the index
|
2058 |
in bl_order of the last bit length code to send. }
|
2059 |
max_blindex := build_bl_tree(s);
|
2060 |
|
2061 |
{ Determine the best encoding. Compute first the block length in bytes}
|
2062 |
opt_lenb := (s.opt_len+3+7) shr 3;
|
2063 |
static_lenb := (s.static_len+3+7) shr 3;
|
2064 |
|
2065 |
{$ifdef DEBUG}
|
2066 |
Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+
|
2067 |
'{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
|
2068 |
's.last_lit}');
|
2069 |
{$ENDIF}
|
2070 |
|
2071 |
if (static_lenb <= opt_lenb) then
|
2072 |
opt_lenb := static_lenb;
|
2073 |
|
2074 |
end
|
2075 |
else
|
2076 |
begin
|
2077 |
{$IFDEF DEBUG}
|
2078 |
Assert(buf <> pcharf(NIL), 'lost buf');
|
2079 |
{$ENDIF}
|
2080 |
static_lenb := stored_len + 5;
|
2081 |
opt_lenb := static_lenb; { force a stored block }
|
2082 |
end;
|
2083 |
|
2084 |
{ If compression failed and this is the first and last block,
|
2085 |
and if the .zip file can be seeked (to rewrite the local header),
|
2086 |
the whole file is transformed into a stored file: }
|
2087 |
|
2088 |
{$ifdef STORED_FILE_OK}
|
2089 |
{$ifdef FORCE_STORED_FILE}
|
2090 |
if eof and (s.compressed_len = Long(0)) then
|
2091 |
begin { force stored file }
|
2092 |
{$else}
|
2093 |
if (stored_len <= opt_lenb) and eof and (s.compressed_len=Long(0))
|
2094 |
and seekable()) do
|
2095 |
begin
|
2096 |
{$endif}
|
2097 |
{ Since LIT_BUFSIZE <= 2*WSIZE, the input data must be there: }
|
2098 |
if (buf = pcharf(0)) then
|
2099 |
error ('block vanished');
|
2100 |
|
2101 |
copy_block(buf, unsigned(stored_len), 0); { without header }
|
2102 |
s.compressed_len := stored_len shl 3;
|
2103 |
s.method := STORED;
|
2104 |
end
|
2105 |
else
|
2106 |
{$endif} { STORED_FILE_OK }
|
2107 |
|
2108 |
{$ifdef FORCE_STORED}
|
2109 |
if (buf <> pchar(0)) then
|
2110 |
begin { force stored block }
|
2111 |
{$else}
|
2112 |
if (stored_len+4 <= opt_lenb) and (buf <> pcharf(0)) then
|
2113 |
begin
|
2114 |
{ 4: two words for the lengths }
|
2115 |
{$endif}
|
2116 |
{ The test buf <> NULL is only necessary if LIT_BUFSIZE > WSIZE.
|
2117 |
Otherwise we can't have processed more than WSIZE input bytes since
|
2118 |
the last block flush, because compression would have been
|
2119 |
successful. If LIT_BUFSIZE <= WSIZE, it is never too late to
|
2120 |
transform a block into a stored block. }
|
2121 |
|
2122 |
_tr_stored_block(s, buf, stored_len, eof);
|
2123 |
|
2124 |
{$ifdef FORCE_STATIC}
|
2125 |
end
|
2126 |
else
|
2127 |
if (static_lenb >= 0) then
|
2128 |
begin { force static trees }
|
2129 |
{$else}
|
2130 |
end
|
2131 |
else
|
2132 |
if (static_lenb = opt_lenb) then
|
2133 |
begin
|
2134 |
{$endif}
|
2135 |
send_bits(s, (STATIC_TREES shl 1)+ord(eof), 3);
|
2136 |
compress_block(s, static_ltree, static_dtree);
|
2137 |
Inc(s.compressed_len, 3 + s.static_len);
|
2138 |
end
|
2139 |
else
|
2140 |
begin
|
2141 |
send_bits(s, (DYN_TREES shl 1)+ord(eof), 3);
|
2142 |
send_all_trees(s, s.l_desc.max_code+1, s.d_desc.max_code+1,
|
2143 |
max_blindex+1);
|
2144 |
compress_block(s, s.dyn_ltree, s.dyn_dtree);
|
2145 |
Inc(s.compressed_len, 3 + s.opt_len);
|
2146 |
end;
|
2147 |
{$ifdef DEBUG}
|
2148 |
Assert (s.compressed_len = s.bits_sent, 'bad compressed size');
|
2149 |
{$ENDIF}
|
2150 |
init_block(s);
|
2151 |
|
2152 |
if (eof) then
|
2153 |
begin
|
2154 |
bi_windup(s);
|
2155 |
Inc(s.compressed_len, 7); { align on byte boundary }
|
2156 |
end;
|
2157 |
{$ifdef DEBUG}
|
2158 |
Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+
|
2159 |
's.compressed_len-7*ord(eof)}');
|
2160 |
{$ENDIF}
|
2161 |
|
2162 |
_tr_flush_block := s.compressed_len shr 3;
|
2163 |
end;
|
2164 |
|
2165 |
|
2166 |
{ ===========================================================================
|
2167 |
Save the match info and tally the frequency counts. Return true if
|
2168 |
the current block must be flushed. }
|
2169 |
|
2170 |
function _tr_tally (var s : deflate_state;
|
2171 |
dist : unsigned; { distance of matched string }
|
2172 |
lc : unsigned) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) }
|
2173 |
var
|
2174 |
{$IFDEF DEBUG}
|
2175 |
MAX_DIST : ush;
|
2176 |
{$ENDIF}
|
2177 |
code : ush;
|
2178 |
{$ifdef TRUNCATE_BLOCK}
|
2179 |
var
|
2180 |
out_length : ulg;
|
2181 |
in_length : ulg;
|
2182 |
dcode : int;
|
2183 |
{$endif}
|
2184 |
begin
|
2185 |
s.d_buf^[s.last_lit] := ush(dist);
|
2186 |
s.l_buf^[s.last_lit] := uch(lc);
|
2187 |
Inc(s.last_lit);
|
2188 |
if (dist = 0) then
|
2189 |
begin
|
2190 |
{ lc is the unmatched char }
|
2191 |
Inc(s.dyn_ltree[lc].fc.Freq);
|
2192 |
end
|
2193 |
else
|
2194 |
begin
|
2195 |
Inc(s.matches);
|
2196 |
{ Here, lc is the match length - MIN_MATCH }
|
2197 |
Dec(dist); { dist := match distance - 1 }
|
2198 |
|
2199 |
{macro d_code(dist)}
|
2200 |
if (dist) < 256 then
|
2201 |
code := _dist_code[dist]
|
2202 |
else
|
2203 |
code := _dist_code[256+(dist shr 7)];
|
2204 |
{$IFDEF DEBUG}
|
2205 |
{macro MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD)
|
2206 |
In order to simplify the code, particularly on 16 bit machines, match
|
2207 |
distances are limited to MAX_DIST instead of WSIZE. }
|
2208 |
MAX_DIST := ush(s.w_size-MIN_LOOKAHEAD);
|
2209 |
Assert((dist < ush(MAX_DIST)) and
|
2210 |
(ush(lc) <= ush(MAX_MATCH-MIN_MATCH)) and
|
2211 |
(ush(code) < ush(D_CODES)), '_tr_tally: bad match');
|
2212 |
{$ENDIF}
|
2213 |
Inc(s.dyn_ltree[_length_code[lc]+LITERALS+1].fc.Freq);
|
2214 |
{s.dyn_dtree[d_code(dist)].Freq++;}
|
2215 |
Inc(s.dyn_dtree[code].fc.Freq);
|
2216 |
end;
|
2217 |
|
2218 |
{$ifdef TRUNCATE_BLOCK}
|
2219 |
{ Try to guess if it is profitable to stop the current block here }
|
2220 |
if (s.last_lit and $1fff = 0) and (s.level > 2) then
|
2221 |
begin
|
2222 |
{ Compute an upper bound for the compressed length }
|
2223 |
out_length := ulg(s.last_lit)*Long(8);
|
2224 |
in_length := ulg(long(s.strstart) - s.block_start);
|
2225 |
for dcode := 0 to D_CODES-1 do
|
2226 |
begin
|
2227 |
Inc(out_length, ulg(s.dyn_dtree[dcode].fc.Freq *
|
2228 |
(Long(5)+extra_dbits[dcode])) );
|
2229 |
end;
|
2230 |
out_length := out_length shr 3;
|
2231 |
{$ifdef DEBUG}
|
2232 |
Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) ');
|
2233 |
{ s.last_lit, in_length, out_length,
|
2234 |
Long(100) - out_length*Long(100) div in_length)); }
|
2235 |
{$ENDIF}
|
2236 |
if (s.matches < s.last_lit div 2) and (out_length < in_length div 2) then
|
2237 |
begin
|
2238 |
_tr_tally := TRUE;
|
2239 |
exit;
|
2240 |
end;
|
2241 |
end;
|
2242 |
{$endif}
|
2243 |
_tr_tally := (s.last_lit = s.lit_bufsize-1);
|
2244 |
{ We avoid equality with lit_bufsize because of wraparound at 64K
|
2245 |
on 16 bit machines and because stored blocks are restricted to
|
2246 |
64K-1 bytes. }
|
2247 |
end;
|
2248 |
|
2249 |
end. |