| 1 | ------------------------------------------------------------------------------ | 
 
 
 
 
 | 2 | --                      ZLib for Ada thick binding.                         -- | 
 
 
 
 
 | 3 | --                                                                          -- | 
 
 
 
 
 | 4 | --              Copyright (C) 2002-2004 Dmitriy Anisimkov                   -- | 
 
 
 
 
 | 5 | --                                                                          -- | 
 
 
 
 
 | 6 | --  This library is free software; you can redistribute it and/or modify    -- | 
 
 
 
 
 | 7 | --  it under the terms of the GNU General Public License as published by    -- | 
 
 
 
 
 | 8 | --  the Free Software Foundation; either version 2 of the License, or (at   -- | 
 
 
 
 
 | 9 | --  your option) any later version.                                         -- | 
 
 
 
 
 | 10 | --                                                                          -- | 
 
 
 
 
 | 11 | --  This library is distributed in the hope that it will be useful, but     -- | 
 
 
 
 
 | 12 | --  WITHOUT ANY WARRANTY; without even the implied warranty of              -- | 
 
 
 
 
 | 13 | --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       -- | 
 
 
 
 
 | 14 | --  General Public License for more details.                                -- | 
 
 
 
 
 | 15 | --                                                                          -- | 
 
 
 
 
 | 16 | --  You should have received a copy of the GNU General Public License       -- | 
 
 
 
 
 | 17 | --  along with this library; if not, write to the Free Software Foundation, -- | 
 
 
 
 
 | 18 | --  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          -- | 
 
 
 
 
 | 19 | --                                                                          -- | 
 
 
 
 
 | 20 | --  As a special exception, if other files instantiate generics from this   -- | 
 
 
 
 
 | 21 | --  unit, or you link this unit with other files to produce an executable,  -- | 
 
 
 
 
 | 22 | --  this  unit  does not  by itself cause  the resulting executable to be   -- | 
 
 
 
 
 | 23 | --  covered by the GNU General Public License. This exception does not      -- | 
 
 
 
 
 | 24 | --  however invalidate any other reasons why the executable file  might be  -- | 
 
 
 
 
 | 25 | --  covered by the  GNU Public License.                                     -- | 
 
 
 
 
 | 26 | ------------------------------------------------------------------------------ | 
 
 
 
 
 | 27 |  | 
 
 
 
 
 | 28 | --  $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $ | 
 
 
 
 
 | 29 |  | 
 
 
 
 
 | 30 | with Ada.Streams; | 
 
 
 
 
 | 31 |  | 
 
 
 
 
 | 32 | with Interfaces; | 
 
 
 
 
 | 33 |  | 
 
 
 
 
 | 34 | package ZLib is | 
 
 
 
 
 | 35 |  | 
 
 
 
 
 | 36 | ZLib_Error   : exception; | 
 
 
 
 
 | 37 | Status_Error : exception; | 
 
 
 
 
 | 38 |  | 
 
 
 
 
 | 39 | type Compression_Level is new Integer range -1 .. 9; | 
 
 
 
 
 | 40 |  | 
 
 
 
 
 | 41 | type Flush_Mode is private; | 
 
 
 
 
 | 42 |  | 
 
 
 
 
 | 43 | type Compression_Method is private; | 
 
 
 
 
 | 44 |  | 
 
 
 
 
 | 45 | type Window_Bits_Type is new Integer range 8 .. 15; | 
 
 
 
 
 | 46 |  | 
 
 
 
 
 | 47 | type Memory_Level_Type is new Integer range 1 .. 9; | 
 
 
 
 
 | 48 |  | 
 
 
 
 
 | 49 | type Unsigned_32 is new Interfaces.Unsigned_32; | 
 
 
 
 
 | 50 |  | 
 
 
 
 
 | 51 | type Strategy_Type is private; | 
 
 
 
 
 | 52 |  | 
 
 
 
 
 | 53 | type Header_Type is (None, Auto, Default, GZip); | 
 
 
 
 
 | 54 | --  Header type usage have a some limitation for inflate. | 
 
 
 
 
 | 55 | --  See comment for Inflate_Init. | 
 
 
 
 
 | 56 |  | 
 
 
 
 
 | 57 | subtype Count is Ada.Streams.Stream_Element_Count; | 
 
 
 
 
 | 58 |  | 
 
 
 
 
 | 59 | Default_Memory_Level : constant Memory_Level_Type := 8; | 
 
 
 
 
 | 60 | Default_Window_Bits  : constant Window_Bits_Type  := 15; | 
 
 
 
 
 | 61 |  | 
 
 
 
 
 | 62 | ---------------------------------- | 
 
 
 
 
 | 63 | -- Compression method constants -- | 
 
 
 
 
 | 64 | ---------------------------------- | 
 
 
 
 
 | 65 |  | 
 
 
 
 
 | 66 | Deflated : constant Compression_Method; | 
 
 
 
 
 | 67 | --  Only one method allowed in this ZLib version | 
 
 
 
 
 | 68 |  | 
 
 
 
 
 | 69 | --------------------------------- | 
 
 
 
 
 | 70 | -- Compression level constants -- | 
 
 
 
 
 | 71 | --------------------------------- | 
 
 
 
 
 | 72 |  | 
 
 
 
 
 | 73 | No_Compression      : constant Compression_Level := 0; | 
 
 
 
 
 | 74 | Best_Speed          : constant Compression_Level := 1; | 
 
 
 
 
 | 75 | Best_Compression    : constant Compression_Level := 9; | 
 
 
 
 
 | 76 | Default_Compression : constant Compression_Level := -1; | 
 
 
 
 
 | 77 |  | 
 
 
 
 
 | 78 | -------------------------- | 
 
 
 
 
 | 79 | -- Flush mode constants -- | 
 
 
 
 
 | 80 | -------------------------- | 
 
 
 
 
 | 81 |  | 
 
 
 
 
 | 82 | No_Flush      : constant Flush_Mode; | 
 
 
 
 
 | 83 | --  Regular way for compression, no flush | 
 
 
 
 
 | 84 |  | 
 
 
 
 
 | 85 | Partial_Flush : constant Flush_Mode; | 
 
 
 
 
 | 86 | --  Will be removed, use Z_SYNC_FLUSH instead | 
 
 
 
 
 | 87 |  | 
 
 
 
 
 | 88 | Sync_Flush    : constant Flush_Mode; | 
 
 
 
 
 | 89 | --  All pending output is flushed to the output buffer and the output | 
 
 
 
 
 | 90 | --  is aligned on a byte boundary, so that the decompressor can get all | 
 
 
 
 
 | 91 | --  input data available so far. (In particular avail_in is zero after the | 
 
 
 
 
 | 92 | --  call if enough output space has been provided  before the call.) | 
 
 
 
 
 | 93 | --  Flushing may degrade compression for some compression algorithms and so | 
 
 
 
 
 | 94 | --  it should be used only when necessary. | 
 
 
 
 
 | 95 |  | 
 
 
 
 
 | 96 | Block_Flush   : constant Flush_Mode; | 
 
 
 
 
 | 97 | --  Z_BLOCK requests that inflate() stop | 
 
 
 
 
 | 98 | --  if and when it get to the next deflate block boundary. When decoding the | 
 
 
 
 
 | 99 | --  zlib or gzip format, this will cause inflate() to return immediately | 
 
 
 
 
 | 100 | --  after the header and before the first block. When doing a raw inflate, | 
 
 
 
 
 | 101 | --  inflate() will go ahead and process the first block, and will return | 
 
 
 
 
 | 102 | --  when it gets to the end of that block, or when it runs out of data. | 
 
 
 
 
 | 103 |  | 
 
 
 
 
 | 104 | Full_Flush    : constant Flush_Mode; | 
 
 
 
 
 | 105 | --  All output is flushed as with SYNC_FLUSH, and the compression state | 
 
 
 
 
 | 106 | --  is reset so that decompression can restart from this point if previous | 
 
 
 
 
 | 107 | --  compressed data has been damaged or if random access is desired. Using | 
 
 
 
 
 | 108 | --  Full_Flush too often can seriously degrade the compression. | 
 
 
 
 
 | 109 |  | 
 
 
 
 
 | 110 | Finish        : constant Flush_Mode; | 
 
 
 
 
 | 111 | --  Just for tell the compressor that input data is complete. | 
 
 
 
 
 | 112 |  | 
 
 
 
 
 | 113 | ------------------------------------ | 
 
 
 
 
 | 114 | -- Compression strategy constants -- | 
 
 
 
 
 | 115 | ------------------------------------ | 
 
 
 
 
 | 116 |  | 
 
 
 
 
 | 117 | --  RLE stategy could be used only in version 1.2.0 and later. | 
 
 
 
 
 | 118 |  | 
 
 
 
 
 | 119 | Filtered         : constant Strategy_Type; | 
 
 
 
 
 | 120 | Huffman_Only     : constant Strategy_Type; | 
 
 
 
 
 | 121 | RLE              : constant Strategy_Type; | 
 
 
 
 
 | 122 | Default_Strategy : constant Strategy_Type; | 
 
 
 
 
 | 123 |  | 
 
 
 
 
 | 124 | Default_Buffer_Size : constant := 4096; | 
 
 
 
 
 | 125 |  | 
 
 
 
 
 | 126 | type Filter_Type is tagged limited private; | 
 
 
 
 
 | 127 | --  The filter is for compression and for decompression. | 
 
 
 
 
 | 128 | --  The usage of the type is depend of its initialization. | 
 
 
 
 
 | 129 |  | 
 
 
 
 
 | 130 | function Version return String; | 
 
 
 
 
 | 131 | pragma Inline (Version); | 
 
 
 
 
 | 132 | --  Return string representation of the ZLib version. | 
 
 
 
 
 | 133 |  | 
 
 
 
 
 | 134 | procedure Deflate_Init | 
 
 
 
 
 | 135 | (Filter       : in out Filter_Type; | 
 
 
 
 
 | 136 | Level        : in     Compression_Level  := Default_Compression; | 
 
 
 
 
 | 137 | Strategy     : in     Strategy_Type      := Default_Strategy; | 
 
 
 
 
 | 138 | Method       : in     Compression_Method := Deflated; | 
 
 
 
 
 | 139 | Window_Bits  : in     Window_Bits_Type   := Default_Window_Bits; | 
 
 
 
 
 | 140 | Memory_Level : in     Memory_Level_Type  := Default_Memory_Level; | 
 
 
 
 
 | 141 | Header       : in     Header_Type        := Default); | 
 
 
 
 
 | 142 | --  Compressor initialization. | 
 
 
 
 
 | 143 | --  When Header parameter is Auto or Default, then default zlib header | 
 
 
 
 
 | 144 | --  would be provided for compressed data. | 
 
 
 
 
 | 145 | --  When Header is GZip, then gzip header would be set instead of | 
 
 
 
 
 | 146 | --  default header. | 
 
 
 
 
 | 147 | --  When Header is None, no header would be set for compressed data. | 
 
 
 
 
 | 148 |  | 
 
 
 
 
 | 149 | procedure Inflate_Init | 
 
 
 
 
 | 150 | (Filter      : in out Filter_Type; | 
 
 
 
 
 | 151 | Window_Bits : in     Window_Bits_Type := Default_Window_Bits; | 
 
 
 
 
 | 152 | Header      : in     Header_Type      := Default); | 
 
 
 
 
 | 153 | --  Decompressor initialization. | 
 
 
 
 
 | 154 | --  Default header type mean that ZLib default header is expecting in the | 
 
 
 
 
 | 155 | --  input compressed stream. | 
 
 
 
 
 | 156 | --  Header type None mean that no header is expecting in the input stream. | 
 
 
 
 
 | 157 | --  GZip header type mean that GZip header is expecting in the | 
 
 
 
 
 | 158 | --  input compressed stream. | 
 
 
 
 
 | 159 | --  Auto header type mean that header type (GZip or Native) would be | 
 
 
 
 
 | 160 | --  detected automatically in the input stream. | 
 
 
 
 
 | 161 | --  Note that header types parameter values None, GZip and Auto are | 
 
 
 
 
 | 162 | --  supported for inflate routine only in ZLib versions 1.2.0.2 and later. | 
 
 
 
 
 | 163 | --  Deflate_Init is supporting all header types. | 
 
 
 
 
 | 164 |  | 
 
 
 
 
 | 165 | function Is_Open (Filter : in Filter_Type) return Boolean; | 
 
 
 
 
 | 166 | pragma Inline (Is_Open); | 
 
 
 
 
 | 167 | --  Is the filter opened for compression or decompression. | 
 
 
 
 
 | 168 |  | 
 
 
 
 
 | 169 | procedure Close | 
 
 
 
 
 | 170 | (Filter       : in out Filter_Type; | 
 
 
 
 
 | 171 | Ignore_Error : in     Boolean := False); | 
 
 
 
 
 | 172 | --  Closing the compression or decompressor. | 
 
 
 
 
 | 173 | --  If stream is closing before the complete and Ignore_Error is False, | 
 
 
 
 
 | 174 | --  The exception would be raised. | 
 
 
 
 
 | 175 |  | 
 
 
 
 
 | 176 | generic | 
 
 
 
 
 | 177 | with procedure Data_In | 
 
 
 
 
 | 178 | (Item : out Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 179 | Last : out Ada.Streams.Stream_Element_Offset); | 
 
 
 
 
 | 180 | with procedure Data_Out | 
 
 
 
 
 | 181 | (Item : in Ada.Streams.Stream_Element_Array); | 
 
 
 
 
 | 182 | procedure Generic_Translate | 
 
 
 
 
 | 183 | (Filter          : in out Filter_Type; | 
 
 
 
 
 | 184 | In_Buffer_Size  : in     Integer := Default_Buffer_Size; | 
 
 
 
 
 | 185 | Out_Buffer_Size : in     Integer := Default_Buffer_Size); | 
 
 
 
 
 | 186 | --  Compress/decompress data fetch from Data_In routine and pass the result | 
 
 
 
 
 | 187 | --  to the Data_Out routine. User should provide Data_In and Data_Out | 
 
 
 
 
 | 188 | --  for compression/decompression data flow. | 
 
 
 
 
 | 189 | --  Compression or decompression depend on Filter initialization. | 
 
 
 
 
 | 190 |  | 
 
 
 
 
 | 191 | function Total_In (Filter : in Filter_Type) return Count; | 
 
 
 
 
 | 192 | pragma Inline (Total_In); | 
 
 
 
 
 | 193 | --  Returns total number of input bytes read so far | 
 
 
 
 
 | 194 |  | 
 
 
 
 
 | 195 | function Total_Out (Filter : in Filter_Type) return Count; | 
 
 
 
 
 | 196 | pragma Inline (Total_Out); | 
 
 
 
 
 | 197 | --  Returns total number of bytes output so far | 
 
 
 
 
 | 198 |  | 
 
 
 
 
 | 199 | function CRC32 | 
 
 
 
 
 | 200 | (CRC    : in Unsigned_32; | 
 
 
 
 
 | 201 | Data   : in Ada.Streams.Stream_Element_Array) | 
 
 
 
 
 | 202 | return Unsigned_32; | 
 
 
 
 
 | 203 | pragma Inline (CRC32); | 
 
 
 
 
 | 204 | --  Compute CRC32, it could be necessary for make gzip format | 
 
 
 
 
 | 205 |  | 
 
 
 
 
 | 206 | procedure CRC32 | 
 
 
 
 
 | 207 | (CRC  : in out Unsigned_32; | 
 
 
 
 
 | 208 | Data : in     Ada.Streams.Stream_Element_Array); | 
 
 
 
 
 | 209 | pragma Inline (CRC32); | 
 
 
 
 
 | 210 | --  Compute CRC32, it could be necessary for make gzip format | 
 
 
 
 
 | 211 |  | 
 
 
 
 
 | 212 | ------------------------------------------------- | 
 
 
 
 
 | 213 | --  Below is more complex low level routines.  -- | 
 
 
 
 
 | 214 | ------------------------------------------------- | 
 
 
 
 
 | 215 |  | 
 
 
 
 
 | 216 | procedure Translate | 
 
 
 
 
 | 217 | (Filter    : in out Filter_Type; | 
 
 
 
 
 | 218 | In_Data   : in     Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 219 | In_Last   :    out Ada.Streams.Stream_Element_Offset; | 
 
 
 
 
 | 220 | Out_Data  :    out Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 221 | Out_Last  :    out Ada.Streams.Stream_Element_Offset; | 
 
 
 
 
 | 222 | Flush     : in     Flush_Mode); | 
 
 
 
 
 | 223 | --  Compress/decompress the In_Data buffer and place the result into | 
 
 
 
 
 | 224 | --  Out_Data. In_Last is the index of last element from In_Data accepted by | 
 
 
 
 
 | 225 | --  the Filter. Out_Last is the last element of the received data from | 
 
 
 
 
 | 226 | --  Filter. To tell the filter that incoming data are complete put the | 
 
 
 
 
 | 227 | --  Flush parameter to Finish. | 
 
 
 
 
 | 228 |  | 
 
 
 
 
 | 229 | function Stream_End (Filter : in Filter_Type) return Boolean; | 
 
 
 
 
 | 230 | pragma Inline (Stream_End); | 
 
 
 
 
 | 231 | --  Return the true when the stream is complete. | 
 
 
 
 
 | 232 |  | 
 
 
 
 
 | 233 | procedure Flush | 
 
 
 
 
 | 234 | (Filter    : in out Filter_Type; | 
 
 
 
 
 | 235 | Out_Data  :    out Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 236 | Out_Last  :    out Ada.Streams.Stream_Element_Offset; | 
 
 
 
 
 | 237 | Flush     : in     Flush_Mode); | 
 
 
 
 
 | 238 | pragma Inline (Flush); | 
 
 
 
 
 | 239 | --  Flushing the data from the compressor. | 
 
 
 
 
 | 240 |  | 
 
 
 
 
 | 241 | generic | 
 
 
 
 
 | 242 | with procedure Write | 
 
 
 
 
 | 243 | (Item : in Ada.Streams.Stream_Element_Array); | 
 
 
 
 
 | 244 | --  User should provide this routine for accept | 
 
 
 
 
 | 245 | --  compressed/decompressed data. | 
 
 
 
 
 | 246 |  | 
 
 
 
 
 | 247 | Buffer_Size : in Ada.Streams.Stream_Element_Offset | 
 
 
 
 
 | 248 | := Default_Buffer_Size; | 
 
 
 
 
 | 249 | --  Buffer size for Write user routine. | 
 
 
 
 
 | 250 |  | 
 
 
 
 
 | 251 | procedure Write | 
 
 
 
 
 | 252 | (Filter  : in out Filter_Type; | 
 
 
 
 
 | 253 | Item    : in     Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 254 | Flush   : in     Flush_Mode := No_Flush); | 
 
 
 
 
 | 255 | --  Compress/Decompress data from Item to the generic parameter procedure | 
 
 
 
 
 | 256 | --  Write. Output buffer size could be set in Buffer_Size generic parameter. | 
 
 
 
 
 | 257 |  | 
 
 
 
 
 | 258 | generic | 
 
 
 
 
 | 259 | with procedure Read | 
 
 
 
 
 | 260 | (Item : out Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 261 | Last : out Ada.Streams.Stream_Element_Offset); | 
 
 
 
 
 | 262 | --  User should provide data for compression/decompression | 
 
 
 
 
 | 263 | --  thru this routine. | 
 
 
 
 
 | 264 |  | 
 
 
 
 
 | 265 | Buffer : in out Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 266 | --  Buffer for keep remaining data from the previous | 
 
 
 
 
 | 267 | --  back read. | 
 
 
 
 
 | 268 |  | 
 
 
 
 
 | 269 | Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset; | 
 
 
 
 
 | 270 | --  Rest_First have to be initialized to Buffer'Last + 1 | 
 
 
 
 
 | 271 | --  Rest_Last have to be initialized to Buffer'Last | 
 
 
 
 
 | 272 | --  before usage. | 
 
 
 
 
 | 273 |  | 
 
 
 
 
 | 274 | Allow_Read_Some : in Boolean := False; | 
 
 
 
 
 | 275 | --  Is it allowed to return Last < Item'Last before end of data. | 
 
 
 
 
 | 276 |  | 
 
 
 
 
 | 277 | procedure Read | 
 
 
 
 
 | 278 | (Filter : in out Filter_Type; | 
 
 
 
 
 | 279 | Item   :    out Ada.Streams.Stream_Element_Array; | 
 
 
 
 
 | 280 | Last   :    out Ada.Streams.Stream_Element_Offset; | 
 
 
 
 
 | 281 | Flush  : in     Flush_Mode := No_Flush); | 
 
 
 
 
 | 282 | --  Compress/Decompress data from generic parameter procedure Read to the | 
 
 
 
 
 | 283 | --  Item. User should provide Buffer and initialized Rest_First, Rest_Last | 
 
 
 
 
 | 284 | --  indicators. If Allow_Read_Some is True, Read routines could return | 
 
 
 
 
 | 285 | --  Last < Item'Last only at end of stream. | 
 
 
 
 
 | 286 |  | 
 
 
 
 
 | 287 | private | 
 
 
 
 
 | 288 |  | 
 
 
 
 
 | 289 | use Ada.Streams; | 
 
 
 
 
 | 290 |  | 
 
 
 
 
 | 291 | pragma Assert (Ada.Streams.Stream_Element'Size    =    8); | 
 
 
 
 
 | 292 | pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8); | 
 
 
 
 
 | 293 |  | 
 
 
 
 
 | 294 | type Flush_Mode is new Integer range 0 .. 5; | 
 
 
 
 
 | 295 |  | 
 
 
 
 
 | 296 | type Compression_Method is new Integer range 8 .. 8; | 
 
 
 
 
 | 297 |  | 
 
 
 
 
 | 298 | type Strategy_Type is new Integer range 0 .. 3; | 
 
 
 
 
 | 299 |  | 
 
 
 
 
 | 300 | No_Flush      : constant Flush_Mode := 0; | 
 
 
 
 
 | 301 | Partial_Flush : constant Flush_Mode := 1; | 
 
 
 
 
 | 302 | Sync_Flush    : constant Flush_Mode := 2; | 
 
 
 
 
 | 303 | Full_Flush    : constant Flush_Mode := 3; | 
 
 
 
 
 | 304 | Finish        : constant Flush_Mode := 4; | 
 
 
 
 
 | 305 | Block_Flush   : constant Flush_Mode := 5; | 
 
 
 
 
 | 306 |  | 
 
 
 
 
 | 307 | Filtered         : constant Strategy_Type := 1; | 
 
 
 
 
 | 308 | Huffman_Only     : constant Strategy_Type := 2; | 
 
 
 
 
 | 309 | RLE              : constant Strategy_Type := 3; | 
 
 
 
 
 | 310 | Default_Strategy : constant Strategy_Type := 0; | 
 
 
 
 
 | 311 |  | 
 
 
 
 
 | 312 | Deflated : constant Compression_Method := 8; | 
 
 
 
 
 | 313 |  | 
 
 
 
 
 | 314 | type Z_Stream; | 
 
 
 
 
 | 315 |  | 
 
 
 
 
 | 316 | type Z_Stream_Access is access all Z_Stream; | 
 
 
 
 
 | 317 |  | 
 
 
 
 
 | 318 | type Filter_Type is tagged limited record | 
 
 
 
 
 | 319 | Strm        : Z_Stream_Access; | 
 
 
 
 
 | 320 | Compression : Boolean; | 
 
 
 
 
 | 321 | Stream_End  : Boolean; | 
 
 
 
 
 | 322 | Header      : Header_Type; | 
 
 
 
 
 | 323 | CRC         : Unsigned_32; | 
 
 
 
 
 | 324 | Offset      : Stream_Element_Offset; | 
 
 
 
 
 | 325 | --  Offset for gzip header/footer output. | 
 
 
 
 
 | 326 | end record; | 
 
 
 
 
 | 327 |  | 
 
 
 
 
 | 328 | end ZLib; |