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