+Unit trees;\r
+\r
+{$T-}\r
+{$define ORG_DEBUG}\r
+{\r
+ trees.c -- output deflated data using Huffman coding\r
+ Copyright (C) 1995-1998 Jean-loup Gailly\r
+\r
+ Pascal tranlastion\r
+ Copyright (C) 1998 by Jacques Nomssi Nzali\r
+ For conditions of distribution and use, see copyright notice in readme.paszlib\r
+}\r
+\r
+{\r
+ * ALGORITHM\r
+ *\r
+ * The "deflation" process uses several Huffman trees. The more\r
+ * common source values are represented by shorter bit sequences.\r
+ *\r
+ * Each code tree is stored in a compressed form which is itself\r
+ * a Huffman encoding of the lengths of all the code strings (in\r
+ * ascending order by source values). The actual code strings are\r
+ * reconstructed from the lengths in the inflate process, as described\r
+ * in the deflate specification.\r
+ *\r
+ * REFERENCES\r
+ *\r
+ * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".\r
+ * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc\r
+ *\r
+ * Storer, James A.\r
+ * Data Compression: Methods and Theory, pp. 49-50.\r
+ * Computer Science Press, 1988. ISBN 0-7167-8156-5.\r
+ *\r
+ * Sedgewick, R.\r
+ * Algorithms, p290.\r
+ * Addison-Wesley, 1983. ISBN 0-201-06672-6.\r
+ }\r
+\r
+interface\r
+\r
+{$I zconf.inc}\r
+\r
+uses\r
+ {$ifdef DEBUG}\r
+ strutils,\r
+ {$ENDIF}\r
+ zutil, zlib;\r
+\r
+{ ===========================================================================\r
+ Internal compression state. }\r
+\r
+const\r
+ LENGTH_CODES = 29;\r
+{ number of length codes, not counting the special END_BLOCK code }\r
+\r
+ LITERALS = 256;\r
+{ number of literal bytes 0..255 }\r
+\r
+ L_CODES = (LITERALS+1+LENGTH_CODES);\r
+{ number of Literal or Length codes, including the END_BLOCK code }\r
+\r
+ D_CODES = 30;\r
+{ number of distance codes }\r
+\r
+ BL_CODES = 19;\r
+{ number of codes used to transfer the bit lengths }\r
+\r
+ HEAP_SIZE = (2*L_CODES+1);\r
+{ maximum heap size }\r
+\r
+ MAX_BITS = 15;\r
+{ All codes must not exceed MAX_BITS bits }\r
+\r
+const\r
+ INIT_STATE = 42;\r
+ BUSY_STATE = 113;\r
+ FINISH_STATE = 666;\r
+{ Stream status }\r
+\r
+\r
+{ Data structure describing a single value and its code string. }\r
+type\r
+ ct_data_ptr = ^ct_data;\r
+ ct_data = record\r
+ fc : record\r
+ case byte of\r
+ 0:(freq : ush); { frequency count }\r
+ 1:(code : ush); { bit string }\r
+ end;\r
+ dl : record\r
+ case byte of\r
+ 0:(dad : ush); { father node in Huffman tree }\r
+ 1:(len : ush); { length of bit string }\r
+ end;\r
+ end;\r
+\r
+{ Freq = fc.freq\r
+ Code = fc.code\r
+ Dad = dl.dad\r
+ Len = dl.len }\r
+\r
+type\r
+ ltree_type = array[0..HEAP_SIZE-1] of ct_data; { literal and length tree }\r
+ dtree_type = array[0..2*D_CODES+1-1] of ct_data; { distance tree }\r
+ htree_type = array[0..2*BL_CODES+1-1] of ct_data; { Huffman tree for bit lengths }\r
+ { generic tree type }\r
+ tree_type = array[0..(MaxMemBlock div SizeOf(ct_data))-1] of ct_data;\r
+\r
+ tree_ptr = ^tree_type;\r
+ ltree_ptr = ^ltree_type;\r
+ dtree_ptr = ^dtree_type;\r
+ htree_ptr = ^htree_type;\r
+\r
+\r
+type\r
+ static_tree_desc_ptr = ^static_tree_desc;\r
+ static_tree_desc =\r
+ record\r
+ {const} static_tree : tree_ptr; { static tree or NIL }\r
+ {const} extra_bits : pzIntfArray; { extra bits for each code or NIL }\r
+ extra_base : int; { base index for extra_bits }\r
+ elems : int; { max number of elements in the tree }\r
+ max_length : int; { max bit length for the codes }\r
+ end;\r
+\r
+ tree_desc_ptr = ^tree_desc;\r
+ tree_desc = record\r
+ dyn_tree : tree_ptr; { the dynamic tree }\r
+ max_code : int; { largest code with non zero frequency }\r
+ stat_desc : static_tree_desc_ptr; { the corresponding static tree }\r
+ end;\r
+\r
+type\r
+ Pos = ush;\r
+ Posf = Pos; {FAR}\r
+ IPos = uInt;\r
+\r
+ pPosf = ^Posf;\r
+\r
+ zPosfArray = array[0..(MaxMemBlock div SizeOf(Posf))-1] of Posf;\r
+ pzPosfArray = ^zPosfArray;\r
+\r
+{ A Pos is an index in the character window. We use short instead of int to\r
+ save space in the various tables. IPos is used only for parameter passing.}\r
+\r
+type\r
+ deflate_state_ptr = ^deflate_state;\r
+ deflate_state = record\r
+ strm : z_streamp; { pointer back to this zlib stream }\r
+ status : int; { as the name implies }\r
+ pending_buf : pzByteArray; { output still pending }\r
+ pending_buf_size : ulg; { size of pending_buf }\r
+ pending_out : pBytef; { next pending byte to output to the stream }\r
+ pending : int; { nb of bytes in the pending buffer }\r
+ noheader : int; { suppress zlib header and adler32 }\r
+ data_type : Byte; { UNKNOWN, BINARY or ASCII }\r
+ method : Byte; { STORED (for zip only) or DEFLATED }\r
+ last_flush : int; { value of flush param for previous deflate call }\r
+\r
+ { used by deflate.pas: }\r
+\r
+ w_size : uInt; { LZ77 window size (32K by default) }\r
+ w_bits : uInt; { log2(w_size) (8..16) }\r
+ w_mask : uInt; { w_size - 1 }\r
+\r
+ window : pzByteArray;\r
+ { Sliding window. Input bytes are read into the second half of the window,\r
+ and move to the first half later to keep a dictionary of at least wSize\r
+ bytes. With this organization, matches are limited to a distance of\r
+ wSize-MAX_MATCH bytes, but this ensures that IO is always\r
+ performed with a length multiple of the block size. Also, it limits\r
+ the window size to 64K, which is quite useful on MSDOS.\r
+ To do: use the user input buffer as sliding window. }\r
+\r
+ window_size : ulg;\r
+ { Actual size of window: 2*wSize, except when the user input buffer\r
+ is directly used as sliding window. }\r
+\r
+ prev : pzPosfArray;\r
+ { Link to older string with same hash index. To limit the size of this\r
+ array to 64K, this link is maintained only for the last 32K strings.\r
+ An index in this array is thus a window index modulo 32K. }\r
+\r
+ head : pzPosfArray; { Heads of the hash chains or NIL. }\r
+\r
+ ins_h : uInt; { hash index of string to be inserted }\r
+ hash_size : uInt; { number of elements in hash table }\r
+ hash_bits : uInt; { log2(hash_size) }\r
+ hash_mask : uInt; { hash_size-1 }\r
+\r
+ hash_shift : uInt;\r
+ { Number of bits by which ins_h must be shifted at each input\r
+ step. It must be such that after MIN_MATCH steps, the oldest\r
+ byte no longer takes part in the hash key, that is:\r
+ hash_shift * MIN_MATCH >= hash_bits }\r
+\r
+ block_start : long;\r
+ { Window position at the beginning of the current output block. Gets\r
+ negative when the window is moved backwards. }\r
+\r
+ match_length : uInt; { length of best match }\r
+ prev_match : IPos; { previous match }\r
+ match_available : boolean; { set if previous match exists }\r
+ strstart : uInt; { start of string to insert }\r
+ match_start : uInt; { start of matching string }\r
+ lookahead : uInt; { number of valid bytes ahead in window }\r
+\r
+ prev_length : uInt;\r
+ { Length of the best match at previous step. Matches not greater than this\r
+ are discarded. This is used in the lazy match evaluation. }\r
+\r
+ max_chain_length : uInt;\r
+ { To speed up deflation, hash chains are never searched beyond this\r
+ length. A higher limit improves compression ratio but degrades the\r
+ speed. }\r
+\r
+ { moved to the end because Borland Pascal won't accept the following:\r
+ max_lazy_match : uInt;\r
+ max_insert_length : uInt absolute max_lazy_match;\r
+ }\r
+\r
+ level : int; { compression level (1..9) }\r
+ strategy : int; { favor or force Huffman coding}\r
+\r
+ good_match : uInt;\r
+ { Use a faster search when the previous match is longer than this }\r
+\r
+ nice_match : int; { Stop searching when current match exceeds this }\r
+\r
+ { used by trees.pas: }\r
+ { Didn't use ct_data typedef below to supress compiler warning }\r
+ dyn_ltree : ltree_type; { literal and length tree }\r
+ dyn_dtree : dtree_type; { distance tree }\r
+ bl_tree : htree_type; { Huffman tree for bit lengths }\r
+\r
+ l_desc : tree_desc; { desc. for literal tree }\r
+ d_desc : tree_desc; { desc. for distance tree }\r
+ bl_desc : tree_desc; { desc. for bit length tree }\r
+\r
+ bl_count : array[0..MAX_BITS+1-1] of ush;\r
+ { number of codes at each bit length for an optimal tree }\r
+\r
+ heap : array[0..2*L_CODES+1-1] of int; { heap used to build the Huffman trees }\r
+ heap_len : int; { number of elements in the heap }\r
+ heap_max : int; { element of largest frequency }\r
+ { The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used.\r
+ The same heap array is used to build all trees. }\r
+\r
+ depth : array[0..2*L_CODES+1-1] of uch;\r
+ { Depth of each subtree used as tie breaker for trees of equal frequency }\r
+\r
+\r
+ l_buf : puchfArray; { buffer for literals or lengths }\r
+\r
+ lit_bufsize : uInt;\r
+ { Size of match buffer for literals/lengths. There are 4 reasons for\r
+ limiting lit_bufsize to 64K:\r
+ - frequencies can be kept in 16 bit counters\r
+ - if compression is not successful for the first block, all input\r
+ data is still in the window so we can still emit a stored block even\r
+ when input comes from standard input. (This can also be done for\r
+ all blocks if lit_bufsize is not greater than 32K.)\r
+ - if compression is not successful for a file smaller than 64K, we can\r
+ even emit a stored file instead of a stored block (saving 5 bytes).\r
+ This is applicable only for zip (not gzip or zlib).\r
+ - creating new Huffman trees less frequently may not provide fast\r
+ adaptation to changes in the input data statistics. (Take for\r
+ example a binary file with poorly compressible code followed by\r
+ a highly compressible string table.) Smaller buffer sizes give\r
+ fast adaptation but have of course the overhead of transmitting\r
+ trees more frequently.\r
+ - I can't count above 4 }\r
+\r
+\r
+ last_lit : uInt; { running index in l_buf }\r
+\r
+ d_buf : pushfArray;\r
+ { Buffer for distances. To simplify the code, d_buf and l_buf have\r
+ the same number of elements. To use different lengths, an extra flag\r
+ array would be necessary. }\r
+\r
+ opt_len : ulg; { bit length of current block with optimal trees }\r
+ static_len : ulg; { bit length of current block with static trees }\r
+ compressed_len : ulg; { total bit length of compressed file }\r
+ matches : uInt; { number of string matches in current block }\r
+ last_eob_len : int; { bit length of EOB code for last block }\r
+\r
+{$ifdef DEBUG}\r
+ bits_sent : ulg; { bit length of the compressed data }\r
+{$endif}\r
+\r
+ bi_buf : ush;\r
+ { Output buffer. bits are inserted starting at the bottom (least\r
+ significant bits). }\r
+\r
+ bi_valid : int;\r
+ { Number of valid bits in bi_buf. All bits above the last valid bit\r
+ are always zero. }\r
+\r
+ case byte of\r
+ 0:(max_lazy_match : uInt);\r
+ { Attempt to find a better match only when the current match is strictly\r
+ smaller than this value. This mechanism is used only for compression\r
+ levels >= 4. }\r
+\r
+ 1:(max_insert_length : uInt);\r
+ { Insert new strings in the hash table only if the match length is not\r
+ greater than this length. This saves time but degrades compression.\r
+ max_insert_length is used only for compression levels <= 3. }\r
+ end;\r
+\r
+procedure _tr_init (var s : deflate_state);\r
+\r
+function _tr_tally (var s : deflate_state;\r
+ dist : unsigned;\r
+ lc : unsigned) : boolean;\r
+\r
+function _tr_flush_block (var s : deflate_state;\r
+ buf : pcharf;\r
+ stored_len : ulg;\r
+ eof : boolean) : ulg;\r
+\r
+procedure _tr_align(var s : deflate_state);\r
+\r
+procedure _tr_stored_block(var s : deflate_state;\r
+ buf : pcharf;\r
+ stored_len : ulg;\r
+ eof : boolean);\r
+\r
+implementation\r
+\r
+{ #define GEN_TREES_H }\r
+\r
+{$ifndef GEN_TREES_H}\r
+{ header created automatically with -DGEN_TREES_H }\r
+\r
+const\r
+ DIST_CODE_LEN = 512; { see definition of array dist_code below }\r
+\r
+{ The static literal tree. Since the bit lengths are imposed, there is no\r
+ need for the L_CODES extra codes used during heap construction. However\r
+ The codes 286 and 287 are needed to build a canonical tree (see _tr_init\r
+ below). }\r
+const\r
+ static_ltree : array[0..L_CODES+2-1] of ct_data = (\r
+{ fc:(freq, code) dl:(dad,len) }\r
+(fc:(freq: 12);dl:(len: 8)), (fc:(freq:140);dl:(len: 8)), (fc:(freq: 76);dl:(len: 8)),\r
+(fc:(freq:204);dl:(len: 8)), (fc:(freq: 44);dl:(len: 8)), (fc:(freq:172);dl:(len: 8)),\r
+(fc:(freq:108);dl:(len: 8)), (fc:(freq:236);dl:(len: 8)), (fc:(freq: 28);dl:(len: 8)),\r
+(fc:(freq:156);dl:(len: 8)), (fc:(freq: 92);dl:(len: 8)), (fc:(freq:220);dl:(len: 8)),\r
+(fc:(freq: 60);dl:(len: 8)), (fc:(freq:188);dl:(len: 8)), (fc:(freq:124);dl:(len: 8)),\r
+(fc:(freq:252);dl:(len: 8)), (fc:(freq: 2);dl:(len: 8)), (fc:(freq:130);dl:(len: 8)),\r
+(fc:(freq: 66);dl:(len: 8)), (fc:(freq:194);dl:(len: 8)), (fc:(freq: 34);dl:(len: 8)),\r
+(fc:(freq:162);dl:(len: 8)), (fc:(freq: 98);dl:(len: 8)), (fc:(freq:226);dl:(len: 8)),\r
+(fc:(freq: 18);dl:(len: 8)), (fc:(freq:146);dl:(len: 8)), (fc:(freq: 82);dl:(len: 8)),\r
+(fc:(freq:210);dl:(len: 8)), (fc:(freq: 50);dl:(len: 8)), (fc:(freq:178);dl:(len: 8)),\r
+(fc:(freq:114);dl:(len: 8)), (fc:(freq:242);dl:(len: 8)), (fc:(freq: 10);dl:(len: 8)),\r
+(fc:(freq:138);dl:(len: 8)), (fc:(freq: 74);dl:(len: 8)), (fc:(freq:202);dl:(len: 8)),\r
+(fc:(freq: 42);dl:(len: 8)), (fc:(freq:170);dl:(len: 8)), (fc:(freq:106);dl:(len: 8)),\r
+(fc:(freq:234);dl:(len: 8)), (fc:(freq: 26);dl:(len: 8)), (fc:(freq:154);dl:(len: 8)),\r
+(fc:(freq: 90);dl:(len: 8)), (fc:(freq:218);dl:(len: 8)), (fc:(freq: 58);dl:(len: 8)),\r
+(fc:(freq:186);dl:(len: 8)), (fc:(freq:122);dl:(len: 8)), (fc:(freq:250);dl:(len: 8)),\r
+(fc:(freq: 6);dl:(len: 8)), (fc:(freq:134);dl:(len: 8)), (fc:(freq: 70);dl:(len: 8)),\r
+(fc:(freq:198);dl:(len: 8)), (fc:(freq: 38);dl:(len: 8)), (fc:(freq:166);dl:(len: 8)),\r
+(fc:(freq:102);dl:(len: 8)), (fc:(freq:230);dl:(len: 8)), (fc:(freq: 22);dl:(len: 8)),\r
+(fc:(freq:150);dl:(len: 8)), (fc:(freq: 86);dl:(len: 8)), (fc:(freq:214);dl:(len: 8)),\r
+(fc:(freq: 54);dl:(len: 8)), (fc:(freq:182);dl:(len: 8)), (fc:(freq:118);dl:(len: 8)),\r
+(fc:(freq:246);dl:(len: 8)), (fc:(freq: 14);dl:(len: 8)), (fc:(freq:142);dl:(len: 8)),\r
+(fc:(freq: 78);dl:(len: 8)), (fc:(freq:206);dl:(len: 8)), (fc:(freq: 46);dl:(len: 8)),\r
+(fc:(freq:174);dl:(len: 8)), (fc:(freq:110);dl:(len: 8)), (fc:(freq:238);dl:(len: 8)),\r
+(fc:(freq: 30);dl:(len: 8)), (fc:(freq:158);dl:(len: 8)), (fc:(freq: 94);dl:(len: 8)),\r
+(fc:(freq:222);dl:(len: 8)), (fc:(freq: 62);dl:(len: 8)), (fc:(freq:190);dl:(len: 8)),\r
+(fc:(freq:126);dl:(len: 8)), (fc:(freq:254);dl:(len: 8)), (fc:(freq: 1);dl:(len: 8)),\r
+(fc:(freq:129);dl:(len: 8)), (fc:(freq: 65);dl:(len: 8)), (fc:(freq:193);dl:(len: 8)),\r
+(fc:(freq: 33);dl:(len: 8)), (fc:(freq:161);dl:(len: 8)), (fc:(freq: 97);dl:(len: 8)),\r
+(fc:(freq:225);dl:(len: 8)), (fc:(freq: 17);dl:(len: 8)), (fc:(freq:145);dl:(len: 8)),\r
+(fc:(freq: 81);dl:(len: 8)), (fc:(freq:209);dl:(len: 8)), (fc:(freq: 49);dl:(len: 8)),\r
+(fc:(freq:177);dl:(len: 8)), (fc:(freq:113);dl:(len: 8)), (fc:(freq:241);dl:(len: 8)),\r
+(fc:(freq: 9);dl:(len: 8)), (fc:(freq:137);dl:(len: 8)), (fc:(freq: 73);dl:(len: 8)),\r
+(fc:(freq:201);dl:(len: 8)), (fc:(freq: 41);dl:(len: 8)), (fc:(freq:169);dl:(len: 8)),\r
+(fc:(freq:105);dl:(len: 8)), (fc:(freq:233);dl:(len: 8)), (fc:(freq: 25);dl:(len: 8)),\r
+(fc:(freq:153);dl:(len: 8)), (fc:(freq: 89);dl:(len: 8)), (fc:(freq:217);dl:(len: 8)),\r
+(fc:(freq: 57);dl:(len: 8)), (fc:(freq:185);dl:(len: 8)), (fc:(freq:121);dl:(len: 8)),\r
+(fc:(freq:249);dl:(len: 8)), (fc:(freq: 5);dl:(len: 8)), (fc:(freq:133);dl:(len: 8)),\r
+(fc:(freq: 69);dl:(len: 8)), (fc:(freq:197);dl:(len: 8)), (fc:(freq: 37);dl:(len: 8)),\r
+(fc:(freq:165);dl:(len: 8)), (fc:(freq:101);dl:(len: 8)), (fc:(freq:229);dl:(len: 8)),\r
+(fc:(freq: 21);dl:(len: 8)), (fc:(freq:149);dl:(len: 8)), (fc:(freq: 85);dl:(len: 8)),\r
+(fc:(freq:213);dl:(len: 8)), (fc:(freq: 53);dl:(len: 8)), (fc:(freq:181);dl:(len: 8)),\r
+(fc:(freq:117);dl:(len: 8)), (fc:(freq:245);dl:(len: 8)), (fc:(freq: 13);dl:(len: 8)),\r
+(fc:(freq:141);dl:(len: 8)), (fc:(freq: 77);dl:(len: 8)), (fc:(freq:205);dl:(len: 8)),\r
+(fc:(freq: 45);dl:(len: 8)), (fc:(freq:173);dl:(len: 8)), (fc:(freq:109);dl:(len: 8)),\r
+(fc:(freq:237);dl:(len: 8)), (fc:(freq: 29);dl:(len: 8)), (fc:(freq:157);dl:(len: 8)),\r
+(fc:(freq: 93);dl:(len: 8)), (fc:(freq:221);dl:(len: 8)), (fc:(freq: 61);dl:(len: 8)),\r
+(fc:(freq:189);dl:(len: 8)), (fc:(freq:125);dl:(len: 8)), (fc:(freq:253);dl:(len: 8)),\r
+(fc:(freq: 19);dl:(len: 9)), (fc:(freq:275);dl:(len: 9)), (fc:(freq:147);dl:(len: 9)),\r
+(fc:(freq:403);dl:(len: 9)), (fc:(freq: 83);dl:(len: 9)), (fc:(freq:339);dl:(len: 9)),\r
+(fc:(freq:211);dl:(len: 9)), (fc:(freq:467);dl:(len: 9)), (fc:(freq: 51);dl:(len: 9)),\r
+(fc:(freq:307);dl:(len: 9)), (fc:(freq:179);dl:(len: 9)), (fc:(freq:435);dl:(len: 9)),\r
+(fc:(freq:115);dl:(len: 9)), (fc:(freq:371);dl:(len: 9)), (fc:(freq:243);dl:(len: 9)),\r
+(fc:(freq:499);dl:(len: 9)), (fc:(freq: 11);dl:(len: 9)), (fc:(freq:267);dl:(len: 9)),\r
+(fc:(freq:139);dl:(len: 9)), (fc:(freq:395);dl:(len: 9)), (fc:(freq: 75);dl:(len: 9)),\r
+(fc:(freq:331);dl:(len: 9)), (fc:(freq:203);dl:(len: 9)), (fc:(freq:459);dl:(len: 9)),\r
+(fc:(freq: 43);dl:(len: 9)), (fc:(freq:299);dl:(len: 9)), (fc:(freq:171);dl:(len: 9)),\r
+(fc:(freq:427);dl:(len: 9)), (fc:(freq:107);dl:(len: 9)), (fc:(freq:363);dl:(len: 9)),\r
+(fc:(freq:235);dl:(len: 9)), (fc:(freq:491);dl:(len: 9)), (fc:(freq: 27);dl:(len: 9)),\r
+(fc:(freq:283);dl:(len: 9)), (fc:(freq:155);dl:(len: 9)), (fc:(freq:411);dl:(len: 9)),\r
+(fc:(freq: 91);dl:(len: 9)), (fc:(freq:347);dl:(len: 9)), (fc:(freq:219);dl:(len: 9)),\r
+(fc:(freq:475);dl:(len: 9)), (fc:(freq: 59);dl:(len: 9)), (fc:(freq:315);dl:(len: 9)),\r
+(fc:(freq:187);dl:(len: 9)), (fc:(freq:443);dl:(len: 9)), (fc:(freq:123);dl:(len: 9)),\r
+(fc:(freq:379);dl:(len: 9)), (fc:(freq:251);dl:(len: 9)), (fc:(freq:507);dl:(len: 9)),\r
+(fc:(freq: 7);dl:(len: 9)), (fc:(freq:263);dl:(len: 9)), (fc:(freq:135);dl:(len: 9)),\r
+(fc:(freq:391);dl:(len: 9)), (fc:(freq: 71);dl:(len: 9)), (fc:(freq:327);dl:(len: 9)),\r
+(fc:(freq:199);dl:(len: 9)), (fc:(freq:455);dl:(len: 9)), (fc:(freq: 39);dl:(len: 9)),\r
+(fc:(freq:295);dl:(len: 9)), (fc:(freq:167);dl:(len: 9)), (fc:(freq:423);dl:(len: 9)),\r
+(fc:(freq:103);dl:(len: 9)), (fc:(freq:359);dl:(len: 9)), (fc:(freq:231);dl:(len: 9)),\r
+(fc:(freq:487);dl:(len: 9)), (fc:(freq: 23);dl:(len: 9)), (fc:(freq:279);dl:(len: 9)),\r
+(fc:(freq:151);dl:(len: 9)), (fc:(freq:407);dl:(len: 9)), (fc:(freq: 87);dl:(len: 9)),\r
+(fc:(freq:343);dl:(len: 9)), (fc:(freq:215);dl:(len: 9)), (fc:(freq:471);dl:(len: 9)),\r
+(fc:(freq: 55);dl:(len: 9)), (fc:(freq:311);dl:(len: 9)), (fc:(freq:183);dl:(len: 9)),\r
+(fc:(freq:439);dl:(len: 9)), (fc:(freq:119);dl:(len: 9)), (fc:(freq:375);dl:(len: 9)),\r
+(fc:(freq:247);dl:(len: 9)), (fc:(freq:503);dl:(len: 9)), (fc:(freq: 15);dl:(len: 9)),\r
+(fc:(freq:271);dl:(len: 9)), (fc:(freq:143);dl:(len: 9)), (fc:(freq:399);dl:(len: 9)),\r
+(fc:(freq: 79);dl:(len: 9)), (fc:(freq:335);dl:(len: 9)), (fc:(freq:207);dl:(len: 9)),\r
+(fc:(freq:463);dl:(len: 9)), (fc:(freq: 47);dl:(len: 9)), (fc:(freq:303);dl:(len: 9)),\r
+(fc:(freq:175);dl:(len: 9)), (fc:(freq:431);dl:(len: 9)), (fc:(freq:111);dl:(len: 9)),\r
+(fc:(freq:367);dl:(len: 9)), (fc:(freq:239);dl:(len: 9)), (fc:(freq:495);dl:(len: 9)),\r
+(fc:(freq: 31);dl:(len: 9)), (fc:(freq:287);dl:(len: 9)), (fc:(freq:159);dl:(len: 9)),\r
+(fc:(freq:415);dl:(len: 9)), (fc:(freq: 95);dl:(len: 9)), (fc:(freq:351);dl:(len: 9)),\r
+(fc:(freq:223);dl:(len: 9)), (fc:(freq:479);dl:(len: 9)), (fc:(freq: 63);dl:(len: 9)),\r
+(fc:(freq:319);dl:(len: 9)), (fc:(freq:191);dl:(len: 9)), (fc:(freq:447);dl:(len: 9)),\r
+(fc:(freq:127);dl:(len: 9)), (fc:(freq:383);dl:(len: 9)), (fc:(freq:255);dl:(len: 9)),\r
+(fc:(freq:511);dl:(len: 9)), (fc:(freq: 0);dl:(len: 7)), (fc:(freq: 64);dl:(len: 7)),\r
+(fc:(freq: 32);dl:(len: 7)), (fc:(freq: 96);dl:(len: 7)), (fc:(freq: 16);dl:(len: 7)),\r
+(fc:(freq: 80);dl:(len: 7)), (fc:(freq: 48);dl:(len: 7)), (fc:(freq:112);dl:(len: 7)),\r
+(fc:(freq: 8);dl:(len: 7)), (fc:(freq: 72);dl:(len: 7)), (fc:(freq: 40);dl:(len: 7)),\r
+(fc:(freq:104);dl:(len: 7)), (fc:(freq: 24);dl:(len: 7)), (fc:(freq: 88);dl:(len: 7)),\r
+(fc:(freq: 56);dl:(len: 7)), (fc:(freq:120);dl:(len: 7)), (fc:(freq: 4);dl:(len: 7)),\r
+(fc:(freq: 68);dl:(len: 7)), (fc:(freq: 36);dl:(len: 7)), (fc:(freq:100);dl:(len: 7)),\r
+(fc:(freq: 20);dl:(len: 7)), (fc:(freq: 84);dl:(len: 7)), (fc:(freq: 52);dl:(len: 7)),\r
+(fc:(freq:116);dl:(len: 7)), (fc:(freq: 3);dl:(len: 8)), (fc:(freq:131);dl:(len: 8)),\r
+(fc:(freq: 67);dl:(len: 8)), (fc:(freq:195);dl:(len: 8)), (fc:(freq: 35);dl:(len: 8)),\r
+(fc:(freq:163);dl:(len: 8)), (fc:(freq: 99);dl:(len: 8)), (fc:(freq:227);dl:(len: 8))\r
+);\r
+\r
+\r
+{ The static distance tree. (Actually a trivial tree since all lens use\r
+ 5 bits.) }\r
+ static_dtree : array[0..D_CODES-1] of ct_data = (\r
+(fc:(freq: 0); dl:(len:5)), (fc:(freq:16); dl:(len:5)), (fc:(freq: 8); dl:(len:5)),\r
+(fc:(freq:24); dl:(len:5)), (fc:(freq: 4); dl:(len:5)), (fc:(freq:20); dl:(len:5)),\r
+(fc:(freq:12); dl:(len:5)), (fc:(freq:28); dl:(len:5)), (fc:(freq: 2); dl:(len:5)),\r
+(fc:(freq:18); dl:(len:5)), (fc:(freq:10); dl:(len:5)), (fc:(freq:26); dl:(len:5)),\r
+(fc:(freq: 6); dl:(len:5)), (fc:(freq:22); dl:(len:5)), (fc:(freq:14); dl:(len:5)),\r
+(fc:(freq:30); dl:(len:5)), (fc:(freq: 1); dl:(len:5)), (fc:(freq:17); dl:(len:5)),\r
+(fc:(freq: 9); dl:(len:5)), (fc:(freq:25); dl:(len:5)), (fc:(freq: 5); dl:(len:5)),\r
+(fc:(freq:21); dl:(len:5)), (fc:(freq:13); dl:(len:5)), (fc:(freq:29); dl:(len:5)),\r
+(fc:(freq: 3); dl:(len:5)), (fc:(freq:19); dl:(len:5)), (fc:(freq:11); dl:(len:5)),\r
+(fc:(freq:27); dl:(len:5)), (fc:(freq: 7); dl:(len:5)), (fc:(freq:23); dl:(len:5))\r
+);\r
+\r
+{ Distance codes. The first 256 values correspond to the distances\r
+ 3 .. 258, the last 256 values correspond to the top 8 bits of\r
+ the 15 bit distances. }\r
+ _dist_code : array[0..DIST_CODE_LEN-1] of uch = (\r
+ 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8,\r
+ 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10,\r
+10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,\r
+11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,\r
+12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13,\r
+13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,\r
+13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,\r
+14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,\r
+14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,\r
+14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,\r
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,\r
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,\r
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17,\r
+18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,\r
+23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,\r
+24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,\r
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,\r
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,\r
+27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,\r
+27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,\r
+28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,\r
+28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,\r
+28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,\r
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,\r
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,\r
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29\r
+);\r
+\r
+{ length code for each normalized match length (0 == MIN_MATCH) }\r
+ _length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of uch = (\r
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12,\r
+13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,\r
+17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,\r
+19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,\r
+21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,\r
+22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,\r
+23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,\r
+24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,\r
+25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,\r
+25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,\r
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,\r
+26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,\r
+27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28\r
+);\r
+\r
+ \r
+{ First normalized length for each code (0 = MIN_MATCH) }\r
+ base_length : array[0..LENGTH_CODES-1] of int = (\r
+0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,\r
+64, 80, 96, 112, 128, 160, 192, 224, 0\r
+);\r
+\r
+\r
+{ First normalized distance for each code (0 = distance of 1) }\r
+ base_dist : array[0..D_CODES-1] of int = (\r
+ 0, 1, 2, 3, 4, 6, 8, 12, 16, 24,\r
+ 32, 48, 64, 96, 128, 192, 256, 384, 512, 768,\r
+ 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576\r
+);\r
+{$endif}\r
+\r
+{ Output a byte on the stream.\r
+ IN assertion: there is enough room in pending_buf.\r
+macro put_byte(s, c)\r
+begin\r
+ s^.pending_buf^[s^.pending] := (c);\r
+ Inc(s^.pending);\r
+end\r
+}\r
+\r
+const\r
+ MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);\r
+{ Minimum amount of lookahead, except at the end of the input file.\r
+ See deflate.c for comments about the MIN_MATCH+1. }\r
+\r
+{macro d_code(dist)\r
+ if (dist) < 256 then\r
+ := _dist_code[dist]\r
+ else\r
+ := _dist_code[256+((dist) shr 7)]);\r
+ Mapping from a distance to a distance code. dist is the distance - 1 and\r
+ must not have side effects. _dist_code[256] and _dist_code[257] are never\r
+ used. }\r
+\r
+{$ifndef ORG_DEBUG}\r
+{ Inline versions of _tr_tally for speed: }\r
+\r
+#if defined(GEN_TREES_H) || !defined(STDC)\r
+ extern uch _length_code[];\r
+ extern uch _dist_code[];\r
+#else\r
+ extern const uch _length_code[];\r
+ extern const uch _dist_code[];\r
+#endif\r
+\r
+macro _tr_tally_lit(s, c, flush)\r
+var\r
+ cc : uch;\r
+begin\r
+ cc := (c);\r
+ s^.d_buf[s^.last_lit] := 0;\r
+ s^.l_buf[s^.last_lit] := cc;\r
+ Inc(s^.last_lit);\r
+ Inc(s^.dyn_ltree[cc].fc.Freq);\r
+ flush := (s^.last_lit = s^.lit_bufsize-1);\r
+end;\r
+\r
+macro _tr_tally_dist(s, distance, length, flush) \\r
+var\r
+ len : uch;\r
+ dist : ush;\r
+begin\r
+ len := (length);\r
+ dist := (distance);\r
+ s^.d_buf[s^.last_lit] := dist;\r
+ s^.l_buf[s^.last_lit] = len;\r
+ Inc(s^.last_lit);\r
+ Dec(dist);\r
+ Inc(s^.dyn_ltree[_length_code[len]+LITERALS+1].fc.Freq);\r
+ Inc(s^.dyn_dtree[d_code(dist)].Freq);\r
+ flush := (s^.last_lit = s^.lit_bufsize-1);\r
+end;\r
+\r
+{$endif}\r
+\r
+{ ===========================================================================\r
+ Constants }\r
+\r
+const\r
+ MAX_BL_BITS = 7;\r
+{ Bit length codes must not exceed MAX_BL_BITS bits }\r
+\r
+const\r
+ END_BLOCK = 256;\r
+{ end of block literal code }\r
+\r
+const\r
+ REP_3_6 = 16;\r
+{ repeat previous bit length 3-6 times (2 bits of repeat count) }\r
+\r
+const\r
+ REPZ_3_10 = 17;\r
+{ repeat a zero length 3-10 times (3 bits of repeat count) }\r
+\r
+const\r
+ REPZ_11_138 = 18;\r
+{ repeat a zero length 11-138 times (7 bits of repeat count) }\r
+\r
+{local}\r
+const\r
+ extra_lbits : array[0..LENGTH_CODES-1] of int\r
+ { extra bits for each length code }\r
+ = (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);\r
+\r
+{local}\r
+const\r
+ extra_dbits : array[0..D_CODES-1] of int\r
+ { extra bits for each distance code }\r
+ = (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);\r
+\r
+{local}\r
+const\r
+ extra_blbits : array[0..BL_CODES-1] of int { extra bits for each bit length code }\r
+ = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7);\r
+\r
+{local}\r
+const\r
+ bl_order : array[0..BL_CODES-1] of uch\r
+ = (16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15);\r
+{ The lengths of the bit length codes are sent in order of decreasing\r
+ probability, to avoid transmitting the lengths for unused bit length codes.\r
+ }\r
+\r
+const\r
+ Buf_size = (8 * 2*sizeof(char));\r
+{ Number of bits used within bi_buf. (bi_buf might be implemented on\r
+ more than 16 bits on some systems.) }\r
+\r
+{ ===========================================================================\r
+ Local data. These are initialized only once. }\r
+\r
+\r
+{$ifdef GEN_TREES_H)}\r
+{ non ANSI compilers may not accept trees.h }\r
+\r
+const\r
+ DIST_CODE_LEN = 512; { see definition of array dist_code below }\r
+\r
+{local}\r
+var\r
+ static_ltree : array[0..L_CODES+2-1] of ct_data;\r
+{ The static literal tree. Since the bit lengths are imposed, there is no\r
+ need for the L_CODES extra codes used during heap construction. However\r
+ The codes 286 and 287 are needed to build a canonical tree (see _tr_init\r
+ below). }\r
+\r
+{local}\r
+ static_dtree : array[0..D_CODES-1] of ct_data;\r
+{ The static distance tree. (Actually a trivial tree since all codes use\r
+ 5 bits.) }\r
+\r
+ _dist_code : array[0..DIST_CODE_LEN-1] of uch;\r
+{ Distance codes. The first 256 values correspond to the distances\r
+ 3 .. 258, the last 256 values correspond to the top 8 bits of\r
+ the 15 bit distances. }\r
+\r
+ _length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of uch;\r
+{ length code for each normalized match length (0 == MIN_MATCH) }\r
+\r
+{local}\r
+ base_length : array[0..LENGTH_CODES-1] of int;\r
+{ First normalized length for each code (0 = MIN_MATCH) }\r
+\r
+{local}\r
+ base_dist : array[0..D_CODES-1] of int;\r
+{ First normalized distance for each code (0 = distance of 1) }\r
+\r
+{$endif} { GEN_TREES_H }\r
+\r
+{local}\r
+const\r
+ static_l_desc : static_tree_desc =\r
+ (static_tree: {tree_ptr}(@(static_ltree)); { pointer to array of ct_data }\r
+ extra_bits: {pzIntfArray}(@(extra_lbits)); { pointer to array of int }\r
+ extra_base: LITERALS+1;\r
+ elems: L_CODES;\r
+ max_length: MAX_BITS);\r
+\r
+{local}\r
+const\r
+ static_d_desc : static_tree_desc =\r
+ (static_tree: {tree_ptr}(@(static_dtree));\r
+ extra_bits: {pzIntfArray}(@(extra_dbits));\r
+ extra_base : 0;\r
+ elems: D_CODES;\r
+ max_length: MAX_BITS);\r
+\r
+{local}\r
+const\r
+ static_bl_desc : static_tree_desc =\r
+ (static_tree: {tree_ptr}(NIL);\r
+ extra_bits: {pzIntfArray}@(extra_blbits);\r
+ extra_base : 0;\r
+ elems: BL_CODES;\r
+ max_length: MAX_BL_BITS);\r
+\r
+(* ===========================================================================\r
+ Local (static) routines in this file. }\r
+\r
+procedure tr_static_init;\r
+procedure init_block(var deflate_state);\r
+procedure pqdownheap(var s : deflate_state;\r
+ var tree : ct_data;\r
+ k : int);\r
+procedure gen_bitlen(var s : deflate_state;\r
+ var desc : tree_desc);\r
+procedure gen_codes(var tree : ct_data;\r
+ max_code : int;\r
+ bl_count : pushf);\r
+procedure build_tree(var s : deflate_state;\r
+ var desc : tree_desc);\r
+procedure scan_tree(var s : deflate_state;\r
+ var tree : ct_data;\r
+ max_code : int);\r
+procedure send_tree(var s : deflate_state;\r
+ var tree : ct_data;\r
+ max_code : int);\r
+function build_bl_tree(var deflate_state) : int;\r
+procedure send_all_trees(var deflate_state;\r
+ lcodes : int;\r
+ dcodes : int;\r
+ blcodes : int);\r
+procedure compress_block(var s : deflate_state;\r
+ var ltree : ct_data;\r
+ var dtree : ct_data);\r
+procedure set_data_type(var s : deflate_state);\r
+function bi_reverse(value : unsigned;\r
+ length : int) : unsigned;\r
+procedure bi_windup(var deflate_state);\r
+procedure bi_flush(var deflate_state);\r
+procedure copy_block(var deflate_state;\r
+ buf : pcharf;\r
+ len : unsigned;\r
+ header : int);\r
+*)\r
+\r
+{$ifdef GEN_TREES_H}\r
+{local}\r
+procedure gen_trees_header;\r
+{$endif}\r
+\r
+(*\r
+{ ===========================================================================\r
+ Output a short LSB first on the stream.\r
+ IN assertion: there is enough room in pendingBuf. }\r
+\r
+macro put_short(s, w)\r
+begin\r
+ {put_byte(s, (uch)((w) & 0xff));}\r
+ s.pending_buf^[s.pending] := uch((w) and $ff);\r
+ Inc(s.pending);\r
+\r
+ {put_byte(s, (uch)((ush)(w) >> 8));}\r
+ s.pending_buf^[s.pending] := uch(ush(w) shr 8);;\r
+ Inc(s.pending);\r
+end\r
+*)\r
+\r
+{ ===========================================================================\r
+ Send a value on a given number of bits.\r
+ IN assertion: length <= 16 and value fits in length bits. }\r
+\r
+{$ifdef ORG_DEBUG}\r
+\r
+{local}\r
+procedure send_bits(var s : deflate_state;\r
+ value : int; { value to send }\r
+ length : int); { number of bits }\r
+begin\r
+ {$ifdef DEBUG}\r
+ Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value));\r
+ Assert((length > 0) and (length <= 15), 'invalid length');\r
+ Inc(s.bits_sent, ulg(length));\r
+ {$ENDIF}\r
+\r
+ { If not enough room in bi_buf, use (valid) bits from bi_buf and\r
+ (16 - bi_valid) bits from value, leaving (width - (16-bi_valid))\r
+ unused bits in value. }\r
+ {$IFOPT Q+} {$Q-} {$DEFINE NoOverflowCheck} {$ENDIF}\r
+ {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}\r
+ if (s.bi_valid > int(Buf_size) - length) then\r
+ begin\r
+ s.bi_buf := s.bi_buf or int(value shl s.bi_valid);\r
+ {put_short(s, s.bi_buf);}\r
+ s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);\r
+ Inc(s.pending);\r
+ s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;\r
+ Inc(s.pending);\r
+\r
+ s.bi_buf := ush(value) shr (Buf_size - s.bi_valid);\r
+ Inc(s.bi_valid, length - Buf_size);\r
+ end\r
+ else\r
+ begin\r
+ s.bi_buf := s.bi_buf or int(value shl s.bi_valid);\r
+ Inc(s.bi_valid, length);\r
+ end;\r
+ {$IFDEF NoOverflowCheck} {$Q+} {$UNDEF NoOverflowCheck} {$ENDIF}\r
+ {$IFDEF NoRangeCheck} {$Q+} {$UNDEF NoRangeCheck} {$ENDIF}\r
+end;\r
+\r
+{$else} { !DEBUG }\r
+\r
+\r
+macro send_code(s, c, tree)\r
+begin\r
+ send_bits(s, tree[c].Code, tree[c].Len);\r
+ { Send a code of the given tree. c and tree must not have side effects }\r
+end\r
+\r
+macro send_bits(s, value, length) \\r
+begin int len := length;\\r
+ if (s^.bi_valid > (int)Buf_size - len) begin\\r
+ int val := value;\\r
+ s^.bi_buf |= (val << s^.bi_valid);\\r
+ {put_short(s, s.bi_buf);}\r
+ s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);\r
+ Inc(s.pending);\r
+ s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;\r
+ Inc(s.pending);\r
+\r
+ s^.bi_buf := (ush)val >> (Buf_size - s^.bi_valid);\\r
+ s^.bi_valid += len - Buf_size;\\r
+ end else begin\\r
+ s^.bi_buf |= (value) << s^.bi_valid;\\r
+ s^.bi_valid += len;\\r
+ end\\r
+end;\r
+{$endif} { DEBUG }\r
+\r
+{ ===========================================================================\r
+ Reverse the first len bits of a code, using straightforward code (a faster\r
+ method would use a table)\r
+ IN assertion: 1 <= len <= 15 }\r
+\r
+{local}\r
+function bi_reverse(code : unsigned; { the value to invert }\r
+ len : int) : unsigned; { its bit length }\r
+\r
+var\r
+ res : unsigned; {register}\r
+begin\r
+ res := 0;\r
+ repeat\r
+ res := res or (code and 1);\r
+ code := code shr 1;\r
+ res := res shl 1;\r
+ Dec(len);\r
+ until (len <= 0);\r
+ bi_reverse := res shr 1;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Generate the codes for a given tree and bit counts (which need not be\r
+ optimal).\r
+ IN assertion: the array bl_count contains the bit length statistics for\r
+ the given tree and the field len is set for all tree elements.\r
+ OUT assertion: the field code is set for all tree elements of non\r
+ zero code length. }\r
+\r
+{local}\r
+procedure gen_codes(tree : tree_ptr; { the tree to decorate }\r
+ max_code : int; { largest code with non zero frequency }\r
+ var bl_count : array of ushf); { number of codes at each bit length }\r
+\r
+var\r
+ next_code : array[0..MAX_BITS+1-1] of ush; { next code value for each bit length }\r
+ code : ush; { running code value }\r
+ bits : int; { bit index }\r
+ n : int; { code index }\r
+var\r
+ len : int;\r
+begin\r
+ code := 0;\r
+\r
+ { The distribution counts are first used to generate the code values\r
+ without bit reversal. }\r
+\r
+ for bits := 1 to MAX_BITS do\r
+ begin\r
+ code := ((code + bl_count[bits-1]) shl 1);\r
+ next_code[bits] := code;\r
+ end;\r
+ { Check that the bit counts in bl_count are consistent. The last code\r
+ must be all ones. }\r
+\r
+ {$IFDEF DEBUG}\r
+ Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1,\r
+ 'inconsistent bit counts');\r
+ Tracev(#13'gen_codes: max_code '+IntToStr(max_code));\r
+ {$ENDIF}\r
+\r
+ for n := 0 to max_code do\r
+ begin\r
+ len := tree^[n].dl.Len;\r
+ if (len = 0) then\r
+ continue;\r
+ { Now reverse the bits }\r
+ tree^[n].fc.Code := bi_reverse(next_code[len], len);\r
+ Inc(next_code[len]);\r
+ {$ifdef DEBUG}\r
+ if (n>31) and (n<128) then\r
+ Tracecv(tree <> tree_ptr(@static_ltree),\r
+ (^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+\r
+ IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))\r
+ else\r
+ Tracecv(tree <> tree_ptr(@static_ltree),\r
+ (^M'n #'+IntToStr(n)+' l '+IntToStr(len)+' c '+\r
+ IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'));\r
+ {$ENDIF}\r
+ end;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Genererate the file trees.h describing the static trees. }\r
+{$ifdef GEN_TREES_H}\r
+\r
+macro SEPARATOR(i, last, width)\r
+ if (i) = (last) then\r
+ ( ^M');'^M^M\r
+ else \\r
+ if (i) mod (width) = (width)-1 then\r
+ ','^M\r
+ else\r
+ ', '\r
+\r
+procedure gen_trees_header;\r
+var\r
+ header : system.text;\r
+ i : int;\r
+begin\r
+ system.assign(header, 'trees.inc');\r
+ {$I-}\r
+ ReWrite(header);\r
+ {$I+}\r
+ Assert (IOresult <> 0, 'Can''t open trees.h');\r
+ WriteLn(header,\r
+ '{ header created automatically with -DGEN_TREES_H }'^M);\r
+\r
+ WriteLn(header, 'local const ct_data static_ltree[L_CODES+2] := (');\r
+ for i := 0 to L_CODES+2-1 do\r
+ begin\r
+ WriteLn(header, '((%3u),(%3u))%s', static_ltree[i].Code,\r
+ static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));\r
+ end;\r
+\r
+ WriteLn(header, 'local const ct_data static_dtree[D_CODES] := (');\r
+ for i := 0 to D_CODES-1 do\r
+ begin\r
+ WriteLn(header, '((%2u),(%2u))%s', static_dtree[i].Code,\r
+ static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));\r
+ end;\r
+\r
+ WriteLn(header, 'const uch _dist_code[DIST_CODE_LEN] := (');\r
+ for i := 0 to DIST_CODE_LEN-1 do\r
+ begin\r
+ WriteLn(header, '%2u%s', _dist_code[i],\r
+ SEPARATOR(i, DIST_CODE_LEN-1, 20));\r
+ end;\r
+\r
+ WriteLn(header, 'const uch _length_code[MAX_MATCH-MIN_MATCH+1]= (');\r
+ for i := 0 to MAX_MATCH-MIN_MATCH+1-1 do\r
+ begin\r
+ WriteLn(header, '%2u%s', _length_code[i],\r
+ SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));\r
+ end;\r
+\r
+ WriteLn(header, 'local const int base_length[LENGTH_CODES] := (');\r
+ for i := 0 to LENGTH_CODES-1 do\r
+ begin\r
+ WriteLn(header, '%1u%s', base_length[i],\r
+ SEPARATOR(i, LENGTH_CODES-1, 20));\r
+ end;\r
+\r
+ WriteLn(header, 'local const int base_dist[D_CODES] := (');\r
+ for i := 0 to D_CODES-1 do\r
+ begin\r
+ WriteLn(header, '%5u%s', base_dist[i],\r
+ SEPARATOR(i, D_CODES-1, 10));\r
+ end;\r
+\r
+ close(header);\r
+end;\r
+{$endif} { GEN_TREES_H }\r
+\r
+\r
+{ ===========================================================================\r
+ Initialize the various 'constant' tables. }\r
+\r
+{local}\r
+procedure tr_static_init;\r
+\r
+{$ifdef GEN_TREES_H}\r
+const\r
+ static_init_done : boolean = FALSE;\r
+var\r
+ n : int; { iterates over tree elements }\r
+ bits : int; { bit counter }\r
+ length : int; { length value }\r
+ code : int; { code value }\r
+ dist : int; { distance index }\r
+ bl_count : array[0..MAX_BITS+1-1] of ush;\r
+ { number of codes at each bit length for an optimal tree }\r
+begin\r
+ if (static_init_done) then\r
+ exit;\r
+\r
+ { Initialize the mapping length (0..255) -> length code (0..28) }\r
+ length := 0;\r
+ for code := 0 to LENGTH_CODES-1-1 do\r
+ begin\r
+ base_length[code] := length;\r
+ for n := 0 to (1 shl extra_lbits[code])-1 do\r
+ begin\r
+ _length_code[length] := uch(code);\r
+ Inc(length);\r
+ end;\r
+ end;\r
+ Assert (length = 256, 'tr_static_init: length <> 256');\r
+ { Note that the length 255 (match length 258) can be represented\r
+ in two different ways: code 284 + 5 bits or code 285, so we\r
+ overwrite length_code[255] to use the best encoding: }\r
+\r
+ _length_code[length-1] := uch(code);\r
+\r
+ { Initialize the mapping dist (0..32K) -> dist code (0..29) }\r
+ dist := 0;\r
+ for code := 0 to 16-1 do\r
+ begin\r
+ base_dist[code] := dist;\r
+ for n := 0 to (1 shl extra_dbits[code])-1 do\r
+ begin\r
+ _dist_code[dist] := uch(code);\r
+ Inc(dist);\r
+ end;\r
+ end;\r
+ Assert (dist = 256, 'tr_static_init: dist <> 256');\r
+ dist := dist shr 7; { from now on, all distances are divided by 128 }\r
+ for code := 16 to D_CODES-1 do\r
+ begin\r
+ base_dist[code] := dist shl 7;\r
+ for n := 0 to (1 shl (extra_dbits[code]-7))-1 do\r
+ begin\r
+ _dist_code[256 + dist] := uch(code);\r
+ Inc(dist);\r
+ end;\r
+ end;\r
+ Assert (dist = 256, 'tr_static_init: 256+dist <> 512');\r
+\r
+ { Construct the codes of the static literal tree }\r
+ for bits := 0 to MAX_BITS do\r
+ bl_count[bits] := 0;\r
+ n := 0;\r
+ while (n <= 143) do\r
+ begin\r
+ static_ltree[n].dl.Len := 8;\r
+ Inc(n);\r
+ Inc(bl_count[8]);\r
+ end;\r
+ while (n <= 255) do\r
+ begin\r
+ static_ltree[n].dl.Len := 9;\r
+ Inc(n);\r
+ Inc(bl_count[9]);\r
+ end;\r
+ while (n <= 279) do\r
+ begin\r
+ static_ltree[n].dl.Len := 7;\r
+ Inc(n);\r
+ Inc(bl_count[7]);\r
+ end;\r
+ while (n <= 287) do\r
+ begin\r
+ static_ltree[n].dl.Len := 8;\r
+ Inc(n);\r
+ Inc(bl_count[8]);\r
+ end;\r
+\r
+ { Codes 286 and 287 do not exist, but we must include them in the\r
+ tree construction to get a canonical Huffman tree (longest code\r
+ all ones) }\r
+\r
+ gen_codes(tree_ptr(@static_ltree), L_CODES+1, bl_count);\r
+\r
+ { The static distance tree is trivial: }\r
+ for n := 0 to D_CODES-1 do\r
+ begin\r
+ static_dtree[n].dl.Len := 5;\r
+ static_dtree[n].fc.Code := bi_reverse(unsigned(n), 5);\r
+ end;\r
+ static_init_done := TRUE;\r
+\r
+ gen_trees_header; { save to include file }\r
+{$else}\r
+begin\r
+{$endif} { GEN_TREES_H) }\r
+end;\r
+\r
+{ ===========================================================================\r
+ Initialize a new block. }\r
+{local}\r
+\r
+procedure init_block(var s : deflate_state);\r
+var\r
+ n : int; { iterates over tree elements }\r
+begin\r
+ { Initialize the trees. }\r
+ for n := 0 to L_CODES-1 do\r
+ s.dyn_ltree[n].fc.Freq := 0;\r
+ for n := 0 to D_CODES-1 do\r
+ s.dyn_dtree[n].fc.Freq := 0;\r
+ for n := 0 to BL_CODES-1 do\r
+ s.bl_tree[n].fc.Freq := 0;\r
+\r
+ s.dyn_ltree[END_BLOCK].fc.Freq := 1;\r
+ s.static_len := Long(0);\r
+ s.opt_len := Long(0);\r
+ s.matches := 0;\r
+ s.last_lit := 0;\r
+end;\r
+\r
+const\r
+ SMALLEST = 1;\r
+{ Index within the heap array of least frequent node in the Huffman tree }\r
+\r
+{ ===========================================================================\r
+ Initialize the tree data structures for a new zlib stream. }\r
+procedure _tr_init(var s : deflate_state);\r
+begin\r
+ tr_static_init;\r
+\r
+ s.compressed_len := Long(0);\r
+\r
+ s.l_desc.dyn_tree := tree_ptr(@s.dyn_ltree);\r
+ s.l_desc.stat_desc := @static_l_desc;\r
+\r
+ s.d_desc.dyn_tree := tree_ptr(@s.dyn_dtree);\r
+ s.d_desc.stat_desc := @static_d_desc;\r
+\r
+ s.bl_desc.dyn_tree := tree_ptr(@s.bl_tree);\r
+ s.bl_desc.stat_desc := @static_bl_desc;\r
+\r
+ s.bi_buf := 0;\r
+ s.bi_valid := 0;\r
+ s.last_eob_len := 8; { enough lookahead for inflate }\r
+{$ifdef DEBUG}\r
+ s.bits_sent := Long(0);\r
+{$endif}\r
+\r
+ { Initialize the first block of the first file: }\r
+ init_block(s);\r
+end;\r
+\r
+{ ===========================================================================\r
+ Remove the smallest element from the heap and recreate the heap with\r
+ one less element. Updates heap and heap_len.\r
+\r
+macro pqremove(s, tree, top)\r
+begin\r
+ top := s.heap[SMALLEST];\r
+ s.heap[SMALLEST] := s.heap[s.heap_len];\r
+ Dec(s.heap_len);\r
+ pqdownheap(s, tree, SMALLEST);\r
+end\r
+}\r
+\r
+{ ===========================================================================\r
+ Compares to subtrees, using the tree depth as tie breaker when\r
+ the subtrees have equal frequency. This minimizes the worst case length.\r
+\r
+macro smaller(tree, n, m, depth)\r
+ ( (tree[n].Freq < tree[m].Freq) or\r
+ ((tree[n].Freq = tree[m].Freq) and (depth[n] <= depth[m])) )\r
+}\r
+\r
+{ ===========================================================================\r
+ Restore the heap property by moving down the tree starting at node k,\r
+ exchanging a node with the smallest of its two sons if necessary, stopping\r
+ when the heap property is re-established (each father smaller than its\r
+ two sons). }\r
+{local}\r
+\r
+procedure pqdownheap(var s : deflate_state;\r
+ var tree : tree_type; { the tree to restore }\r
+ k : int); { node to move down }\r
+var\r
+ v : int;\r
+ j : int;\r
+begin\r
+ v := s.heap[k];\r
+ j := k shl 1; { left son of k }\r
+ while (j <= s.heap_len) do\r
+ begin\r
+ { Set j to the smallest of the two sons: }\r
+ if (j < s.heap_len) and\r
+ {smaller(tree, s.heap[j+1], s.heap[j], s.depth)}\r
+ ( (tree[s.heap[j+1]].fc.Freq < tree[s.heap[j]].fc.Freq) or\r
+ ((tree[s.heap[j+1]].fc.Freq = tree[s.heap[j]].fc.Freq) and\r
+ (s.depth[s.heap[j+1]] <= s.depth[s.heap[j]])) ) then\r
+ begin\r
+ Inc(j);\r
+ end;\r
+ { Exit if v is smaller than both sons }\r
+ if {(smaller(tree, v, s.heap[j], s.depth))}\r
+ ( (tree[v].fc.Freq < tree[s.heap[j]].fc.Freq) or\r
+ ((tree[v].fc.Freq = tree[s.heap[j]].fc.Freq) and\r
+ (s.depth[v] <= s.depth[s.heap[j]])) ) then\r
+ break;\r
+ { Exchange v with the smallest son }\r
+ s.heap[k] := s.heap[j];\r
+ k := j;\r
+\r
+ { And continue down the tree, setting j to the left son of k }\r
+ j := j shl 1;\r
+ end;\r
+ s.heap[k] := v;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Compute the optimal bit lengths for a tree and update the total bit length\r
+ for the current block.\r
+ IN assertion: the fields freq and dad are set, heap[heap_max] and\r
+ above are the tree nodes sorted by increasing frequency.\r
+ OUT assertions: the field len is set to the optimal bit length, the\r
+ array bl_count contains the frequencies for each bit length.\r
+ The length opt_len is updated; static_len is also updated if stree is\r
+ not null. }\r
+\r
+{local}\r
+procedure gen_bitlen(var s : deflate_state;\r
+ var desc : tree_desc); { the tree descriptor }\r
+var\r
+ tree : tree_ptr;\r
+ max_code : int;\r
+ stree : tree_ptr; {const}\r
+ extra : pzIntfArray; {const}\r
+ base : int;\r
+ max_length : int;\r
+ h : int; { heap index }\r
+ n, m : int; { iterate over the tree elements }\r
+ bits : int; { bit length }\r
+ xbits : int; { extra bits }\r
+ f : ush; { frequency }\r
+ overflow : int; { number of elements with bit length too large }\r
+begin\r
+ tree := desc.dyn_tree;\r
+ max_code := desc.max_code;\r
+ stree := desc.stat_desc^.static_tree;\r
+ extra := desc.stat_desc^.extra_bits;\r
+ base := desc.stat_desc^.extra_base;\r
+ max_length := desc.stat_desc^.max_length;\r
+ overflow := 0;\r
+\r
+ for bits := 0 to MAX_BITS do\r
+ s.bl_count[bits] := 0;\r
+\r
+ { In a first pass, compute the optimal bit lengths (which may\r
+ overflow in the case of the bit length tree). }\r
+\r
+ tree^[s.heap[s.heap_max]].dl.Len := 0; { root of the heap }\r
+\r
+ for h := s.heap_max+1 to HEAP_SIZE-1 do\r
+ begin\r
+ n := s.heap[h];\r
+ bits := tree^[tree^[n].dl.Dad].dl.Len + 1;\r
+ if (bits > max_length) then\r
+ begin\r
+ bits := max_length;\r
+ Inc(overflow);\r
+ end;\r
+ tree^[n].dl.Len := ush(bits);\r
+ { We overwrite tree[n].dl.Dad which is no longer needed }\r
+\r
+ if (n > max_code) then\r
+ continue; { not a leaf node }\r
+\r
+ Inc(s.bl_count[bits]);\r
+ xbits := 0;\r
+ if (n >= base) then\r
+ xbits := extra^[n-base];\r
+ f := tree^[n].fc.Freq;\r
+ Inc(s.opt_len, ulg(f) * (bits + xbits));\r
+ if (stree <> NIL) then\r
+ Inc(s.static_len, ulg(f) * (stree^[n].dl.Len + xbits));\r
+ end;\r
+ if (overflow = 0) then\r
+ exit;\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'bit length overflow');\r
+ {$endif}\r
+ { This happens for example on obj2 and pic of the Calgary corpus }\r
+\r
+ { Find the first bit length which could increase: }\r
+ repeat\r
+ bits := max_length-1;\r
+ while (s.bl_count[bits] = 0) do\r
+ Dec(bits);\r
+ Dec(s.bl_count[bits]); { move one leaf down the tree }\r
+ Inc(s.bl_count[bits+1], 2); { move one overflow item as its brother }\r
+ Dec(s.bl_count[max_length]);\r
+ { The brother of the overflow item also moves one step up,\r
+ but this does not affect bl_count[max_length] }\r
+\r
+ Dec(overflow, 2);\r
+ until (overflow <= 0);\r
+\r
+ { Now recompute all bit lengths, scanning in increasing frequency.\r
+ h is still equal to HEAP_SIZE. (It is simpler to reconstruct all\r
+ lengths instead of fixing only the wrong ones. This idea is taken\r
+ from 'ar' written by Haruhiko Okumura.) }\r
+ h := HEAP_SIZE; { Delphi3: compiler warning w/o this }\r
+ for bits := max_length downto 1 do\r
+ begin\r
+ n := s.bl_count[bits];\r
+ while (n <> 0) do\r
+ begin\r
+ Dec(h);\r
+ m := s.heap[h];\r
+ if (m > max_code) then\r
+ continue;\r
+ if (tree^[m].dl.Len <> unsigned(bits)) then\r
+ begin\r
+ {$ifdef DEBUG}\r
+ Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)\r
+ +'.'+IntToStr(bits));\r
+ {$ENDIF}\r
+ Inc(s.opt_len, (long(bits) - long(tree^[m].dl.Len))\r
+ * long(tree^[m].fc.Freq) );\r
+ tree^[m].dl.Len := ush(bits);\r
+ end;\r
+ Dec(n);\r
+ end;\r
+ end;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Construct one Huffman tree and assigns the code bit strings and lengths.\r
+ Update the total bit length for the current block.\r
+ IN assertion: the field freq is set for all tree elements.\r
+ OUT assertions: the fields len and code are set to the optimal bit length\r
+ and corresponding code. The length opt_len is updated; static_len is\r
+ also updated if stree is not null. The field max_code is set. }\r
+\r
+{local}\r
+procedure build_tree(var s : deflate_state;\r
+ var desc : tree_desc); { the tree descriptor }\r
+\r
+var\r
+ tree : tree_ptr;\r
+ stree : tree_ptr; {const}\r
+ elems : int;\r
+ n, m : int; { iterate over heap elements }\r
+ max_code : int; { largest code with non zero frequency }\r
+ node : int; { new node being created }\r
+begin\r
+ tree := desc.dyn_tree;\r
+ stree := desc.stat_desc^.static_tree;\r
+ elems := desc.stat_desc^.elems;\r
+ max_code := -1;\r
+\r
+ { Construct the initial heap, with least frequent element in\r
+ heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1].\r
+ heap[0] is not used. }\r
+ s.heap_len := 0;\r
+ s.heap_max := HEAP_SIZE;\r
+\r
+ for n := 0 to elems-1 do\r
+ begin\r
+ if (tree^[n].fc.Freq <> 0) then\r
+ begin\r
+ max_code := n;\r
+ Inc(s.heap_len);\r
+ s.heap[s.heap_len] := n;\r
+ s.depth[n] := 0;\r
+ end\r
+ else\r
+ begin\r
+ tree^[n].dl.Len := 0;\r
+ end;\r
+ end;\r
+\r
+ { The pkzip format requires that at least one distance code exists,\r
+ and that at least one bit should be sent even if there is only one\r
+ possible code. So to avoid special checks later on we force at least\r
+ two codes of non zero frequency. }\r
+\r
+ while (s.heap_len < 2) do\r
+ begin\r
+ Inc(s.heap_len);\r
+ if (max_code < 2) then\r
+ begin\r
+ Inc(max_code);\r
+ s.heap[s.heap_len] := max_code;\r
+ node := max_code;\r
+ end\r
+ else\r
+ begin\r
+ s.heap[s.heap_len] := 0;\r
+ node := 0;\r
+ end;\r
+ tree^[node].fc.Freq := 1;\r
+ s.depth[node] := 0;\r
+ Dec(s.opt_len);\r
+ if (stree <> NIL) then\r
+ Dec(s.static_len, stree^[node].dl.Len);\r
+ { node is 0 or 1 so it does not have extra bits }\r
+ end;\r
+ desc.max_code := max_code;\r
+\r
+ { The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,\r
+ establish sub-heaps of increasing lengths: }\r
+\r
+ for n := s.heap_len div 2 downto 1 do\r
+ pqdownheap(s, tree^, n);\r
+\r
+ { Construct the Huffman tree by repeatedly combining the least two\r
+ frequent nodes. }\r
+\r
+ node := elems; { next internal node of the tree }\r
+ repeat\r
+ {pqremove(s, tree, n);} { n := node of least frequency }\r
+ n := s.heap[SMALLEST];\r
+ s.heap[SMALLEST] := s.heap[s.heap_len];\r
+ Dec(s.heap_len);\r
+ pqdownheap(s, tree^, SMALLEST);\r
+\r
+ m := s.heap[SMALLEST]; { m := node of next least frequency }\r
+\r
+ Dec(s.heap_max);\r
+ s.heap[s.heap_max] := n; { keep the nodes sorted by frequency }\r
+ Dec(s.heap_max);\r
+ s.heap[s.heap_max] := m;\r
+\r
+ { Create a new node father of n and m }\r
+ tree^[node].fc.Freq := tree^[n].fc.Freq + tree^[m].fc.Freq;\r
+ { maximum }\r
+ if (s.depth[n] >= s.depth[m]) then\r
+ s.depth[node] := uch (s.depth[n] + 1)\r
+ else\r
+ s.depth[node] := uch (s.depth[m] + 1);\r
+\r
+ tree^[m].dl.Dad := ush(node);\r
+ tree^[n].dl.Dad := ush(node);\r
+{$ifdef DUMP_BL_TREE}\r
+ if (tree = tree_ptr(@s.bl_tree)) then\r
+ begin\r
+ WriteLn(#13'node ',node,'(',tree^[node].fc.Freq,') sons ',n,\r
+ '(',tree^[n].fc.Freq,') ', m, '(',tree^[m].fc.Freq,')');\r
+ end;\r
+{$endif}\r
+ { and insert the new node in the heap }\r
+ s.heap[SMALLEST] := node;\r
+ Inc(node);\r
+ pqdownheap(s, tree^, SMALLEST);\r
+\r
+ until (s.heap_len < 2);\r
+\r
+ Dec(s.heap_max);\r
+ s.heap[s.heap_max] := s.heap[SMALLEST];\r
+\r
+ { At this point, the fields freq and dad are set. We can now\r
+ generate the bit lengths. }\r
+\r
+ gen_bitlen(s, desc);\r
+\r
+ { The field len is now set, we can generate the bit codes }\r
+ gen_codes (tree, max_code, s.bl_count);\r
+end;\r
+\r
+{ ===========================================================================\r
+ Scan a literal or distance tree to determine the frequencies of the codes\r
+ in the bit length tree. }\r
+\r
+{local}\r
+procedure scan_tree(var s : deflate_state;\r
+ var tree : array of ct_data; { the tree to be scanned }\r
+ max_code : int); { and its largest code of non zero frequency }\r
+var\r
+ n : int; { iterates over all tree elements }\r
+ prevlen : int; { last emitted length }\r
+ curlen : int; { length of current code }\r
+ nextlen : int; { length of next code }\r
+ count : int; { repeat count of the current code }\r
+ max_count : int; { max repeat count }\r
+ min_count : int; { min repeat count }\r
+begin\r
+ prevlen := -1;\r
+ nextlen := tree[0].dl.Len;\r
+ count := 0;\r
+ max_count := 7;\r
+ min_count := 4;\r
+\r
+ if (nextlen = 0) then\r
+ begin\r
+ max_count := 138;\r
+ min_count := 3;\r
+ end;\r
+ tree[max_code+1].dl.Len := ush($ffff); { guard }\r
+\r
+ for n := 0 to max_code do\r
+ begin\r
+ curlen := nextlen;\r
+ nextlen := tree[n+1].dl.Len;\r
+ Inc(count);\r
+ if (count < max_count) and (curlen = nextlen) then\r
+ continue\r
+ else\r
+ if (count < min_count) then\r
+ Inc(s.bl_tree[curlen].fc.Freq, count)\r
+ else\r
+ if (curlen <> 0) then\r
+ begin\r
+ if (curlen <> prevlen) then\r
+ Inc(s.bl_tree[curlen].fc.Freq);\r
+ Inc(s.bl_tree[REP_3_6].fc.Freq);\r
+ end\r
+ else\r
+ if (count <= 10) then\r
+ Inc(s.bl_tree[REPZ_3_10].fc.Freq)\r
+ else\r
+ Inc(s.bl_tree[REPZ_11_138].fc.Freq);\r
+\r
+ count := 0;\r
+ prevlen := curlen;\r
+ if (nextlen = 0) then\r
+ begin\r
+ max_count := 138;\r
+ min_count := 3;\r
+ end\r
+ else\r
+ if (curlen = nextlen) then\r
+ begin\r
+ max_count := 6;\r
+ min_count := 3;\r
+ end\r
+ else\r
+ begin\r
+ max_count := 7;\r
+ min_count := 4;\r
+ end;\r
+ end;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Send a literal or distance tree in compressed form, using the codes in\r
+ bl_tree. }\r
+\r
+{local}\r
+procedure send_tree(var s : deflate_state;\r
+ var tree : array of ct_data; { the tree to be scanned }\r
+ max_code : int); { and its largest code of non zero frequency }\r
+\r
+var\r
+ n : int; { iterates over all tree elements }\r
+ prevlen : int; { last emitted length }\r
+ curlen : int; { length of current code }\r
+ nextlen : int; { length of next code }\r
+ count : int; { repeat count of the current code }\r
+ max_count : int; { max repeat count }\r
+ min_count : int; { min repeat count }\r
+begin\r
+ prevlen := -1;\r
+ nextlen := tree[0].dl.Len;\r
+ count := 0;\r
+ max_count := 7;\r
+ min_count := 4;\r
+\r
+ { tree[max_code+1].dl.Len := -1; } { guard already set }\r
+ if (nextlen = 0) then\r
+ begin\r
+ max_count := 138;\r
+ min_count := 3;\r
+ end;\r
+\r
+ for n := 0 to max_code do\r
+ begin\r
+ curlen := nextlen;\r
+ nextlen := tree[n+1].dl.Len;\r
+ Inc(count);\r
+ if (count < max_count) and (curlen = nextlen) then\r
+ continue\r
+ else\r
+ if (count < min_count) then\r
+ begin\r
+ repeat\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(curlen));\r
+ {$ENDIF}\r
+ send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);\r
+ Dec(count);\r
+ until (count = 0);\r
+ end\r
+ else\r
+ if (curlen <> 0) then\r
+ begin\r
+ if (curlen <> prevlen) then\r
+ begin\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(curlen));\r
+ {$ENDIF}\r
+ send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);\r
+ Dec(count);\r
+ end;\r
+ {$IFDEF DEBUG}\r
+ Assert((count >= 3) and (count <= 6), ' 3_6?');\r
+ {$ENDIF}\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(REP_3_6));\r
+ {$ENDIF}\r
+ send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len);\r
+ send_bits(s, count-3, 2);\r
+ end\r
+ else\r
+ if (count <= 10) then\r
+ begin\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(REPZ_3_10));\r
+ {$ENDIF}\r
+ send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len);\r
+ send_bits(s, count-3, 3);\r
+ end\r
+ else\r
+ begin\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(REPZ_11_138));\r
+ {$ENDIF}\r
+ send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len);\r
+ send_bits(s, count-11, 7);\r
+ end;\r
+ count := 0;\r
+ prevlen := curlen;\r
+ if (nextlen = 0) then\r
+ begin\r
+ max_count := 138;\r
+ min_count := 3;\r
+ end\r
+ else\r
+ if (curlen = nextlen) then\r
+ begin\r
+ max_count := 6;\r
+ min_count := 3;\r
+ end\r
+ else\r
+ begin\r
+ max_count := 7;\r
+ min_count := 4;\r
+ end;\r
+ end;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Construct the Huffman tree for the bit lengths and return the index in\r
+ bl_order of the last bit length code to send. }\r
+\r
+{local}\r
+function build_bl_tree(var s : deflate_state) : int;\r
+var\r
+ max_blindex : int; { index of last bit length code of non zero freq }\r
+begin\r
+ { Determine the bit length frequencies for literal and distance trees }\r
+ scan_tree(s, s.dyn_ltree, s.l_desc.max_code);\r
+ scan_tree(s, s.dyn_dtree, s.d_desc.max_code);\r
+\r
+ { Build the bit length tree: }\r
+ build_tree(s, s.bl_desc);\r
+ { opt_len now includes the length of the tree representations, except\r
+ the lengths of the bit lengths codes and the 5+5+4 bits for the counts. }\r
+\r
+ { Determine the number of bit length codes to send. The pkzip format\r
+ requires that at least 4 bit length codes be sent. (appnote.txt says\r
+ 3 but the actual value used is 4.) }\r
+\r
+ for max_blindex := BL_CODES-1 downto 3 do\r
+ begin\r
+ if (s.bl_tree[bl_order[max_blindex]].dl.Len <> 0) then\r
+ break;\r
+ end;\r
+ { Update opt_len to include the bit length tree and counts }\r
+ Inc(s.opt_len, 3*(max_blindex+1) + 5+5+4);\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}');\r
+ {$ENDIF}\r
+\r
+ build_bl_tree := max_blindex;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Send the header for a block using dynamic Huffman trees: the counts, the\r
+ lengths of the bit length codes, the literal tree and the distance tree.\r
+ IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. }\r
+\r
+{local}\r
+procedure send_all_trees(var s : deflate_state;\r
+ lcodes : int;\r
+ dcodes : int;\r
+ blcodes : int); { number of codes for each tree }\r
+var\r
+ rank : int; { index in bl_order }\r
+begin\r
+ {$IFDEF DEBUG}\r
+ Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4),\r
+ 'not enough codes');\r
+ Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES)\r
+ and (blcodes <= BL_CODES), 'too many codes');\r
+ Tracev(^M'bl counts: ');\r
+ {$ENDIF}\r
+ send_bits(s, lcodes-257, 5); { not +255 as stated in appnote.txt }\r
+ send_bits(s, dcodes-1, 5);\r
+ send_bits(s, blcodes-4, 4); { not -3 as stated in appnote.txt }\r
+ for rank := 0 to blcodes-1 do\r
+ begin\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'bl code '+IntToStr(bl_order[rank]));\r
+ {$ENDIF}\r
+ send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3);\r
+ end;\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent));\r
+ {$ENDIF}\r
+\r
+ send_tree(s, s.dyn_ltree, lcodes-1); { literal tree }\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent));\r
+ {$ENDIF}\r
+\r
+ send_tree(s, s.dyn_dtree, dcodes-1); { distance tree }\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent));\r
+ {$ENDIF}\r
+end;\r
+\r
+{ ===========================================================================\r
+ Flush the bit buffer and align the output on a byte boundary }\r
+\r
+{local}\r
+procedure bi_windup(var s : deflate_state);\r
+begin\r
+ if (s.bi_valid > 8) then\r
+ begin\r
+ {put_short(s, s.bi_buf);}\r
+ s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);\r
+ Inc(s.pending);\r
+ s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;\r
+ Inc(s.pending);\r
+ end\r
+ else\r
+ if (s.bi_valid > 0) then\r
+ begin\r
+ {put_byte(s, (Byte)s^.bi_buf);}\r
+ s.pending_buf^[s.pending] := Byte(s.bi_buf);\r
+ Inc(s.pending);\r
+ end;\r
+ s.bi_buf := 0;\r
+ s.bi_valid := 0;\r
+{$ifdef DEBUG}\r
+ s.bits_sent := (s.bits_sent+7) and (not 7);\r
+{$endif}\r
+end;\r
+\r
+{ ===========================================================================\r
+ Copy a stored block, storing first the length and its\r
+ one's complement if requested. }\r
+\r
+{local}\r
+procedure copy_block(var s : deflate_state;\r
+ buf : pcharf; { the input data }\r
+ len : unsigned; { its length }\r
+ header : boolean); { true if block header must be written }\r
+begin\r
+ bi_windup(s); { align on byte boundary }\r
+ s.last_eob_len := 8; { enough lookahead for inflate }\r
+\r
+ if (header) then\r
+ begin\r
+ {put_short(s, (ush)len);}\r
+ s.pending_buf^[s.pending] := uch(ush(len) and $ff);\r
+ Inc(s.pending);\r
+ s.pending_buf^[s.pending] := uch(ush(len) shr 8);;\r
+ Inc(s.pending);\r
+ {put_short(s, (ush)~len);}\r
+ s.pending_buf^[s.pending] := uch(ush(not len) and $ff);\r
+ Inc(s.pending);\r
+ s.pending_buf^[s.pending] := uch(ush(not len) shr 8);;\r
+ Inc(s.pending);\r
+\r
+{$ifdef DEBUG}\r
+ Inc(s.bits_sent, 2*16);\r
+{$endif}\r
+ end;\r
+{$ifdef DEBUG}\r
+ Inc(s.bits_sent, ulg(len shl 3));\r
+{$endif}\r
+ while (len <> 0) do\r
+ begin\r
+ Dec(len);\r
+ {put_byte(s, *buf++);}\r
+ s.pending_buf^[s.pending] := buf^;\r
+ Inc(buf);\r
+ Inc(s.pending);\r
+ end;\r
+end;\r
+\r
+\r
+{ ===========================================================================\r
+ Send a stored block }\r
+\r
+procedure _tr_stored_block(var s : deflate_state;\r
+ buf : pcharf; { input block }\r
+ stored_len : ulg; { length of input block }\r
+ eof : boolean); { true if this is the last block for a file }\r
+\r
+begin\r
+ send_bits(s, (STORED_BLOCK shl 1)+ord(eof), 3); { send block type }\r
+ s.compressed_len := (s.compressed_len + 3 + 7) and ulg(not Long(7));\r
+ Inc(s.compressed_len, (stored_len + 4) shl 3);\r
+\r
+ copy_block(s, buf, unsigned(stored_len), TRUE); { with header }\r
+end;\r
+\r
+{ ===========================================================================\r
+ Flush the bit buffer, keeping at most 7 bits in it. }\r
+\r
+{local}\r
+procedure bi_flush(var s : deflate_state);\r
+begin\r
+ if (s.bi_valid = 16) then\r
+ begin\r
+ {put_short(s, s.bi_buf);}\r
+ s.pending_buf^[s.pending] := uch(s.bi_buf and $ff);\r
+ Inc(s.pending);\r
+ s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);;\r
+ Inc(s.pending);\r
+\r
+ s.bi_buf := 0;\r
+ s.bi_valid := 0;\r
+ end\r
+ else\r
+ if (s.bi_valid >= 8) then\r
+ begin\r
+ {put_byte(s, (Byte)s^.bi_buf);}\r
+ s.pending_buf^[s.pending] := Byte(s.bi_buf);\r
+ Inc(s.pending);\r
+\r
+ s.bi_buf := s.bi_buf shr 8;\r
+ Dec(s.bi_valid, 8);\r
+ end;\r
+end;\r
+\r
+\r
+{ ===========================================================================\r
+ Send one empty static block to give enough lookahead for inflate.\r
+ This takes 10 bits, of which 7 may remain in the bit buffer.\r
+ The current inflate code requires 9 bits of lookahead. If the\r
+ last two codes for the previous block (real code plus EOB) were coded\r
+ on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode\r
+ the last real code. In this case we send two empty static blocks instead\r
+ of one. (There are no problems if the previous block is stored or fixed.)\r
+ To simplify the code, we assume the worst case of last real code encoded\r
+ on one bit only. }\r
+\r
+procedure _tr_align(var s : deflate_state);\r
+begin\r
+ send_bits(s, STATIC_TREES shl 1, 3);\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(END_BLOCK));\r
+ {$ENDIF}\r
+ send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);\r
+ Inc(s.compressed_len, Long(10)); { 3 for block type, 7 for EOB }\r
+ bi_flush(s);\r
+ { Of the 10 bits for the empty block, we have already sent\r
+ (10 - bi_valid) bits. The lookahead for the last real code (before\r
+ the EOB of the previous block) was thus at least one plus the length\r
+ of the EOB plus what we have just sent of the empty static block. }\r
+ if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then\r
+ begin\r
+ send_bits(s, STATIC_TREES shl 1, 3);\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(END_BLOCK));\r
+ {$ENDIF}\r
+ send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);\r
+ Inc(s.compressed_len, Long(10));\r
+ bi_flush(s);\r
+ end;\r
+ s.last_eob_len := 7;\r
+end;\r
+\r
+{ ===========================================================================\r
+ Set the data type to ASCII or BINARY, using a crude approximation:\r
+ binary if more than 20% of the bytes are <= 6 or >= 128, ascii otherwise.\r
+ IN assertion: the fields freq of dyn_ltree are set and the total of all\r
+ frequencies does not exceed 64K (to fit in an int on 16 bit machines). }\r
+\r
+{local}\r
+procedure set_data_type(var s : deflate_state);\r
+var\r
+ n : int;\r
+ ascii_freq : unsigned;\r
+ bin_freq : unsigned;\r
+begin\r
+ n := 0;\r
+ ascii_freq := 0;\r
+ bin_freq := 0;\r
+\r
+ while (n < 7) do\r
+ begin\r
+ Inc(bin_freq, s.dyn_ltree[n].fc.Freq);\r
+ Inc(n);\r
+ end;\r
+ while (n < 128) do\r
+ begin\r
+ Inc(ascii_freq, s.dyn_ltree[n].fc.Freq);\r
+ Inc(n);\r
+ end;\r
+ while (n < LITERALS) do\r
+ begin\r
+ Inc(bin_freq, s.dyn_ltree[n].fc.Freq);\r
+ Inc(n);\r
+ end;\r
+ if (bin_freq > (ascii_freq shr 2)) then\r
+ s.data_type := Byte(Z_BINARY)\r
+ else\r
+ s.data_type := Byte(Z_ASCII);\r
+end;\r
+\r
+{ ===========================================================================\r
+ Send the block data compressed using the given Huffman trees }\r
+\r
+{local}\r
+procedure compress_block(var s : deflate_state;\r
+ var ltree : array of ct_data; { literal tree }\r
+ var dtree : array of ct_data); { distance tree }\r
+var\r
+ dist : unsigned; { distance of matched string }\r
+ lc : int; { match length or unmatched char (if dist == 0) }\r
+ lx : unsigned; { running index in l_buf }\r
+ code : unsigned; { the code to send }\r
+ extra : int; { number of extra bits to send }\r
+begin\r
+ lx := 0;\r
+ if (s.last_lit <> 0) then\r
+ repeat\r
+ dist := s.d_buf^[lx];\r
+ lc := s.l_buf^[lx];\r
+ Inc(lx);\r
+ if (dist = 0) then\r
+ begin\r
+ { send a literal byte }\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(lc));\r
+ Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');\r
+ {$ENDIF}\r
+ send_bits(s, ltree[lc].fc.Code, ltree[lc].dl.Len);\r
+ end\r
+ else\r
+ begin\r
+ { Here, lc is the match length - MIN_MATCH }\r
+ code := _length_code[lc];\r
+ { send the length code }\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(code+LITERALS+1));\r
+ {$ENDIF}\r
+ send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len);\r
+ extra := extra_lbits[code];\r
+ if (extra <> 0) then\r
+ begin\r
+ Dec(lc, base_length[code]);\r
+ send_bits(s, lc, extra); { send the extra length bits }\r
+ end;\r
+ Dec(dist); { dist is now the match distance - 1 }\r
+ {code := d_code(dist);}\r
+ if (dist < 256) then\r
+ code := _dist_code[dist]\r
+ else\r
+ code := _dist_code[256+(dist shr 7)];\r
+\r
+ {$IFDEF DEBUG}\r
+ Assert (code < D_CODES, 'bad d_code');\r
+ {$ENDIF}\r
+\r
+ { send the distance code }\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(code));\r
+ {$ENDIF}\r
+ send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len);\r
+ extra := extra_dbits[code];\r
+ if (extra <> 0) then\r
+ begin\r
+ Dec(dist, base_dist[code]);\r
+ send_bits(s, dist, extra); { send the extra distance bits }\r
+ end;\r
+ end; { literal or match pair ? }\r
+\r
+ { Check that the overlay between pending_buf and d_buf+l_buf is ok: }\r
+ {$IFDEF DEBUG}\r
+ Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow');\r
+ {$ENDIF}\r
+ until (lx >= s.last_lit);\r
+\r
+ {$ifdef DEBUG}\r
+ Tracevvv(#13'cd '+IntToStr(END_BLOCK));\r
+ {$ENDIF}\r
+ send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len);\r
+ s.last_eob_len := ltree[END_BLOCK].dl.Len;\r
+end;\r
+\r
+\r
+{ ===========================================================================\r
+ Determine the best encoding for the current block: dynamic trees, static\r
+ trees or store, and output the encoded block to the zip file. This function\r
+ returns the total compressed length for the file so far. }\r
+\r
+function _tr_flush_block (var s : deflate_state;\r
+ buf : pcharf; { input block, or NULL if too old }\r
+ stored_len : ulg; { length of input block }\r
+ eof : boolean) : ulg; { true if this is the last block for a file }\r
+var\r
+ opt_lenb, static_lenb : ulg; { opt_len and static_len in bytes }\r
+ max_blindex : int; { index of last bit length code of non zero freq }\r
+begin\r
+ max_blindex := 0;\r
+\r
+ { Build the Huffman trees unless a stored block is forced }\r
+ if (s.level > 0) then\r
+ begin\r
+ { Check if the file is ascii or binary }\r
+ if (s.data_type = Z_UNKNOWN) then\r
+ set_data_type(s);\r
+\r
+ { Construct the literal and distance trees }\r
+ build_tree(s, s.l_desc);\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}');\r
+ {$ENDIF}\r
+\r
+ build_tree(s, s.d_desc);\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}');\r
+ {$ENDIF}\r
+ { At this point, opt_len and static_len are the total bit lengths of\r
+ the compressed block data, excluding the tree representations. }\r
+\r
+ { Build the bit length tree for the above two trees, and get the index\r
+ in bl_order of the last bit length code to send. }\r
+ max_blindex := build_bl_tree(s);\r
+\r
+ { Determine the best encoding. Compute first the block length in bytes}\r
+ opt_lenb := (s.opt_len+3+7) shr 3;\r
+ static_lenb := (s.static_len+3+7) shr 3;\r
+\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+\r
+ '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+\r
+ 's.last_lit}');\r
+ {$ENDIF}\r
+\r
+ if (static_lenb <= opt_lenb) then\r
+ opt_lenb := static_lenb;\r
+\r
+ end\r
+ else\r
+ begin\r
+ {$IFDEF DEBUG}\r
+ Assert(buf <> pcharf(NIL), 'lost buf');\r
+ {$ENDIF}\r
+ static_lenb := stored_len + 5;\r
+ opt_lenb := static_lenb; { force a stored block }\r
+ end;\r
+\r
+ { If compression failed and this is the first and last block,\r
+ and if the .zip file can be seeked (to rewrite the local header),\r
+ the whole file is transformed into a stored file: }\r
+\r
+{$ifdef STORED_FILE_OK}\r
+{$ifdef FORCE_STORED_FILE}\r
+ if eof and (s.compressed_len = Long(0)) then\r
+ begin { force stored file }\r
+{$else}\r
+ if (stored_len <= opt_lenb) and eof and (s.compressed_len=Long(0))\r
+ and seekable()) do\r
+ begin\r
+{$endif}\r
+ { Since LIT_BUFSIZE <= 2*WSIZE, the input data must be there: }\r
+ if (buf = pcharf(0)) then\r
+ error ('block vanished');\r
+\r
+ copy_block(buf, unsigned(stored_len), 0); { without header }\r
+ s.compressed_len := stored_len shl 3;\r
+ s.method := STORED;\r
+ end\r
+ else\r
+{$endif} { STORED_FILE_OK }\r
+\r
+{$ifdef FORCE_STORED}\r
+ if (buf <> pchar(0)) then\r
+ begin { force stored block }\r
+{$else}\r
+ if (stored_len+4 <= opt_lenb) and (buf <> pcharf(0)) then\r
+ begin\r
+ { 4: two words for the lengths }\r
+{$endif}\r
+ { The test buf <> NULL is only necessary if LIT_BUFSIZE > WSIZE.\r
+ Otherwise we can't have processed more than WSIZE input bytes since\r
+ the last block flush, because compression would have been\r
+ successful. If LIT_BUFSIZE <= WSIZE, it is never too late to\r
+ transform a block into a stored block. }\r
+\r
+ _tr_stored_block(s, buf, stored_len, eof);\r
+\r
+{$ifdef FORCE_STATIC}\r
+ end\r
+ else\r
+ if (static_lenb >= 0) then\r
+ begin { force static trees }\r
+{$else}\r
+ end\r
+ else\r
+ if (static_lenb = opt_lenb) then\r
+ begin\r
+{$endif}\r
+ send_bits(s, (STATIC_TREES shl 1)+ord(eof), 3);\r
+ compress_block(s, static_ltree, static_dtree);\r
+ Inc(s.compressed_len, 3 + s.static_len);\r
+ end\r
+ else\r
+ begin\r
+ send_bits(s, (DYN_TREES shl 1)+ord(eof), 3);\r
+ send_all_trees(s, s.l_desc.max_code+1, s.d_desc.max_code+1,\r
+ max_blindex+1);\r
+ compress_block(s, s.dyn_ltree, s.dyn_dtree);\r
+ Inc(s.compressed_len, 3 + s.opt_len);\r
+ end;\r
+ {$ifdef DEBUG}\r
+ Assert (s.compressed_len = s.bits_sent, 'bad compressed size');\r
+ {$ENDIF}\r
+ init_block(s);\r
+\r
+ if (eof) then\r
+ begin\r
+ bi_windup(s);\r
+ Inc(s.compressed_len, 7); { align on byte boundary }\r
+ end;\r
+ {$ifdef DEBUG}\r
+ Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+\r
+ 's.compressed_len-7*ord(eof)}');\r
+ {$ENDIF}\r
+\r
+ _tr_flush_block := s.compressed_len shr 3;\r
+end;\r
+\r
+\r
+{ ===========================================================================\r
+ Save the match info and tally the frequency counts. Return true if\r
+ the current block must be flushed. }\r
+\r
+function _tr_tally (var s : deflate_state;\r
+ dist : unsigned; { distance of matched string }\r
+ lc : unsigned) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) }\r
+var\r
+ {$IFDEF DEBUG}\r
+ MAX_DIST : ush;\r
+ {$ENDIF}\r
+ code : ush;\r
+{$ifdef TRUNCATE_BLOCK}\r
+var\r
+ out_length : ulg;\r
+ in_length : ulg;\r
+ dcode : int;\r
+{$endif}\r
+begin\r
+ s.d_buf^[s.last_lit] := ush(dist);\r
+ s.l_buf^[s.last_lit] := uch(lc);\r
+ Inc(s.last_lit);\r
+ if (dist = 0) then\r
+ begin\r
+ { lc is the unmatched char }\r
+ Inc(s.dyn_ltree[lc].fc.Freq);\r
+ end\r
+ else\r
+ begin\r
+ Inc(s.matches);\r
+ { Here, lc is the match length - MIN_MATCH }\r
+ Dec(dist); { dist := match distance - 1 }\r
+\r
+ {macro d_code(dist)}\r
+ if (dist) < 256 then\r
+ code := _dist_code[dist]\r
+ else\r
+ code := _dist_code[256+(dist shr 7)];\r
+ {$IFDEF DEBUG}\r
+{macro MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD)\r
+ In order to simplify the code, particularly on 16 bit machines, match\r
+ distances are limited to MAX_DIST instead of WSIZE. }\r
+ MAX_DIST := ush(s.w_size-MIN_LOOKAHEAD);\r
+ Assert((dist < ush(MAX_DIST)) and\r
+ (ush(lc) <= ush(MAX_MATCH-MIN_MATCH)) and\r
+ (ush(code) < ush(D_CODES)), '_tr_tally: bad match');\r
+ {$ENDIF}\r
+ Inc(s.dyn_ltree[_length_code[lc]+LITERALS+1].fc.Freq);\r
+ {s.dyn_dtree[d_code(dist)].Freq++;}\r
+ Inc(s.dyn_dtree[code].fc.Freq);\r
+ end;\r
+\r
+{$ifdef TRUNCATE_BLOCK}\r
+ { Try to guess if it is profitable to stop the current block here }\r
+ if (s.last_lit and $1fff = 0) and (s.level > 2) then\r
+ begin\r
+ { Compute an upper bound for the compressed length }\r
+ out_length := ulg(s.last_lit)*Long(8);\r
+ in_length := ulg(long(s.strstart) - s.block_start);\r
+ for dcode := 0 to D_CODES-1 do\r
+ begin\r
+ Inc(out_length, ulg(s.dyn_dtree[dcode].fc.Freq *\r
+ (Long(5)+extra_dbits[dcode])) );\r
+ end;\r
+ out_length := out_length shr 3;\r
+ {$ifdef DEBUG}\r
+ Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) ');\r
+ { s.last_lit, in_length, out_length,\r
+ Long(100) - out_length*Long(100) div in_length)); }\r
+ {$ENDIF}\r
+ if (s.matches < s.last_lit div 2) and (out_length < in_length div 2) then\r
+ begin\r
+ _tr_tally := TRUE;\r
+ exit;\r
+ end;\r
+ end;\r
+{$endif}\r
+ _tr_tally := (s.last_lit = s.lit_bufsize-1);\r
+ { We avoid equality with lit_bufsize because of wraparound at 64K\r
+ on 16 bit machines and because stored blocks are restricted to\r
+ 64K-1 bytes. }\r
+end;\r
+\r
+end.
\ No newline at end of file
lcore.org gitweb / pngwrite.git / commitdiff