Link zlib statically for windows (#35)
* Add zlib 1.2.11 sources * link zlib statically for windows
This commit is contained in:
		
				
					committed by
					
						 Benjamin Sergeant
						Benjamin Sergeant
					
				
			
			
				
	
			
			
			
						parent
						
							5682129b1d
						
					
				
				
					commit
					f61fd7b7f1
				
			
							
								
								
									
										701
									
								
								third_party/zlib/contrib/ada/zlib.adb
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										701
									
								
								third_party/zlib/contrib/ada/zlib.adb
									
									
									
									
										vendored
									
									
										Normal file
									
								
							| @@ -0,0 +1,701 @@ | ||||
| ---------------------------------------------------------------- | ||||
| --  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; | ||||
		Reference in New Issue
	
	Block a user