702 lines
		
	
	
		
			20 KiB
		
	
	
	
		
			Ada
		
	
	
	
	
	
			
		
		
	
	
			702 lines
		
	
	
		
			20 KiB
		
	
	
	
		
			Ada
		
	
	
	
	
	
----------------------------------------------------------------
 | 
						|
--  ZLib for Ada thick binding.                               --
 | 
						|
--                                                            --
 | 
						|
--  Copyright (C) 2002-2004 Dmitriy Anisimkov                 --
 | 
						|
--                                                            --
 | 
						|
--  Open source license information is in the zlib.ads file.  --
 | 
						|
----------------------------------------------------------------
 | 
						|
 | 
						|
--  $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
 | 
						|
 | 
						|
with Ada.Exceptions;
 | 
						|
with Ada.Unchecked_Conversion;
 | 
						|
with Ada.Unchecked_Deallocation;
 | 
						|
 | 
						|
with Interfaces.C.Strings;
 | 
						|
 | 
						|
with ZLib.Thin;
 | 
						|
 | 
						|
package body ZLib is
 | 
						|
 | 
						|
   use type Thin.Int;
 | 
						|
 | 
						|
   type Z_Stream is new Thin.Z_Stream;
 | 
						|
 | 
						|
   type Return_Code_Enum is
 | 
						|
      (OK,
 | 
						|
       STREAM_END,
 | 
						|
       NEED_DICT,
 | 
						|
       ERRNO,
 | 
						|
       STREAM_ERROR,
 | 
						|
       DATA_ERROR,
 | 
						|
       MEM_ERROR,
 | 
						|
       BUF_ERROR,
 | 
						|
       VERSION_ERROR);
 | 
						|
 | 
						|
   type Flate_Step_Function is access
 | 
						|
     function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
 | 
						|
   pragma Convention (C, Flate_Step_Function);
 | 
						|
 | 
						|
   type Flate_End_Function is access
 | 
						|
      function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
 | 
						|
   pragma Convention (C, Flate_End_Function);
 | 
						|
 | 
						|
   type Flate_Type is record
 | 
						|
      Step : Flate_Step_Function;
 | 
						|
      Done : Flate_End_Function;
 | 
						|
   end record;
 | 
						|
 | 
						|
   subtype Footer_Array is Stream_Element_Array (1 .. 8);
 | 
						|
 | 
						|
   Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
 | 
						|
     := (16#1f#, 16#8b#,                 --  Magic header
 | 
						|
         16#08#,                         --  Z_DEFLATED
 | 
						|
         16#00#,                         --  Flags
 | 
						|
         16#00#, 16#00#, 16#00#, 16#00#, --  Time
 | 
						|
         16#00#,                         --  XFlags
 | 
						|
         16#03#                          --  OS code
 | 
						|
        );
 | 
						|
   --  The simplest gzip header is not for informational, but just for
 | 
						|
   --  gzip format compatibility.
 | 
						|
   --  Note that some code below is using assumption
 | 
						|
   --  Simple_GZip_Header'Last > Footer_Array'Last, so do not make
 | 
						|
   --  Simple_GZip_Header'Last <= Footer_Array'Last.
 | 
						|
 | 
						|
   Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
 | 
						|
     := (0 => OK,
 | 
						|
         1 => STREAM_END,
 | 
						|
         2 => NEED_DICT,
 | 
						|
        -1 => ERRNO,
 | 
						|
        -2 => STREAM_ERROR,
 | 
						|
        -3 => DATA_ERROR,
 | 
						|
        -4 => MEM_ERROR,
 | 
						|
        -5 => BUF_ERROR,
 | 
						|
        -6 => VERSION_ERROR);
 | 
						|
 | 
						|
   Flate : constant array (Boolean) of Flate_Type
 | 
						|
     := (True  => (Step => Thin.Deflate'Access,
 | 
						|
                   Done => Thin.DeflateEnd'Access),
 | 
						|
         False => (Step => Thin.Inflate'Access,
 | 
						|
                   Done => Thin.InflateEnd'Access));
 | 
						|
 | 
						|
   Flush_Finish : constant array (Boolean) of Flush_Mode
 | 
						|
     := (True => Finish, False => No_Flush);
 | 
						|
 | 
						|
   procedure Raise_Error (Stream : in Z_Stream);
 | 
						|
   pragma Inline (Raise_Error);
 | 
						|
 | 
						|
   procedure Raise_Error (Message : in String);
 | 
						|
   pragma Inline (Raise_Error);
 | 
						|
 | 
						|
   procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
 | 
						|
 | 
						|
   procedure Free is new Ada.Unchecked_Deallocation
 | 
						|
      (Z_Stream, Z_Stream_Access);
 | 
						|
 | 
						|
   function To_Thin_Access is new Ada.Unchecked_Conversion
 | 
						|
     (Z_Stream_Access, Thin.Z_Streamp);
 | 
						|
 | 
						|
   procedure Translate_GZip
 | 
						|
     (Filter    : in out Filter_Type;
 | 
						|
      In_Data   : in     Ada.Streams.Stream_Element_Array;
 | 
						|
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush     : in     Flush_Mode);
 | 
						|
   --  Separate translate routine for make gzip header.
 | 
						|
 | 
						|
   procedure Translate_Auto
 | 
						|
     (Filter    : in out Filter_Type;
 | 
						|
      In_Data   : in     Ada.Streams.Stream_Element_Array;
 | 
						|
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush     : in     Flush_Mode);
 | 
						|
   --  translate routine without additional headers.
 | 
						|
 | 
						|
   -----------------
 | 
						|
   -- Check_Error --
 | 
						|
   -----------------
 | 
						|
 | 
						|
   procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
 | 
						|
      use type Thin.Int;
 | 
						|
   begin
 | 
						|
      if Code /= Thin.Z_OK then
 | 
						|
         Raise_Error
 | 
						|
            (Return_Code_Enum'Image (Return_Code (Code))
 | 
						|
              & ": " & Last_Error_Message (Stream));
 | 
						|
      end if;
 | 
						|
   end Check_Error;
 | 
						|
 | 
						|
   -----------
 | 
						|
   -- Close --
 | 
						|
   -----------
 | 
						|
 | 
						|
   procedure Close
 | 
						|
     (Filter       : in out Filter_Type;
 | 
						|
      Ignore_Error : in     Boolean := False)
 | 
						|
   is
 | 
						|
      Code : Thin.Int;
 | 
						|
   begin
 | 
						|
      if not Ignore_Error and then not Is_Open (Filter) then
 | 
						|
         raise Status_Error;
 | 
						|
      end if;
 | 
						|
 | 
						|
      Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
 | 
						|
 | 
						|
      if Ignore_Error or else Code = Thin.Z_OK then
 | 
						|
         Free (Filter.Strm);
 | 
						|
      else
 | 
						|
         declare
 | 
						|
            Error_Message : constant String
 | 
						|
              := Last_Error_Message (Filter.Strm.all);
 | 
						|
         begin
 | 
						|
            Free (Filter.Strm);
 | 
						|
            Ada.Exceptions.Raise_Exception
 | 
						|
               (ZLib_Error'Identity,
 | 
						|
                Return_Code_Enum'Image (Return_Code (Code))
 | 
						|
                  & ": " & Error_Message);
 | 
						|
         end;
 | 
						|
      end if;
 | 
						|
   end Close;
 | 
						|
 | 
						|
   -----------
 | 
						|
   -- CRC32 --
 | 
						|
   -----------
 | 
						|
 | 
						|
   function CRC32
 | 
						|
     (CRC  : in Unsigned_32;
 | 
						|
      Data : in Ada.Streams.Stream_Element_Array)
 | 
						|
      return Unsigned_32
 | 
						|
   is
 | 
						|
      use Thin;
 | 
						|
   begin
 | 
						|
      return Unsigned_32 (crc32 (ULong (CRC),
 | 
						|
                                 Data'Address,
 | 
						|
                                 Data'Length));
 | 
						|
   end CRC32;
 | 
						|
 | 
						|
   procedure CRC32
 | 
						|
     (CRC  : in out Unsigned_32;
 | 
						|
      Data : in     Ada.Streams.Stream_Element_Array) is
 | 
						|
   begin
 | 
						|
      CRC := CRC32 (CRC, Data);
 | 
						|
   end CRC32;
 | 
						|
 | 
						|
   ------------------
 | 
						|
   -- Deflate_Init --
 | 
						|
   ------------------
 | 
						|
 | 
						|
   procedure Deflate_Init
 | 
						|
     (Filter       : in out Filter_Type;
 | 
						|
      Level        : in     Compression_Level  := Default_Compression;
 | 
						|
      Strategy     : in     Strategy_Type      := Default_Strategy;
 | 
						|
      Method       : in     Compression_Method := Deflated;
 | 
						|
      Window_Bits  : in     Window_Bits_Type   := Default_Window_Bits;
 | 
						|
      Memory_Level : in     Memory_Level_Type  := Default_Memory_Level;
 | 
						|
      Header       : in     Header_Type        := Default)
 | 
						|
   is
 | 
						|
      use type Thin.Int;
 | 
						|
      Win_Bits : Thin.Int := Thin.Int (Window_Bits);
 | 
						|
   begin
 | 
						|
      if Is_Open (Filter) then
 | 
						|
         raise Status_Error;
 | 
						|
      end if;
 | 
						|
 | 
						|
      --  We allow ZLib to make header only in case of default header type.
 | 
						|
      --  Otherwise we would either do header by ourselfs, or do not do
 | 
						|
      --  header at all.
 | 
						|
 | 
						|
      if Header = None or else Header = GZip then
 | 
						|
         Win_Bits := -Win_Bits;
 | 
						|
      end if;
 | 
						|
 | 
						|
      --  For the GZip CRC calculation and make headers.
 | 
						|
 | 
						|
      if Header = GZip then
 | 
						|
         Filter.CRC    := 0;
 | 
						|
         Filter.Offset := Simple_GZip_Header'First;
 | 
						|
      else
 | 
						|
         Filter.Offset := Simple_GZip_Header'Last + 1;
 | 
						|
      end if;
 | 
						|
 | 
						|
      Filter.Strm        := new Z_Stream;
 | 
						|
      Filter.Compression := True;
 | 
						|
      Filter.Stream_End  := False;
 | 
						|
      Filter.Header      := Header;
 | 
						|
 | 
						|
      if Thin.Deflate_Init
 | 
						|
           (To_Thin_Access (Filter.Strm),
 | 
						|
            Level      => Thin.Int (Level),
 | 
						|
            method     => Thin.Int (Method),
 | 
						|
            windowBits => Win_Bits,
 | 
						|
            memLevel   => Thin.Int (Memory_Level),
 | 
						|
            strategy   => Thin.Int (Strategy)) /= Thin.Z_OK
 | 
						|
      then
 | 
						|
         Raise_Error (Filter.Strm.all);
 | 
						|
      end if;
 | 
						|
   end Deflate_Init;
 | 
						|
 | 
						|
   -----------
 | 
						|
   -- Flush --
 | 
						|
   -----------
 | 
						|
 | 
						|
   procedure Flush
 | 
						|
     (Filter    : in out Filter_Type;
 | 
						|
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush     : in     Flush_Mode)
 | 
						|
   is
 | 
						|
      No_Data : Stream_Element_Array := (1 .. 0 => 0);
 | 
						|
      Last    : Stream_Element_Offset;
 | 
						|
   begin
 | 
						|
      Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
 | 
						|
   end Flush;
 | 
						|
 | 
						|
   -----------------------
 | 
						|
   -- Generic_Translate --
 | 
						|
   -----------------------
 | 
						|
 | 
						|
   procedure Generic_Translate
 | 
						|
     (Filter          : in out ZLib.Filter_Type;
 | 
						|
      In_Buffer_Size  : in     Integer := Default_Buffer_Size;
 | 
						|
      Out_Buffer_Size : in     Integer := Default_Buffer_Size)
 | 
						|
   is
 | 
						|
      In_Buffer  : Stream_Element_Array
 | 
						|
                     (1 .. Stream_Element_Offset (In_Buffer_Size));
 | 
						|
      Out_Buffer : Stream_Element_Array
 | 
						|
                     (1 .. Stream_Element_Offset (Out_Buffer_Size));
 | 
						|
      Last       : Stream_Element_Offset;
 | 
						|
      In_Last    : Stream_Element_Offset;
 | 
						|
      In_First   : Stream_Element_Offset;
 | 
						|
      Out_Last   : Stream_Element_Offset;
 | 
						|
   begin
 | 
						|
      Main : loop
 | 
						|
         Data_In (In_Buffer, Last);
 | 
						|
 | 
						|
         In_First := In_Buffer'First;
 | 
						|
 | 
						|
         loop
 | 
						|
            Translate
 | 
						|
              (Filter   => Filter,
 | 
						|
               In_Data  => In_Buffer (In_First .. Last),
 | 
						|
               In_Last  => In_Last,
 | 
						|
               Out_Data => Out_Buffer,
 | 
						|
               Out_Last => Out_Last,
 | 
						|
               Flush    => Flush_Finish (Last < In_Buffer'First));
 | 
						|
 | 
						|
            if Out_Buffer'First <= Out_Last then
 | 
						|
               Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
 | 
						|
            end if;
 | 
						|
 | 
						|
            exit Main when Stream_End (Filter);
 | 
						|
 | 
						|
            --  The end of in buffer.
 | 
						|
 | 
						|
            exit when In_Last = Last;
 | 
						|
 | 
						|
            In_First := In_Last + 1;
 | 
						|
         end loop;
 | 
						|
      end loop Main;
 | 
						|
 | 
						|
   end Generic_Translate;
 | 
						|
 | 
						|
   ------------------
 | 
						|
   -- Inflate_Init --
 | 
						|
   ------------------
 | 
						|
 | 
						|
   procedure Inflate_Init
 | 
						|
     (Filter      : in out Filter_Type;
 | 
						|
      Window_Bits : in     Window_Bits_Type := Default_Window_Bits;
 | 
						|
      Header      : in     Header_Type      := Default)
 | 
						|
   is
 | 
						|
      use type Thin.Int;
 | 
						|
      Win_Bits : Thin.Int := Thin.Int (Window_Bits);
 | 
						|
 | 
						|
      procedure Check_Version;
 | 
						|
      --  Check the latest header types compatibility.
 | 
						|
 | 
						|
      procedure Check_Version is
 | 
						|
      begin
 | 
						|
         if Version <= "1.1.4" then
 | 
						|
            Raise_Error
 | 
						|
              ("Inflate header type " & Header_Type'Image (Header)
 | 
						|
               & " incompatible with ZLib version " & Version);
 | 
						|
         end if;
 | 
						|
      end Check_Version;
 | 
						|
 | 
						|
   begin
 | 
						|
      if Is_Open (Filter) then
 | 
						|
         raise Status_Error;
 | 
						|
      end if;
 | 
						|
 | 
						|
      case Header is
 | 
						|
         when None =>
 | 
						|
            Check_Version;
 | 
						|
 | 
						|
            --  Inflate data without headers determined
 | 
						|
            --  by negative Win_Bits.
 | 
						|
 | 
						|
            Win_Bits := -Win_Bits;
 | 
						|
         when GZip =>
 | 
						|
            Check_Version;
 | 
						|
 | 
						|
            --  Inflate gzip data defined by flag 16.
 | 
						|
 | 
						|
            Win_Bits := Win_Bits + 16;
 | 
						|
         when Auto =>
 | 
						|
            Check_Version;
 | 
						|
 | 
						|
            --  Inflate with automatic detection
 | 
						|
            --  of gzip or native header defined by flag 32.
 | 
						|
 | 
						|
            Win_Bits := Win_Bits + 32;
 | 
						|
         when Default => null;
 | 
						|
      end case;
 | 
						|
 | 
						|
      Filter.Strm        := new Z_Stream;
 | 
						|
      Filter.Compression := False;
 | 
						|
      Filter.Stream_End  := False;
 | 
						|
      Filter.Header      := Header;
 | 
						|
 | 
						|
      if Thin.Inflate_Init
 | 
						|
         (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
 | 
						|
      then
 | 
						|
         Raise_Error (Filter.Strm.all);
 | 
						|
      end if;
 | 
						|
   end Inflate_Init;
 | 
						|
 | 
						|
   -------------
 | 
						|
   -- Is_Open --
 | 
						|
   -------------
 | 
						|
 | 
						|
   function Is_Open (Filter : in Filter_Type) return Boolean is
 | 
						|
   begin
 | 
						|
      return Filter.Strm /= null;
 | 
						|
   end Is_Open;
 | 
						|
 | 
						|
   -----------------
 | 
						|
   -- Raise_Error --
 | 
						|
   -----------------
 | 
						|
 | 
						|
   procedure Raise_Error (Message : in String) is
 | 
						|
   begin
 | 
						|
      Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
 | 
						|
   end Raise_Error;
 | 
						|
 | 
						|
   procedure Raise_Error (Stream : in Z_Stream) is
 | 
						|
   begin
 | 
						|
      Raise_Error (Last_Error_Message (Stream));
 | 
						|
   end Raise_Error;
 | 
						|
 | 
						|
   ----------
 | 
						|
   -- Read --
 | 
						|
   ----------
 | 
						|
 | 
						|
   procedure Read
 | 
						|
     (Filter : in out Filter_Type;
 | 
						|
      Item   :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Last   :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush  : in     Flush_Mode := No_Flush)
 | 
						|
   is
 | 
						|
      In_Last    : Stream_Element_Offset;
 | 
						|
      Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
 | 
						|
      V_Flush    : Flush_Mode := Flush;
 | 
						|
 | 
						|
   begin
 | 
						|
      pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
 | 
						|
      pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
 | 
						|
 | 
						|
      loop
 | 
						|
         if Rest_Last = Buffer'First - 1 then
 | 
						|
            V_Flush := Finish;
 | 
						|
 | 
						|
         elsif Rest_First > Rest_Last then
 | 
						|
            Read (Buffer, Rest_Last);
 | 
						|
            Rest_First := Buffer'First;
 | 
						|
 | 
						|
            if Rest_Last < Buffer'First then
 | 
						|
               V_Flush := Finish;
 | 
						|
            end if;
 | 
						|
         end if;
 | 
						|
 | 
						|
         Translate
 | 
						|
           (Filter   => Filter,
 | 
						|
            In_Data  => Buffer (Rest_First .. Rest_Last),
 | 
						|
            In_Last  => In_Last,
 | 
						|
            Out_Data => Item (Item_First .. Item'Last),
 | 
						|
            Out_Last => Last,
 | 
						|
            Flush    => V_Flush);
 | 
						|
 | 
						|
         Rest_First := In_Last + 1;
 | 
						|
 | 
						|
         exit when Stream_End (Filter)
 | 
						|
           or else Last = Item'Last
 | 
						|
           or else (Last >= Item'First and then Allow_Read_Some);
 | 
						|
 | 
						|
         Item_First := Last + 1;
 | 
						|
      end loop;
 | 
						|
   end Read;
 | 
						|
 | 
						|
   ----------------
 | 
						|
   -- Stream_End --
 | 
						|
   ----------------
 | 
						|
 | 
						|
   function Stream_End (Filter : in Filter_Type) return Boolean is
 | 
						|
   begin
 | 
						|
      if Filter.Header = GZip and Filter.Compression then
 | 
						|
         return Filter.Stream_End
 | 
						|
            and then Filter.Offset = Footer_Array'Last + 1;
 | 
						|
      else
 | 
						|
         return Filter.Stream_End;
 | 
						|
      end if;
 | 
						|
   end Stream_End;
 | 
						|
 | 
						|
   --------------
 | 
						|
   -- Total_In --
 | 
						|
   --------------
 | 
						|
 | 
						|
   function Total_In (Filter : in Filter_Type) return Count is
 | 
						|
   begin
 | 
						|
      return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
 | 
						|
   end Total_In;
 | 
						|
 | 
						|
   ---------------
 | 
						|
   -- Total_Out --
 | 
						|
   ---------------
 | 
						|
 | 
						|
   function Total_Out (Filter : in Filter_Type) return Count is
 | 
						|
   begin
 | 
						|
      return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
 | 
						|
   end Total_Out;
 | 
						|
 | 
						|
   ---------------
 | 
						|
   -- Translate --
 | 
						|
   ---------------
 | 
						|
 | 
						|
   procedure Translate
 | 
						|
     (Filter    : in out Filter_Type;
 | 
						|
      In_Data   : in     Ada.Streams.Stream_Element_Array;
 | 
						|
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush     : in     Flush_Mode) is
 | 
						|
   begin
 | 
						|
      if Filter.Header = GZip and then Filter.Compression then
 | 
						|
         Translate_GZip
 | 
						|
           (Filter   => Filter,
 | 
						|
            In_Data  => In_Data,
 | 
						|
            In_Last  => In_Last,
 | 
						|
            Out_Data => Out_Data,
 | 
						|
            Out_Last => Out_Last,
 | 
						|
            Flush    => Flush);
 | 
						|
      else
 | 
						|
         Translate_Auto
 | 
						|
           (Filter   => Filter,
 | 
						|
            In_Data  => In_Data,
 | 
						|
            In_Last  => In_Last,
 | 
						|
            Out_Data => Out_Data,
 | 
						|
            Out_Last => Out_Last,
 | 
						|
            Flush    => Flush);
 | 
						|
      end if;
 | 
						|
   end Translate;
 | 
						|
 | 
						|
   --------------------
 | 
						|
   -- Translate_Auto --
 | 
						|
   --------------------
 | 
						|
 | 
						|
   procedure Translate_Auto
 | 
						|
     (Filter    : in out Filter_Type;
 | 
						|
      In_Data   : in     Ada.Streams.Stream_Element_Array;
 | 
						|
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush     : in     Flush_Mode)
 | 
						|
   is
 | 
						|
      use type Thin.Int;
 | 
						|
      Code : Thin.Int;
 | 
						|
 | 
						|
   begin
 | 
						|
      if not Is_Open (Filter) then
 | 
						|
         raise Status_Error;
 | 
						|
      end if;
 | 
						|
 | 
						|
      if Out_Data'Length = 0 and then In_Data'Length = 0 then
 | 
						|
         raise Constraint_Error;
 | 
						|
      end if;
 | 
						|
 | 
						|
      Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
 | 
						|
      Set_In  (Filter.Strm.all, In_Data'Address, In_Data'Length);
 | 
						|
 | 
						|
      Code := Flate (Filter.Compression).Step
 | 
						|
        (To_Thin_Access (Filter.Strm),
 | 
						|
         Thin.Int (Flush));
 | 
						|
 | 
						|
      if Code = Thin.Z_STREAM_END then
 | 
						|
         Filter.Stream_End := True;
 | 
						|
      else
 | 
						|
         Check_Error (Filter.Strm.all, Code);
 | 
						|
      end if;
 | 
						|
 | 
						|
      In_Last  := In_Data'Last
 | 
						|
         - Stream_Element_Offset (Avail_In (Filter.Strm.all));
 | 
						|
      Out_Last := Out_Data'Last
 | 
						|
         - Stream_Element_Offset (Avail_Out (Filter.Strm.all));
 | 
						|
   end Translate_Auto;
 | 
						|
 | 
						|
   --------------------
 | 
						|
   -- Translate_GZip --
 | 
						|
   --------------------
 | 
						|
 | 
						|
   procedure Translate_GZip
 | 
						|
     (Filter    : in out Filter_Type;
 | 
						|
      In_Data   : in     Ada.Streams.Stream_Element_Array;
 | 
						|
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
 | 
						|
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
 | 
						|
      Flush     : in     Flush_Mode)
 | 
						|
   is
 | 
						|
      Out_First : Stream_Element_Offset;
 | 
						|
 | 
						|
      procedure Add_Data (Data : in Stream_Element_Array);
 | 
						|
      --  Add data to stream from the Filter.Offset till necessary,
 | 
						|
      --  used for add gzip headr/footer.
 | 
						|
 | 
						|
      procedure Put_32
 | 
						|
        (Item : in out Stream_Element_Array;
 | 
						|
         Data : in     Unsigned_32);
 | 
						|
      pragma Inline (Put_32);
 | 
						|
 | 
						|
      --------------
 | 
						|
      -- Add_Data --
 | 
						|
      --------------
 | 
						|
 | 
						|
      procedure Add_Data (Data : in Stream_Element_Array) is
 | 
						|
         Data_First : Stream_Element_Offset renames Filter.Offset;
 | 
						|
         Data_Last  : Stream_Element_Offset;
 | 
						|
         Data_Len   : Stream_Element_Offset; --  -1
 | 
						|
         Out_Len    : Stream_Element_Offset; --  -1
 | 
						|
      begin
 | 
						|
         Out_First := Out_Last + 1;
 | 
						|
 | 
						|
         if Data_First > Data'Last then
 | 
						|
            return;
 | 
						|
         end if;
 | 
						|
 | 
						|
         Data_Len  := Data'Last     - Data_First;
 | 
						|
         Out_Len   := Out_Data'Last - Out_First;
 | 
						|
 | 
						|
         if Data_Len <= Out_Len then
 | 
						|
            Out_Last  := Out_First  + Data_Len;
 | 
						|
            Data_Last := Data'Last;
 | 
						|
         else
 | 
						|
            Out_Last  := Out_Data'Last;
 | 
						|
            Data_Last := Data_First + Out_Len;
 | 
						|
         end if;
 | 
						|
 | 
						|
         Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
 | 
						|
 | 
						|
         Data_First := Data_Last + 1;
 | 
						|
         Out_First  := Out_Last + 1;
 | 
						|
      end Add_Data;
 | 
						|
 | 
						|
      ------------
 | 
						|
      -- Put_32 --
 | 
						|
      ------------
 | 
						|
 | 
						|
      procedure Put_32
 | 
						|
        (Item : in out Stream_Element_Array;
 | 
						|
         Data : in     Unsigned_32)
 | 
						|
      is
 | 
						|
         D : Unsigned_32 := Data;
 | 
						|
      begin
 | 
						|
         for J in Item'First .. Item'First + 3 loop
 | 
						|
            Item (J) := Stream_Element (D and 16#FF#);
 | 
						|
            D := Shift_Right (D, 8);
 | 
						|
         end loop;
 | 
						|
      end Put_32;
 | 
						|
 | 
						|
   begin
 | 
						|
      Out_Last := Out_Data'First - 1;
 | 
						|
 | 
						|
      if not Filter.Stream_End then
 | 
						|
         Add_Data (Simple_GZip_Header);
 | 
						|
 | 
						|
         Translate_Auto
 | 
						|
           (Filter   => Filter,
 | 
						|
            In_Data  => In_Data,
 | 
						|
            In_Last  => In_Last,
 | 
						|
            Out_Data => Out_Data (Out_First .. Out_Data'Last),
 | 
						|
            Out_Last => Out_Last,
 | 
						|
            Flush    => Flush);
 | 
						|
 | 
						|
         CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
 | 
						|
      end if;
 | 
						|
 | 
						|
      if Filter.Stream_End and then Out_Last <= Out_Data'Last then
 | 
						|
         --  This detection method would work only when
 | 
						|
         --  Simple_GZip_Header'Last > Footer_Array'Last
 | 
						|
 | 
						|
         if Filter.Offset = Simple_GZip_Header'Last + 1 then
 | 
						|
            Filter.Offset := Footer_Array'First;
 | 
						|
         end if;
 | 
						|
 | 
						|
         declare
 | 
						|
            Footer : Footer_Array;
 | 
						|
         begin
 | 
						|
            Put_32 (Footer, Filter.CRC);
 | 
						|
            Put_32 (Footer (Footer'First + 4 .. Footer'Last),
 | 
						|
                    Unsigned_32 (Total_In (Filter)));
 | 
						|
            Add_Data (Footer);
 | 
						|
         end;
 | 
						|
      end if;
 | 
						|
   end Translate_GZip;
 | 
						|
 | 
						|
   -------------
 | 
						|
   -- Version --
 | 
						|
   -------------
 | 
						|
 | 
						|
   function Version return String is
 | 
						|
   begin
 | 
						|
      return Interfaces.C.Strings.Value (Thin.zlibVersion);
 | 
						|
   end Version;
 | 
						|
 | 
						|
   -----------
 | 
						|
   -- Write --
 | 
						|
   -----------
 | 
						|
 | 
						|
   procedure Write
 | 
						|
     (Filter : in out Filter_Type;
 | 
						|
      Item   : in     Ada.Streams.Stream_Element_Array;
 | 
						|
      Flush  : in     Flush_Mode := No_Flush)
 | 
						|
   is
 | 
						|
      Buffer   : Stream_Element_Array (1 .. Buffer_Size);
 | 
						|
      In_Last  : Stream_Element_Offset;
 | 
						|
      Out_Last : Stream_Element_Offset;
 | 
						|
      In_First : Stream_Element_Offset := Item'First;
 | 
						|
   begin
 | 
						|
      if Item'Length = 0 and Flush = No_Flush then
 | 
						|
         return;
 | 
						|
      end if;
 | 
						|
 | 
						|
      loop
 | 
						|
         Translate
 | 
						|
           (Filter   => Filter,
 | 
						|
            In_Data  => Item (In_First .. Item'Last),
 | 
						|
            In_Last  => In_Last,
 | 
						|
            Out_Data => Buffer,
 | 
						|
            Out_Last => Out_Last,
 | 
						|
            Flush    => Flush);
 | 
						|
 | 
						|
         if Out_Last >= Buffer'First then
 | 
						|
            Write (Buffer (1 .. Out_Last));
 | 
						|
         end if;
 | 
						|
 | 
						|
         exit when In_Last = Item'Last or Stream_End (Filter);
 | 
						|
 | 
						|
         In_First := In_Last + 1;
 | 
						|
      end loop;
 | 
						|
   end Write;
 | 
						|
 | 
						|
end ZLib;
 |