DEADSOFTWARE

hopefully no more windows
[d2df-editor.git] / src / lib / vampimg / ZLib / iminffast.pas
1 Unit iminffast;
3 {
4 inffast.h and
5 inffast.c -- process literals and length/distance pairs fast
6 Copyright (C) 1995-1998 Mark Adler
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 }
14 interface
16 {$I imzconf.inc}
18 uses
19 {$ifdef DEBUG}
20 SysUtils, strutils,
21 {$ENDIF}
22 imzutil, impaszlib;
24 function inflate_fast( bl : uInt;
25 bd : uInt;
26 tl : pInflate_huft;
27 td : pInflate_huft;
28 var s : inflate_blocks_state;
29 var z : z_stream) : int;
32 implementation
34 uses
35 iminfutil;
38 { Called with number of bytes left to write in window at least 258
39 (the maximum string length) and number of input bytes available
40 at least ten. The ten bytes are six bytes for the longest length/
41 distance pair plus four bytes for overloading the bit buffer. }
43 function inflate_fast( bl : uInt;
44 bd : uInt;
45 tl : pInflate_huft;
46 td : pInflate_huft;
47 var s : inflate_blocks_state;
48 var z : z_stream) : int;
50 var
51 t : pInflate_huft; { temporary pointer }
52 e : uInt; { extra bits or operation }
53 b : uLong; { bit buffer }
54 k : uInt; { bits in bit buffer }
55 p : pBytef; { input data pointer }
56 n : uInt; { bytes available there }
57 q : pBytef; { output window write pointer }
58 m : uInt; { bytes to end of window or read pointer }
59 ml : uInt; { mask for literal/length tree }
60 md : uInt; { mask for distance tree }
61 c : uInt; { bytes to copy }
62 d : uInt; { distance back to copy from }
63 r : pBytef; { copy source pointer }
64 begin
65 { load input, output, bit values (macro LOAD) }
66 p := z.next_in;
67 n := z.avail_in;
68 b := s.bitb;
69 k := s.bitk;
70 q := s.write;
71 if ptr2int(q) < ptr2int(s.read) then
72 m := uInt(ptr2int(s.read)-ptr2int(q)-1)
73 else
74 m := uInt(ptr2int(s.zend)-ptr2int(q));
76 { initialize masks }
77 ml := inflate_mask[bl];
78 md := inflate_mask[bd];
80 { do until not enough input or output space for fast loop }
81 repeat { assume called with (m >= 258) and (n >= 10) }
82 { get literal/length code }
83 {GRABBITS(20);} { max bits for literal/length code }
84 while (k < 20) do
85 begin
86 Dec(n);
87 b := b or (uLong(p^) shl k);
88 Inc(p);
89 Inc(k, 8);
90 end;
92 t := @(huft_ptr(tl)^[uInt(b) and ml]);
94 e := t^.exop;
95 if (e = 0) then
96 begin
97 {DUMPBITS(t^.bits);}
98 b := b shr t^.bits;
99 Dec(k, t^.bits);
100 {$IFDEF DEBUG}
101 if (t^.base >= $20) and (t^.base < $7f) then
102 Tracevv('inflate: * literal '+AnsiChar(t^.base))
103 else
104 Tracevv('inflate: * literal '+ IntToStr(t^.base));
105 {$ENDIF}
106 q^ := Byte(t^.base);
107 Inc(q);
108 Dec(m);
109 continue;
110 end;
111 repeat
112 {DUMPBITS(t^.bits);}
113 b := b shr t^.bits;
114 Dec(k, t^.bits);
116 if (e and 16 <> 0) then
117 begin
118 { get extra bits for length }
119 e := e and 15;
120 c := t^.base + (uInt(b) and inflate_mask[e]);
121 {DUMPBITS(e);}
122 b := b shr e;
123 Dec(k, e);
124 {$IFDEF DEBUG}
125 Tracevv('inflate: * length ' + IntToStr(c));
126 {$ENDIF}
127 { decode distance base of block to copy }
128 {GRABBITS(15);} { max bits for distance code }
129 while (k < 15) do
130 begin
131 Dec(n);
132 b := b or (uLong(p^) shl k);
133 Inc(p);
134 Inc(k, 8);
135 end;
137 t := @huft_ptr(td)^[uInt(b) and md];
138 e := t^.exop;
139 repeat
140 {DUMPBITS(t^.bits);}
141 b := b shr t^.bits;
142 Dec(k, t^.bits);
144 if (e and 16 <> 0) then
145 begin
146 { get extra bits to add to distance base }
147 e := e and 15;
148 {GRABBITS(e);} { get extra bits (up to 13) }
149 while (k < e) do
150 begin
151 Dec(n);
152 b := b or (uLong(p^) shl k);
153 Inc(p);
154 Inc(k, 8);
155 end;
157 d := t^.base + (uInt(b) and inflate_mask[e]);
158 {DUMPBITS(e);}
159 b := b shr e;
160 Dec(k, e);
162 {$IFDEF DEBUG}
163 Tracevv('inflate: * distance '+IntToStr(d));
164 {$ENDIF}
165 { do the copy }
166 Dec(m, c);
167 if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest }
168 begin { just copy }
169 r := q;
170 Dec(r, d);
171 q^ := r^; Inc(q); Inc(r); Dec(c); { minimum count is three, }
172 q^ := r^; Inc(q); Inc(r); Dec(c); { so unroll loop a little }
173 end
174 else { else offset after destination }
175 begin
176 e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
177 r := s.zend;
178 Dec(r, e); { pointer to offset }
179 if (c > e) then { if source crosses, }
180 begin
181 Dec(c, e); { copy to end of window }
182 repeat
183 q^ := r^;
184 Inc(q);
185 Inc(r);
186 Dec(e);
187 until (e=0);
188 r := s.window; { copy rest from start of window }
189 end;
190 end;
191 repeat { copy all or what's left }
192 q^ := r^;
193 Inc(q);
194 Inc(r);
195 Dec(c);
196 until (c = 0);
197 break;
198 end
199 else
200 if (e and 64 = 0) then
201 begin
202 Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
203 e := t^.exop;
204 end
205 else
206 begin
207 z.msg := 'invalid distance code';
208 {UNGRAB}
209 c := z.avail_in-n;
210 if (k shr 3) < c then
211 c := k shr 3;
212 Inc(n, c);
213 Dec(p, c);
214 Dec(k, c shl 3);
215 {UPDATE}
216 s.bitb := b;
217 s.bitk := k;
218 z.avail_in := n;
219 Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
220 z.next_in := p;
221 s.write := q;
223 inflate_fast := Z_DATA_ERROR;
224 exit;
225 end;
226 until FALSE;
227 break;
228 end;
229 if (e and 64 = 0) then
230 begin
231 {t += t->base;
232 e = (t += ((uInt)b & inflate_mask[e]))->exop;}
234 Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
235 e := t^.exop;
236 if (e = 0) then
237 begin
238 {DUMPBITS(t^.bits);}
239 b := b shr t^.bits;
240 Dec(k, t^.bits);
242 {$IFDEF DEBUG}
243 if (t^.base >= $20) and (t^.base < $7f) then
244 Tracevv('inflate: * literal '+AnsiChar(t^.base))
245 else
246 Tracevv('inflate: * literal '+IntToStr(t^.base));
247 {$ENDIF}
248 q^ := Byte(t^.base);
249 Inc(q);
250 Dec(m);
251 break;
252 end;
253 end
254 else
255 if (e and 32 <> 0) then
256 begin
257 {$IFDEF DEBUG}
258 Tracevv('inflate: * end of block');
259 {$ENDIF}
260 {UNGRAB}
261 c := z.avail_in-n;
262 if (k shr 3) < c then
263 c := k shr 3;
264 Inc(n, c);
265 Dec(p, c);
266 Dec(k, c shl 3);
267 {UPDATE}
268 s.bitb := b;
269 s.bitk := k;
270 z.avail_in := n;
271 Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
272 z.next_in := p;
273 s.write := q;
274 inflate_fast := Z_STREAM_END;
275 exit;
276 end
277 else
278 begin
279 z.msg := 'invalid literal/length code';
280 {UNGRAB}
281 c := z.avail_in-n;
282 if (k shr 3) < c then
283 c := k shr 3;
284 Inc(n, c);
285 Dec(p, c);
286 Dec(k, c shl 3);
287 {UPDATE}
288 s.bitb := b;
289 s.bitk := k;
290 z.avail_in := n;
291 Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
292 z.next_in := p;
293 s.write := q;
294 inflate_fast := Z_DATA_ERROR;
295 exit;
296 end;
297 until FALSE;
298 until (m < 258) or (n < 10);
300 { not enough input or output--restore pointers and return }
301 {UNGRAB}
302 c := z.avail_in-n;
303 if (k shr 3) < c then
304 c := k shr 3;
305 Inc(n, c);
306 Dec(p, c);
307 Dec(k, c shl 3);
308 {UPDATE}
309 s.bitb := b;
310 s.bitk := k;
311 z.avail_in := n;
312 Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
313 z.next_in := p;
314 s.write := q;
315 inflate_fast := Z_OK;
316 end;
318 end.