1 ----------------------------------------------------------------
2 -- ZLib for Ada thick binding. --
4 -- Copyright (C) 2002-2003 Dmitriy Anisimkov --
6 -- Open source license information is in the zlib.ads file. --
7 ----------------------------------------------------------------
9 -- $Id: zlib.adb,v 1.19 2003/07/13 16:02:19 vagul Exp $
12 with Ada.Unchecked_Conversion;
13 with Ada.Unchecked_Deallocation;
15 with Interfaces.C.Strings;
23 type Z_Stream is new Thin.Z_Stream;
25 type Return_Code_Enum is
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);
40 type Flate_End_Function is access
41 function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
42 pragma Convention (C, Flate_End_Function);
44 type Flate_Type is record
45 Step : Flate_Step_Function;
46 Done : Flate_End_Function;
49 subtype Footer_Array is Stream_Element_Array (1 .. 8);
51 Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
52 := (16#1f#, 16#8b#, -- Magic header
55 16#00#, 16#00#, 16#00#, 16#00#, -- Time
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.
65 Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
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));
82 Flush_Finish : constant array (Boolean) of Flush_Mode
83 := (True => Finish, False => No_Flush);
85 procedure Raise_Error (Stream : Z_Stream);
86 pragma Inline (Raise_Error);
88 procedure Raise_Error (Message : String);
89 pragma Inline (Raise_Error);
91 procedure Check_Error (Stream : Z_Stream; Code : Thin.Int);
93 procedure Free is new Ada.Unchecked_Deallocation
94 (Z_Stream, Z_Stream_Access);
96 function To_Thin_Access is new Ada.Unchecked_Conversion
97 (Z_Stream_Access, Thin.Z_Streamp);
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.
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.
121 procedure Check_Error (Stream : Z_Stream; Code : Thin.Int) is
124 if Code /= Thin.Z_OK then
126 (Return_Code_Enum'Image (Return_Code (Code))
127 & ": " & Last_Error_Message (Stream));
136 (Filter : in out Filter_Type;
137 Ignore_Error : in Boolean := False)
141 Code := Flate (Filter.Compression).Done
142 (To_Thin_Access (Filter.Strm));
144 Filter.Opened := False;
146 if Ignore_Error or else Code = Thin.Z_OK then
150 Error_Message : constant String
151 := Last_Error_Message (Filter.Strm.all);
154 Ada.Exceptions.Raise_Exception
155 (ZLib_Error'Identity,
156 Return_Code_Enum'Image (Return_Code (Code))
157 & ": " & Error_Message);
167 (CRC : in Unsigned_32;
168 Data : in Ada.Streams.Stream_Element_Array)
173 return Unsigned_32 (crc32
175 Bytes.To_Pointer (Data'Address),
180 (CRC : in out Unsigned_32;
181 Data : in Ada.Streams.Stream_Element_Array) is
183 CRC := CRC32 (CRC, Data);
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)
200 Win_Bits : Thin.Int := Thin.Int (Window_Bits);
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
206 if Header = None or else Header = GZip then
207 Win_Bits := -Win_Bits;
210 -- For the GZip CRC calculation and make headers.
212 if Header = GZip then
214 Filter.Offset := Simple_GZip_Header'First;
216 Filter.Offset := Simple_GZip_Header'Last + 1;
219 Filter.Strm := new Z_Stream;
220 Filter.Compression := True;
221 Filter.Stream_End := False;
222 Filter.Opened := True;
223 Filter.Header := Header;
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
233 Raise_Error (Filter.Strm.all);
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)
247 No_Data : Stream_Element_Array := (1 .. 0 => 0);
248 Last : Stream_Element_Offset;
250 Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
253 -----------------------
254 -- Generic_Translate --
255 -----------------------
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)
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;
272 Data_In (In_Buffer, Last);
274 In_First := In_Buffer'First;
279 In_Buffer (In_First .. Last),
283 Flush_Finish (Last < In_Buffer'First));
285 Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
287 exit Main when Stream_End (Filter);
289 -- The end of in buffer.
290 exit when In_Last = Last;
292 In_First := In_Last + 1;
296 end Generic_Translate;
302 procedure Inflate_Init
303 (Filter : in out Filter_Type;
304 Window_Bits : in Window_Bits_Type := 15;
305 Header : in Header_Type := Default)
308 Win_Bits : Thin.Int := Thin.Int (Window_Bits);
310 procedure Check_Version;
311 -- Check the latest header types compatibility.
313 procedure Check_Version is
315 if Version <= "1.1.4" then
317 ("Inflate header type " & Header_Type'Image (Header)
318 & " incompatible with ZLib version " & Version);
327 -- Inflate data without headers determined
328 -- by negative Win_Bits.
330 Win_Bits := -Win_Bits;
334 -- Inflate gzip data defined by flag 16.
336 Win_Bits := Win_Bits + 16;
340 -- Inflate with automatic detection
341 -- of gzip or native header defined by flag 32.
343 Win_Bits := Win_Bits + 32;
344 when Default => null;
347 Filter.Strm := new Z_Stream;
348 Filter.Compression := False;
349 Filter.Stream_End := False;
350 Filter.Opened := True;
351 Filter.Header := Header;
354 (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
356 Raise_Error (Filter.Strm.all);
364 procedure Raise_Error (Message : String) is
366 Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
369 procedure Raise_Error (Stream : Z_Stream) is
371 Raise_Error (Last_Error_Message (Stream));
379 (Filter : in out Filter_Type;
380 Item : out Ada.Streams.Stream_Element_Array;
381 Last : out Ada.Streams.Stream_Element_Offset)
383 In_Last : Stream_Element_Offset;
384 Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
387 pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
390 if Rest_First > Buffer'Last then
391 Read (Buffer, Rest_Last);
392 Rest_First := Buffer'First;
395 pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
399 In_Data => Buffer (Rest_First .. Rest_Last),
401 Out_Data => Item (Item_First .. Item'Last),
403 Flush => Flush_Finish (Rest_Last < Rest_First));
405 Rest_First := In_Last + 1;
407 exit when Last = Item'Last or else Stream_End (Filter);
409 Item_First := Last + 1;
417 function Stream_End (Filter : in Filter_Type) return Boolean is
419 if Filter.Header = GZip and Filter.Compression then
420 return Filter.Stream_End
421 and then Filter.Offset = Footer_Array'Last + 1;
423 return Filter.Stream_End;
431 function Total_In (Filter : in Filter_Type) return Count is
433 return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
440 function Total_Out (Filter : in Filter_Type) return Count is
442 return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
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
457 if Filter.Header = GZip and then Filter.Compression then
462 Out_Data => Out_Data,
463 Out_Last => Out_Last,
470 Out_Data => Out_Data,
471 Out_Last => Out_Last,
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)
492 if Filter.Opened = False then
496 if Out_Data'Length = 0 then
497 raise Constraint_Error;
500 Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
501 Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
503 Code := Flate (Filter.Compression).Step
504 (To_Thin_Access (Filter.Strm),
507 if Code = Thin.Z_STREAM_END then
508 Filter.Stream_End := True;
510 Check_Error (Filter.Strm.all, Code);
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));
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)
532 Out_First : Stream_Element_Offset;
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.
539 (Item : in out Stream_Element_Array;
540 Data : in Unsigned_32);
541 pragma Inline (Put_32);
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
553 Out_First := Out_Last + 1;
555 if Data_First > Data'Last then
559 Data_Len := Data'Last - Data_First;
560 Out_Len := Out_Data'Last - Out_First;
562 if Data_Len <= Out_Len then
563 Out_Last := Out_First + Data_Len;
564 Data_Last := Data'Last;
566 Out_Last := Out_Data'Last;
567 Data_Last := Data_First + Out_Len;
570 Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
572 Data_First := Data_Last + 1;
573 Out_First := Out_Last + 1;
581 (Item : in out Stream_Element_Array;
582 Data : in Unsigned_32)
584 D : Unsigned_32 := Data;
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);
593 Out_Last := Out_Data'First - 1;
595 if not Filter.Stream_End then
596 Add_Data (Simple_GZip_Header);
602 Out_Data => Out_Data (Out_First .. Out_Data'Last),
603 Out_Last => Out_Last,
606 CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
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
614 if Filter.Offset = Simple_GZip_Header'Last + 1 then
615 Filter.Offset := Footer_Array'First;
619 Footer : Footer_Array;
621 Put_32 (Footer, Filter.CRC);
622 Put_32 (Footer (Footer'First + 4 .. Footer'Last),
623 Unsigned_32 (Total_In (Filter)));
633 function Version return String is
635 return Interfaces.C.Strings.Value (Thin.zlibVersion);
643 (Filter : in out Filter_Type;
644 Item : in Ada.Streams.Stream_Element_Array;
645 Flush : in Flush_Mode)
647 Buffer : Stream_Element_Array (1 .. Buffer_Size);
648 In_Last, Out_Last : Stream_Element_Offset;
649 In_First : Stream_Element_Offset := Item'First;
651 if Item'Length = 0 and Flush = No_Flush then
658 In_Data => Item (In_First .. Item'Last),
661 Out_Last => Out_Last,
664 if Out_Last >= Buffer'First then
665 Write (Buffer (1 .. Out_Last));
668 exit when In_Last = Item'Last or Stream_End (Filter);
670 In_First := In_Last + 1;