zdeflate.pas 72 KB

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