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