diff options
Diffstat (limited to 'contrib/ada/zlib.adb')
-rw-r--r-- | contrib/ada/zlib.adb | 674 |
1 files changed, 674 insertions, 0 deletions
diff --git a/contrib/ada/zlib.adb b/contrib/ada/zlib.adb new file mode 100644 index 0000000..93bf885 --- /dev/null +++ b/contrib/ada/zlib.adb | |||
@@ -0,0 +1,674 @@ | |||
1 | ---------------------------------------------------------------- | ||
2 | -- ZLib for Ada thick binding. -- | ||
3 | -- -- | ||
4 | -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- | ||
5 | -- -- | ||
6 | -- Open source license information is in the zlib.ads file. -- | ||
7 | ---------------------------------------------------------------- | ||
8 | |||
9 | -- $Id: zlib.adb,v 1.19 2003/07/13 16:02:19 vagul Exp $ | ||
10 | |||
11 | with Ada.Exceptions; | ||
12 | with Ada.Unchecked_Conversion; | ||
13 | with Ada.Unchecked_Deallocation; | ||
14 | |||
15 | with Interfaces.C.Strings; | ||
16 | |||
17 | with ZLib.Thin; | ||
18 | |||
19 | package body ZLib is | ||
20 | |||
21 | use type Thin.Int; | ||
22 | |||
23 | type Z_Stream is new Thin.Z_Stream; | ||
24 | |||
25 | type Return_Code_Enum is | ||
26 | (OK, | ||
27 | STREAM_END, | ||
28 | NEED_DICT, | ||
29 | ERRNO, | ||
30 | STREAM_ERROR, | ||
31 | DATA_ERROR, | ||
32 | MEM_ERROR, | ||
33 | BUF_ERROR, | ||
34 | VERSION_ERROR); | ||
35 | |||
36 | type Flate_Step_Function is access | ||
37 | function (Strm : Thin.Z_Streamp; flush : Thin.Int) return Thin.Int; | ||
38 | pragma Convention (C, Flate_Step_Function); | ||
39 | |||
40 | type Flate_End_Function is access | ||
41 | function (Ctrm : in Thin.Z_Streamp) return Thin.Int; | ||
42 | pragma Convention (C, Flate_End_Function); | ||
43 | |||
44 | type Flate_Type is record | ||
45 | Step : Flate_Step_Function; | ||
46 | Done : Flate_End_Function; | ||
47 | end record; | ||
48 | |||
49 | subtype Footer_Array is Stream_Element_Array (1 .. 8); | ||
50 | |||
51 | Simple_GZip_Header : constant Stream_Element_Array (1 .. 10) | ||
52 | := (16#1f#, 16#8b#, -- Magic header | ||
53 | 16#08#, -- Z_DEFLATED | ||
54 | 16#00#, -- Flags | ||
55 | 16#00#, 16#00#, 16#00#, 16#00#, -- Time | ||
56 | 16#00#, -- XFlags | ||
57 | 16#03# -- OS code | ||
58 | ); | ||
59 | -- The simplest gzip header is not for informational, but just for | ||
60 | -- gzip format compatibility. | ||
61 | -- Note that some code below is using assumption | ||
62 | -- Simple_GZip_Header'Last > Footer_Array'Last, so do not make | ||
63 | -- Simple_GZip_Header'Last <= Footer_Array'Last. | ||
64 | |||
65 | Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum | ||
66 | := (0 => OK, | ||
67 | 1 => STREAM_END, | ||
68 | 2 => NEED_DICT, | ||
69 | -1 => ERRNO, | ||
70 | -2 => STREAM_ERROR, | ||
71 | -3 => DATA_ERROR, | ||
72 | -4 => MEM_ERROR, | ||
73 | -5 => BUF_ERROR, | ||
74 | -6 => VERSION_ERROR); | ||
75 | |||
76 | Flate : constant array (Boolean) of Flate_Type | ||
77 | := (True => (Step => Thin.Deflate'Access, | ||
78 | Done => Thin.DeflateEnd'Access), | ||
79 | False => (Step => Thin.Inflate'Access, | ||
80 | Done => Thin.InflateEnd'Access)); | ||
81 | |||
82 | Flush_Finish : constant array (Boolean) of Flush_Mode | ||
83 | := (True => Finish, False => No_Flush); | ||
84 | |||
85 | procedure Raise_Error (Stream : Z_Stream); | ||
86 | pragma Inline (Raise_Error); | ||
87 | |||
88 | procedure Raise_Error (Message : String); | ||
89 | pragma Inline (Raise_Error); | ||
90 | |||
91 | procedure Check_Error (Stream : Z_Stream; Code : Thin.Int); | ||
92 | |||
93 | procedure Free is new Ada.Unchecked_Deallocation | ||
94 | (Z_Stream, Z_Stream_Access); | ||
95 | |||
96 | function To_Thin_Access is new Ada.Unchecked_Conversion | ||
97 | (Z_Stream_Access, Thin.Z_Streamp); | ||
98 | |||
99 | procedure Translate_GZip | ||
100 | (Filter : in out Filter_Type; | ||
101 | In_Data : in Ada.Streams.Stream_Element_Array; | ||
102 | In_Last : out Ada.Streams.Stream_Element_Offset; | ||
103 | Out_Data : out Ada.Streams.Stream_Element_Array; | ||
104 | Out_Last : out Ada.Streams.Stream_Element_Offset; | ||
105 | Flush : in Flush_Mode); | ||
106 | -- Separate translate routine for make gzip header. | ||
107 | |||
108 | procedure Translate_Auto | ||
109 | (Filter : in out Filter_Type; | ||
110 | In_Data : in Ada.Streams.Stream_Element_Array; | ||
111 | In_Last : out Ada.Streams.Stream_Element_Offset; | ||
112 | Out_Data : out Ada.Streams.Stream_Element_Array; | ||
113 | Out_Last : out Ada.Streams.Stream_Element_Offset; | ||
114 | Flush : in Flush_Mode); | ||
115 | -- translate routine without additional headers. | ||
116 | |||
117 | ----------------- | ||
118 | -- Check_Error -- | ||
119 | ----------------- | ||
120 | |||
121 | procedure Check_Error (Stream : Z_Stream; Code : Thin.Int) is | ||
122 | use type Thin.Int; | ||
123 | begin | ||
124 | if Code /= Thin.Z_OK then | ||
125 | Raise_Error | ||
126 | (Return_Code_Enum'Image (Return_Code (Code)) | ||
127 | & ": " & Last_Error_Message (Stream)); | ||
128 | end if; | ||
129 | end Check_Error; | ||
130 | |||
131 | ----------- | ||
132 | -- Close -- | ||
133 | ----------- | ||
134 | |||
135 | procedure Close | ||
136 | (Filter : in out Filter_Type; | ||
137 | Ignore_Error : in Boolean := False) | ||
138 | is | ||
139 | Code : Thin.Int; | ||
140 | begin | ||
141 | Code := Flate (Filter.Compression).Done | ||
142 | (To_Thin_Access (Filter.Strm)); | ||
143 | |||
144 | Filter.Opened := False; | ||
145 | |||
146 | if Ignore_Error or else Code = Thin.Z_OK then | ||
147 | Free (Filter.Strm); | ||
148 | else | ||
149 | declare | ||
150 | Error_Message : constant String | ||
151 | := Last_Error_Message (Filter.Strm.all); | ||
152 | begin | ||
153 | Free (Filter.Strm); | ||
154 | Ada.Exceptions.Raise_Exception | ||
155 | (ZLib_Error'Identity, | ||
156 | Return_Code_Enum'Image (Return_Code (Code)) | ||
157 | & ": " & Error_Message); | ||
158 | end; | ||
159 | end if; | ||
160 | end Close; | ||
161 | |||
162 | ----------- | ||
163 | -- CRC32 -- | ||
164 | ----------- | ||
165 | |||
166 | function CRC32 | ||
167 | (CRC : in Unsigned_32; | ||
168 | Data : in Ada.Streams.Stream_Element_Array) | ||
169 | return Unsigned_32 | ||
170 | is | ||
171 | use Thin; | ||
172 | begin | ||
173 | return Unsigned_32 (crc32 | ||
174 | (ULong (CRC), | ||
175 | Bytes.To_Pointer (Data'Address), | ||
176 | Data'Length)); | ||
177 | end CRC32; | ||
178 | |||
179 | procedure CRC32 | ||
180 | (CRC : in out Unsigned_32; | ||
181 | Data : in Ada.Streams.Stream_Element_Array) is | ||
182 | begin | ||
183 | CRC := CRC32 (CRC, Data); | ||
184 | end CRC32; | ||
185 | |||
186 | ------------------ | ||
187 | -- Deflate_Init -- | ||
188 | ------------------ | ||
189 | |||
190 | procedure Deflate_Init | ||
191 | (Filter : in out Filter_Type; | ||
192 | Level : in Compression_Level := Default_Compression; | ||
193 | Strategy : in Strategy_Type := Default_Strategy; | ||
194 | Method : in Compression_Method := Deflated; | ||
195 | Window_Bits : in Window_Bits_Type := 15; | ||
196 | Memory_Level : in Memory_Level_Type := 8; | ||
197 | Header : in Header_Type := Default) | ||
198 | is | ||
199 | use type Thin.Int; | ||
200 | Win_Bits : Thin.Int := Thin.Int (Window_Bits); | ||
201 | begin | ||
202 | -- We allow ZLib to make header only in case of default header type. | ||
203 | -- Otherwise we would either do header by ourselfs, or do not do | ||
204 | -- header at all. | ||
205 | |||
206 | if Header = None or else Header = GZip then | ||
207 | Win_Bits := -Win_Bits; | ||
208 | end if; | ||
209 | |||
210 | -- For the GZip CRC calculation and make headers. | ||
211 | |||
212 | if Header = GZip then | ||
213 | Filter.CRC := 0; | ||
214 | Filter.Offset := Simple_GZip_Header'First; | ||
215 | else | ||
216 | Filter.Offset := Simple_GZip_Header'Last + 1; | ||
217 | end if; | ||
218 | |||
219 | Filter.Strm := new Z_Stream; | ||
220 | Filter.Compression := True; | ||
221 | Filter.Stream_End := False; | ||
222 | Filter.Opened := True; | ||
223 | Filter.Header := Header; | ||
224 | |||
225 | if Thin.Deflate_Init | ||
226 | (To_Thin_Access (Filter.Strm), | ||
227 | Level => Thin.Int (Level), | ||
228 | method => Thin.Int (Method), | ||
229 | windowBits => Win_Bits, | ||
230 | memLevel => Thin.Int (Memory_Level), | ||
231 | strategy => Thin.Int (Strategy)) /= Thin.Z_OK | ||
232 | then | ||
233 | Raise_Error (Filter.Strm.all); | ||
234 | end if; | ||
235 | end Deflate_Init; | ||
236 | |||
237 | ----------- | ||
238 | -- Flush -- | ||
239 | ----------- | ||
240 | |||
241 | procedure Flush | ||
242 | (Filter : in out Filter_Type; | ||
243 | Out_Data : out Ada.Streams.Stream_Element_Array; | ||
244 | Out_Last : out Ada.Streams.Stream_Element_Offset; | ||
245 | Flush : in Flush_Mode) | ||
246 | is | ||
247 | No_Data : Stream_Element_Array := (1 .. 0 => 0); | ||
248 | Last : Stream_Element_Offset; | ||
249 | begin | ||
250 | Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush); | ||
251 | end Flush; | ||
252 | |||
253 | ----------------------- | ||
254 | -- Generic_Translate -- | ||
255 | ----------------------- | ||
256 | |||
257 | procedure Generic_Translate | ||
258 | (Filter : in out ZLib.Filter_Type; | ||
259 | In_Buffer_Size : Integer := Default_Buffer_Size; | ||
260 | Out_Buffer_Size : Integer := Default_Buffer_Size) | ||
261 | is | ||
262 | In_Buffer : Stream_Element_Array | ||
263 | (1 .. Stream_Element_Offset (In_Buffer_Size)); | ||
264 | Out_Buffer : Stream_Element_Array | ||
265 | (1 .. Stream_Element_Offset (Out_Buffer_Size)); | ||
266 | Last : Stream_Element_Offset; | ||
267 | In_Last : Stream_Element_Offset; | ||
268 | In_First : Stream_Element_Offset; | ||
269 | Out_Last : Stream_Element_Offset; | ||
270 | begin | ||
271 | Main : loop | ||
272 | Data_In (In_Buffer, Last); | ||
273 | |||
274 | In_First := In_Buffer'First; | ||
275 | |||
276 | loop | ||
277 | Translate | ||
278 | (Filter, | ||
279 | In_Buffer (In_First .. Last), | ||
280 | In_Last, | ||
281 | Out_Buffer, | ||
282 | Out_Last, | ||
283 | Flush_Finish (Last < In_Buffer'First)); | ||
284 | |||
285 | Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last)); | ||
286 | |||
287 | exit Main when Stream_End (Filter); | ||
288 | |||
289 | -- The end of in buffer. | ||
290 | exit when In_Last = Last; | ||
291 | |||
292 | In_First := In_Last + 1; | ||
293 | end loop; | ||
294 | end loop Main; | ||
295 | |||
296 | end Generic_Translate; | ||
297 | |||
298 | ------------------ | ||
299 | -- Inflate_Init -- | ||
300 | ------------------ | ||
301 | |||
302 | procedure Inflate_Init | ||
303 | (Filter : in out Filter_Type; | ||
304 | Window_Bits : in Window_Bits_Type := 15; | ||
305 | Header : in Header_Type := Default) | ||
306 | is | ||
307 | use type Thin.Int; | ||
308 | Win_Bits : Thin.Int := Thin.Int (Window_Bits); | ||
309 | |||
310 | procedure Check_Version; | ||
311 | -- Check the latest header types compatibility. | ||
312 | |||
313 | procedure Check_Version is | ||
314 | begin | ||
315 | if Version <= "1.1.4" then | ||
316 | Raise_Error | ||
317 | ("Inflate header type " & Header_Type'Image (Header) | ||
318 | & " incompatible with ZLib version " & Version); | ||
319 | end if; | ||
320 | end Check_Version; | ||
321 | |||
322 | begin | ||
323 | case Header is | ||
324 | when None => | ||
325 | Check_Version; | ||
326 | |||
327 | -- Inflate data without headers determined | ||
328 | -- by negative Win_Bits. | ||
329 | |||
330 | Win_Bits := -Win_Bits; | ||
331 | when GZip => | ||
332 | Check_Version; | ||
333 | |||
334 | -- Inflate gzip data defined by flag 16. | ||
335 | |||
336 | Win_Bits := Win_Bits + 16; | ||
337 | when Auto => | ||
338 | Check_Version; | ||
339 | |||
340 | -- Inflate with automatic detection | ||
341 | -- of gzip or native header defined by flag 32. | ||
342 | |||
343 | Win_Bits := Win_Bits + 32; | ||
344 | when Default => null; | ||
345 | end case; | ||
346 | |||
347 | Filter.Strm := new Z_Stream; | ||
348 | Filter.Compression := False; | ||
349 | Filter.Stream_End := False; | ||
350 | Filter.Opened := True; | ||
351 | Filter.Header := Header; | ||
352 | |||
353 | if Thin.Inflate_Init | ||
354 | (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK | ||
355 | then | ||
356 | Raise_Error (Filter.Strm.all); | ||
357 | end if; | ||
358 | end Inflate_Init; | ||
359 | |||
360 | ----------------- | ||
361 | -- Raise_Error -- | ||
362 | ----------------- | ||
363 | |||
364 | procedure Raise_Error (Message : String) is | ||
365 | begin | ||
366 | Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message); | ||
367 | end Raise_Error; | ||
368 | |||
369 | procedure Raise_Error (Stream : Z_Stream) is | ||
370 | begin | ||
371 | Raise_Error (Last_Error_Message (Stream)); | ||
372 | end Raise_Error; | ||
373 | |||
374 | ---------- | ||
375 | -- Read -- | ||
376 | ---------- | ||
377 | |||
378 | procedure Read | ||
379 | (Filter : in out Filter_Type; | ||
380 | Item : out Ada.Streams.Stream_Element_Array; | ||
381 | Last : out Ada.Streams.Stream_Element_Offset) | ||
382 | is | ||
383 | In_Last : Stream_Element_Offset; | ||
384 | Item_First : Ada.Streams.Stream_Element_Offset := Item'First; | ||
385 | |||
386 | begin | ||
387 | pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1); | ||
388 | |||
389 | loop | ||
390 | if Rest_First > Buffer'Last then | ||
391 | Read (Buffer, Rest_Last); | ||
392 | Rest_First := Buffer'First; | ||
393 | end if; | ||
394 | |||
395 | pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last); | ||
396 | |||
397 | Translate | ||
398 | (Filter => Filter, | ||
399 | In_Data => Buffer (Rest_First .. Rest_Last), | ||
400 | In_Last => In_Last, | ||
401 | Out_Data => Item (Item_First .. Item'Last), | ||
402 | Out_Last => Last, | ||
403 | Flush => Flush_Finish (Rest_Last < Rest_First)); | ||
404 | |||
405 | Rest_First := In_Last + 1; | ||
406 | |||
407 | exit when Last = Item'Last or else Stream_End (Filter); | ||
408 | |||
409 | Item_First := Last + 1; | ||
410 | end loop; | ||
411 | end Read; | ||
412 | |||
413 | ---------------- | ||
414 | -- Stream_End -- | ||
415 | ---------------- | ||
416 | |||
417 | function Stream_End (Filter : in Filter_Type) return Boolean is | ||
418 | begin | ||
419 | if Filter.Header = GZip and Filter.Compression then | ||
420 | return Filter.Stream_End | ||
421 | and then Filter.Offset = Footer_Array'Last + 1; | ||
422 | else | ||
423 | return Filter.Stream_End; | ||
424 | end if; | ||
425 | end Stream_End; | ||
426 | |||
427 | -------------- | ||
428 | -- Total_In -- | ||
429 | -------------- | ||
430 | |||
431 | function Total_In (Filter : in Filter_Type) return Count is | ||
432 | begin | ||
433 | return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all)); | ||
434 | end Total_In; | ||
435 | |||
436 | --------------- | ||
437 | -- Total_Out -- | ||
438 | --------------- | ||
439 | |||
440 | function Total_Out (Filter : in Filter_Type) return Count is | ||
441 | begin | ||
442 | return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all)); | ||
443 | end Total_Out; | ||
444 | |||
445 | --------------- | ||
446 | -- Translate -- | ||
447 | --------------- | ||
448 | |||
449 | procedure Translate | ||
450 | (Filter : in out Filter_Type; | ||
451 | In_Data : in Ada.Streams.Stream_Element_Array; | ||
452 | In_Last : out Ada.Streams.Stream_Element_Offset; | ||
453 | Out_Data : out Ada.Streams.Stream_Element_Array; | ||
454 | Out_Last : out Ada.Streams.Stream_Element_Offset; | ||
455 | Flush : in Flush_Mode) is | ||
456 | begin | ||
457 | if Filter.Header = GZip and then Filter.Compression then | ||
458 | Translate_GZip | ||
459 | (Filter => Filter, | ||
460 | In_Data => In_Data, | ||
461 | In_Last => In_Last, | ||
462 | Out_Data => Out_Data, | ||
463 | Out_Last => Out_Last, | ||
464 | Flush => Flush); | ||
465 | else | ||
466 | Translate_Auto | ||
467 | (Filter => Filter, | ||
468 | In_Data => In_Data, | ||
469 | In_Last => In_Last, | ||
470 | Out_Data => Out_Data, | ||
471 | Out_Last => Out_Last, | ||
472 | Flush => Flush); | ||
473 | end if; | ||
474 | end Translate; | ||
475 | |||
476 | -------------------- | ||
477 | -- Translate_Auto -- | ||
478 | -------------------- | ||
479 | |||
480 | procedure Translate_Auto | ||
481 | (Filter : in out Filter_Type; | ||
482 | In_Data : in Ada.Streams.Stream_Element_Array; | ||
483 | In_Last : out Ada.Streams.Stream_Element_Offset; | ||
484 | Out_Data : out Ada.Streams.Stream_Element_Array; | ||
485 | Out_Last : out Ada.Streams.Stream_Element_Offset; | ||
486 | Flush : in Flush_Mode) | ||
487 | is | ||
488 | use type Thin.Int; | ||
489 | Code : Thin.Int; | ||
490 | |||
491 | begin | ||
492 | if Filter.Opened = False then | ||
493 | raise ZLib_Error; | ||
494 | end if; | ||
495 | |||
496 | if Out_Data'Length = 0 then | ||
497 | raise Constraint_Error; | ||
498 | end if; | ||
499 | |||
500 | Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length); | ||
501 | Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length); | ||
502 | |||
503 | Code := Flate (Filter.Compression).Step | ||
504 | (To_Thin_Access (Filter.Strm), | ||
505 | Thin.Int (Flush)); | ||
506 | |||
507 | if Code = Thin.Z_STREAM_END then | ||
508 | Filter.Stream_End := True; | ||
509 | else | ||
510 | Check_Error (Filter.Strm.all, Code); | ||
511 | end if; | ||
512 | |||
513 | In_Last := In_Data'Last | ||
514 | - Stream_Element_Offset (Avail_In (Filter.Strm.all)); | ||
515 | Out_Last := Out_Data'Last | ||
516 | - Stream_Element_Offset (Avail_Out (Filter.Strm.all)); | ||
517 | |||
518 | end Translate_Auto; | ||
519 | |||
520 | -------------------- | ||
521 | -- Translate_GZip -- | ||
522 | -------------------- | ||
523 | |||
524 | procedure Translate_GZip | ||
525 | (Filter : in out Filter_Type; | ||
526 | In_Data : in Ada.Streams.Stream_Element_Array; | ||
527 | In_Last : out Ada.Streams.Stream_Element_Offset; | ||
528 | Out_Data : out Ada.Streams.Stream_Element_Array; | ||
529 | Out_Last : out Ada.Streams.Stream_Element_Offset; | ||
530 | Flush : in Flush_Mode) | ||
531 | is | ||
532 | Out_First : Stream_Element_Offset; | ||
533 | |||
534 | procedure Add_Data (Data : in Stream_Element_Array); | ||
535 | -- Add data to stream from the Filter.Offset till necessary, | ||
536 | -- used for add gzip headr/footer. | ||
537 | |||
538 | procedure Put_32 | ||
539 | (Item : in out Stream_Element_Array; | ||
540 | Data : in Unsigned_32); | ||
541 | pragma Inline (Put_32); | ||
542 | |||
543 | -------------- | ||
544 | -- Add_Data -- | ||
545 | -------------- | ||
546 | |||
547 | procedure Add_Data (Data : in Stream_Element_Array) is | ||
548 | Data_First : Stream_Element_Offset renames Filter.Offset; | ||
549 | Data_Last : Stream_Element_Offset; | ||
550 | Data_Len : Stream_Element_Offset; -- -1 | ||
551 | Out_Len : Stream_Element_Offset; -- -1 | ||
552 | begin | ||
553 | Out_First := Out_Last + 1; | ||
554 | |||
555 | if Data_First > Data'Last then | ||
556 | return; | ||
557 | end if; | ||
558 | |||
559 | Data_Len := Data'Last - Data_First; | ||
560 | Out_Len := Out_Data'Last - Out_First; | ||
561 | |||
562 | if Data_Len <= Out_Len then | ||
563 | Out_Last := Out_First + Data_Len; | ||
564 | Data_Last := Data'Last; | ||
565 | else | ||
566 | Out_Last := Out_Data'Last; | ||
567 | Data_Last := Data_First + Out_Len; | ||
568 | end if; | ||
569 | |||
570 | Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last); | ||
571 | |||
572 | Data_First := Data_Last + 1; | ||
573 | Out_First := Out_Last + 1; | ||
574 | end Add_Data; | ||
575 | |||
576 | ------------ | ||
577 | -- Put_32 -- | ||
578 | ------------ | ||
579 | |||
580 | procedure Put_32 | ||
581 | (Item : in out Stream_Element_Array; | ||
582 | Data : in Unsigned_32) | ||
583 | is | ||
584 | D : Unsigned_32 := Data; | ||
585 | begin | ||
586 | for J in Item'First .. Item'First + 3 loop | ||
587 | Item (J) := Stream_Element (D and 16#FF#); | ||
588 | D := Shift_Right (D, 8); | ||
589 | end loop; | ||
590 | end Put_32; | ||
591 | |||
592 | begin | ||
593 | Out_Last := Out_Data'First - 1; | ||
594 | |||
595 | if not Filter.Stream_End then | ||
596 | Add_Data (Simple_GZip_Header); | ||
597 | |||
598 | Translate_Auto | ||
599 | (Filter => Filter, | ||
600 | In_Data => In_Data, | ||
601 | In_Last => In_Last, | ||
602 | Out_Data => Out_Data (Out_First .. Out_Data'Last), | ||
603 | Out_Last => Out_Last, | ||
604 | Flush => Flush); | ||
605 | |||
606 | CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last)); | ||
607 | |||
608 | end if; | ||
609 | |||
610 | if Filter.Stream_End and then Out_Last <= Out_Data'Last then | ||
611 | -- This detection method would work only when | ||
612 | -- Simple_GZip_Header'Last > Footer_Array'Last | ||
613 | |||
614 | if Filter.Offset = Simple_GZip_Header'Last + 1 then | ||
615 | Filter.Offset := Footer_Array'First; | ||
616 | end if; | ||
617 | |||
618 | declare | ||
619 | Footer : Footer_Array; | ||
620 | begin | ||
621 | Put_32 (Footer, Filter.CRC); | ||
622 | Put_32 (Footer (Footer'First + 4 .. Footer'Last), | ||
623 | Unsigned_32 (Total_In (Filter))); | ||
624 | Add_Data (Footer); | ||
625 | end; | ||
626 | end if; | ||
627 | end Translate_GZip; | ||
628 | |||
629 | ------------- | ||
630 | -- Version -- | ||
631 | ------------- | ||
632 | |||
633 | function Version return String is | ||
634 | begin | ||
635 | return Interfaces.C.Strings.Value (Thin.zlibVersion); | ||
636 | end Version; | ||
637 | |||
638 | ----------- | ||
639 | -- Write -- | ||
640 | ----------- | ||
641 | |||
642 | procedure Write | ||
643 | (Filter : in out Filter_Type; | ||
644 | Item : in Ada.Streams.Stream_Element_Array; | ||
645 | Flush : in Flush_Mode) | ||
646 | is | ||
647 | Buffer : Stream_Element_Array (1 .. Buffer_Size); | ||
648 | In_Last, Out_Last : Stream_Element_Offset; | ||
649 | In_First : Stream_Element_Offset := Item'First; | ||
650 | begin | ||
651 | if Item'Length = 0 and Flush = No_Flush then | ||
652 | return; | ||
653 | end if; | ||
654 | |||
655 | loop | ||
656 | Translate | ||
657 | (Filter => Filter, | ||
658 | In_Data => Item (In_First .. Item'Last), | ||
659 | In_Last => In_Last, | ||
660 | Out_Data => Buffer, | ||
661 | Out_Last => Out_Last, | ||
662 | Flush => Flush); | ||
663 | |||
664 | if Out_Last >= Buffer'First then | ||
665 | Write (Buffer (1 .. Out_Last)); | ||
666 | end if; | ||
667 | |||
668 | exit when In_Last = Item'Last or Stream_End (Filter); | ||
669 | |||
670 | In_First := In_Last + 1; | ||
671 | end loop; | ||
672 | end Write; | ||
673 | |||
674 | end ZLib; | ||