summaryrefslogtreecommitdiff
path: root/zlib/contrib/ada
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /zlib/contrib/ada
downloadcbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.bz2
cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'zlib/contrib/ada')
-rw-r--r--zlib/contrib/ada/buffer_demo.adb106
-rw-r--r--zlib/contrib/ada/mtest.adb156
-rw-r--r--zlib/contrib/ada/read.adb156
-rw-r--r--zlib/contrib/ada/readme.txt65
-rw-r--r--zlib/contrib/ada/test.adb463
-rw-r--r--zlib/contrib/ada/zlib-streams.adb225
-rw-r--r--zlib/contrib/ada/zlib-streams.ads114
-rw-r--r--zlib/contrib/ada/zlib-thin.adb141
-rw-r--r--zlib/contrib/ada/zlib-thin.ads450
-rw-r--r--zlib/contrib/ada/zlib.adb701
-rw-r--r--zlib/contrib/ada/zlib.ads328
-rw-r--r--zlib/contrib/ada/zlib.gpr20
12 files changed, 2925 insertions, 0 deletions
diff --git a/zlib/contrib/ada/buffer_demo.adb b/zlib/contrib/ada/buffer_demo.adb
new file mode 100644
index 000000000..46b863810
--- /dev/null
+++ b/zlib/contrib/ada/buffer_demo.adb
@@ -0,0 +1,106 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+--
+-- $Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp $
+
+-- This demo program provided by Dr Steve Sangwine <sjs@essex.ac.uk>
+--
+-- Demonstration of a problem with Zlib-Ada (already fixed) when a buffer
+-- of exactly the correct size is used for decompressed data, and the last
+-- few bytes passed in to Zlib are checksum bytes.
+
+-- This program compresses a string of text, and then decompresses the
+-- compressed text into a buffer of the same size as the original text.
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Text_IO;
+
+with ZLib; use ZLib;
+
+procedure Buffer_Demo is
+ EOL : Character renames ASCII.LF;
+ Text : constant String
+ := "Four score and seven years ago our fathers brought forth," & EOL &
+ "upon this continent, a new nation, conceived in liberty," & EOL &
+ "and dedicated to the proposition that `all men are created equal'.";
+
+ Source : Stream_Element_Array (1 .. Text'Length);
+ for Source'Address use Text'Address;
+
+begin
+ Ada.Text_IO.Put (Text);
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line
+ ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
+
+ declare
+ Compressed_Data : Stream_Element_Array (1 .. Text'Length);
+ L : Stream_Element_Offset;
+ begin
+ Compress : declare
+ Compressor : Filter_Type;
+ I : Stream_Element_Offset;
+ begin
+ Deflate_Init (Compressor);
+
+ -- Compress the whole of T at once.
+
+ Translate (Compressor, Source, I, Compressed_Data, L, Finish);
+ pragma Assert (I = Source'Last);
+
+ Close (Compressor);
+
+ Ada.Text_IO.Put_Line
+ ("Compressed size : "
+ & Stream_Element_Offset'Image (L) & " bytes");
+ end Compress;
+
+ -- Now we decompress the data, passing short blocks of data to Zlib
+ -- (because this demonstrates the problem - the last block passed will
+ -- contain checksum information and there will be no output, only a
+ -- check inside Zlib that the checksum is correct).
+
+ Decompress : declare
+ Decompressor : Filter_Type;
+
+ Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
+
+ Block_Size : constant := 4;
+ -- This makes sure that the last block contains
+ -- only Adler checksum data.
+
+ P : Stream_Element_Offset := Compressed_Data'First - 1;
+ O : Stream_Element_Offset;
+ begin
+ Inflate_Init (Decompressor);
+
+ loop
+ Translate
+ (Decompressor,
+ Compressed_Data
+ (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
+ P,
+ Uncompressed_Data
+ (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
+ O,
+ No_Flush);
+
+ Ada.Text_IO.Put_Line
+ ("Total in : " & Count'Image (Total_In (Decompressor)) &
+ ", out : " & Count'Image (Total_Out (Decompressor)));
+
+ exit when P = L;
+ end loop;
+
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line
+ ("Decompressed text matches original text : "
+ & Boolean'Image (Uncompressed_Data = Source));
+ end Decompress;
+ end;
+end Buffer_Demo;
diff --git a/zlib/contrib/ada/mtest.adb b/zlib/contrib/ada/mtest.adb
new file mode 100644
index 000000000..c4dfd080f
--- /dev/null
+++ b/zlib/contrib/ada/mtest.adb
@@ -0,0 +1,156 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+-- Continuous test for ZLib multithreading. If the test would fail
+-- we should provide thread safe allocation routines for the Z_Stream.
+--
+-- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $
+
+with ZLib;
+with Ada.Streams;
+with Ada.Numerics.Discrete_Random;
+with Ada.Text_IO;
+with Ada.Exceptions;
+with Ada.Task_Identification;
+
+procedure MTest is
+ use Ada.Streams;
+ use ZLib;
+
+ Stop : Boolean := False;
+
+ pragma Atomic (Stop);
+
+ subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
+
+ package Random_Elements is
+ new Ada.Numerics.Discrete_Random (Visible_Symbols);
+
+ task type Test_Task;
+
+ task body Test_Task is
+ Buffer : Stream_Element_Array (1 .. 100_000);
+ Gen : Random_Elements.Generator;
+
+ Buffer_First : Stream_Element_Offset;
+ Compare_First : Stream_Element_Offset;
+
+ Deflate : Filter_Type;
+ Inflate : Filter_Type;
+
+ procedure Further (Item : in Stream_Element_Array);
+
+ procedure Read_Buffer
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+
+ -------------
+ -- Further --
+ -------------
+
+ procedure Further (Item : in Stream_Element_Array) is
+
+ procedure Compare (Item : in Stream_Element_Array);
+
+ -------------
+ -- Compare --
+ -------------
+
+ procedure Compare (Item : in Stream_Element_Array) is
+ Next_First : Stream_Element_Offset := Compare_First + Item'Length;
+ begin
+ if Buffer (Compare_First .. Next_First - 1) /= Item then
+ raise Program_Error;
+ end if;
+
+ Compare_First := Next_First;
+ end Compare;
+
+ procedure Compare_Write is new ZLib.Write (Write => Compare);
+ begin
+ Compare_Write (Inflate, Item, No_Flush);
+ end Further;
+
+ -----------------
+ -- Read_Buffer --
+ -----------------
+
+ procedure Read_Buffer
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset)
+ is
+ Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First;
+ Next_First : Stream_Element_Offset;
+ begin
+ if Item'Length <= Buff_Diff then
+ Last := Item'Last;
+
+ Next_First := Buffer_First + Item'Length;
+
+ Item := Buffer (Buffer_First .. Next_First - 1);
+
+ Buffer_First := Next_First;
+ else
+ Last := Item'First + Buff_Diff;
+ Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);
+ Buffer_First := Buffer'Last + 1;
+ end if;
+ end Read_Buffer;
+
+ procedure Translate is new Generic_Translate
+ (Data_In => Read_Buffer,
+ Data_Out => Further);
+
+ begin
+ Random_Elements.Reset (Gen);
+
+ Buffer := (others => 20);
+
+ Main : loop
+ for J in Buffer'Range loop
+ Buffer (J) := Random_Elements.Random (Gen);
+
+ Deflate_Init (Deflate);
+ Inflate_Init (Inflate);
+
+ Buffer_First := Buffer'First;
+ Compare_First := Buffer'First;
+
+ Translate (Deflate);
+
+ if Compare_First /= Buffer'Last + 1 then
+ raise Program_Error;
+ end if;
+
+ Ada.Text_IO.Put_Line
+ (Ada.Task_Identification.Image
+ (Ada.Task_Identification.Current_Task)
+ & Stream_Element_Offset'Image (J)
+ & ZLib.Count'Image (Total_Out (Deflate)));
+
+ Close (Deflate);
+ Close (Inflate);
+
+ exit Main when Stop;
+ end loop;
+ end loop Main;
+ exception
+ when E : others =>
+ Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
+ Stop := True;
+ end Test_Task;
+
+ Test : array (1 .. 4) of Test_Task;
+
+ pragma Unreferenced (Test);
+
+ Dummy : Character;
+
+begin
+ Ada.Text_IO.Get_Immediate (Dummy);
+ Stop := True;
+end MTest;
diff --git a/zlib/contrib/ada/read.adb b/zlib/contrib/ada/read.adb
new file mode 100644
index 000000000..1f2efbfeb
--- /dev/null
+++ b/zlib/contrib/ada/read.adb
@@ -0,0 +1,156 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
+
+-- Test/demo program for the generic read interface.
+
+with Ada.Numerics.Discrete_Random;
+with Ada.Streams;
+with Ada.Text_IO;
+
+with ZLib;
+
+procedure Read is
+
+ use Ada.Streams;
+
+ ------------------------------------
+ -- Test configuration parameters --
+ ------------------------------------
+
+ File_Size : Stream_Element_Offset := 100_000;
+
+ Continuous : constant Boolean := False;
+ -- If this constant is True, the test would be repeated again and again,
+ -- with increment File_Size for every iteration.
+
+ Header : constant ZLib.Header_Type := ZLib.Default;
+ -- Do not use Header other than Default in ZLib versions 1.1.4 and older.
+
+ Init_Random : constant := 8;
+ -- We are using the same random sequence, in case of we catch bug,
+ -- so we would be able to reproduce it.
+
+ -- End --
+
+ Pack_Size : Stream_Element_Offset;
+ Offset : Stream_Element_Offset;
+
+ Filter : ZLib.Filter_Type;
+
+ subtype Visible_Symbols
+ is Stream_Element range 16#20# .. 16#7E#;
+
+ package Random_Elements is new
+ Ada.Numerics.Discrete_Random (Visible_Symbols);
+
+ Gen : Random_Elements.Generator;
+ Period : constant Stream_Element_Offset := 200;
+ -- Period constant variable for random generator not to be very random.
+ -- Bigger period, harder random.
+
+ Read_Buffer : Stream_Element_Array (1 .. 2048);
+ Read_First : Stream_Element_Offset;
+ Read_Last : Stream_Element_Offset;
+
+ procedure Reset;
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+ -- this procedure is for generic instantiation of
+ -- ZLib.Read
+ -- reading data from the File_In.
+
+ procedure Read is new ZLib.Read
+ (Read,
+ Read_Buffer,
+ Rest_First => Read_First,
+ Rest_Last => Read_Last);
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Last := Stream_Element_Offset'Min
+ (Item'Last,
+ Item'First + File_Size - Offset);
+
+ for J in Item'First .. Last loop
+ if J < Item'First + Period then
+ Item (J) := Random_Elements.Random (Gen);
+ else
+ Item (J) := Item (J - Period);
+ end if;
+
+ Offset := Offset + 1;
+ end loop;
+ end Read;
+
+ -----------
+ -- Reset --
+ -----------
+
+ procedure Reset is
+ begin
+ Random_Elements.Reset (Gen, Init_Random);
+ Pack_Size := 0;
+ Offset := 1;
+ Read_First := Read_Buffer'Last + 1;
+ Read_Last := Read_Buffer'Last;
+ end Reset;
+
+begin
+ Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
+
+ loop
+ for Level in ZLib.Compression_Level'Range loop
+
+ Ada.Text_IO.Put ("Level ="
+ & ZLib.Compression_Level'Image (Level));
+
+ -- Deflate using generic instantiation.
+
+ ZLib.Deflate_Init
+ (Filter,
+ Level,
+ Header => Header);
+
+ Reset;
+
+ Ada.Text_IO.Put
+ (Stream_Element_Offset'Image (File_Size) & " ->");
+
+ loop
+ declare
+ Buffer : Stream_Element_Array (1 .. 1024);
+ Last : Stream_Element_Offset;
+ begin
+ Read (Filter, Buffer, Last);
+
+ Pack_Size := Pack_Size + Last - Buffer'First + 1;
+
+ exit when Last < Buffer'Last;
+ end;
+ end loop;
+
+ Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
+
+ ZLib.Close (Filter);
+ end loop;
+
+ exit when not Continuous;
+
+ File_Size := File_Size + 1;
+ end loop;
+end Read;
diff --git a/zlib/contrib/ada/readme.txt b/zlib/contrib/ada/readme.txt
new file mode 100644
index 000000000..ce4d2cadf
--- /dev/null
+++ b/zlib/contrib/ada/readme.txt
@@ -0,0 +1,65 @@
+ ZLib for Ada thick binding (ZLib.Ada)
+ Release 1.3
+
+ZLib.Ada is a thick binding interface to the popular ZLib data
+compression library, available at http://www.gzip.org/zlib/.
+It provides Ada-style access to the ZLib C library.
+
+
+ Here are the main changes since ZLib.Ada 1.2:
+
+- Attension: ZLib.Read generic routine have a initialization requirement
+ for Read_Last parameter now. It is a bit incompartible with previous version,
+ but extends functionality, we could use new parameters Allow_Read_Some and
+ Flush now.
+
+- Added Is_Open routines to ZLib and ZLib.Streams packages.
+
+- Add pragma Assert to check Stream_Element is 8 bit.
+
+- Fix extraction to buffer with exact known decompressed size. Error reported by
+ Steve Sangwine.
+
+- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits
+ computers. Patch provided by Pascal Obry.
+
+- Add Status_Error exception definition.
+
+- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit.
+
+
+ How to build ZLib.Ada under GNAT
+
+You should have the ZLib library already build on your computer, before
+building ZLib.Ada. Make the directory of ZLib.Ada sources current and
+issue the command:
+
+ gnatmake test -largs -L<directory where libz.a is> -lz
+
+Or use the GNAT project file build for GNAT 3.15 or later:
+
+ gnatmake -Pzlib.gpr -L<directory where libz.a is>
+
+
+ How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2
+
+1. Make a project with all *.ads and *.adb files from the distribution.
+2. Build the libz.a library from the ZLib C sources.
+3. Rename libz.a to z.lib.
+4. Add the library z.lib to the project.
+5. Add the libc.lib library from the ObjectAda distribution to the project.
+6. Build the executable using test.adb as a main procedure.
+
+
+ How to use ZLib.Ada
+
+The source files test.adb and read.adb are small demo programs that show
+the main functionality of ZLib.Ada.
+
+The routines from the package specifications are commented.
+
+
+Homepage: http://zlib-ada.sourceforge.net/
+Author: Dmitriy Anisimkov <anisimkov@yahoo.com>
+
+Contributors: Pascal Obry <pascal@obry.org>, Steve Sangwine <sjs@essex.ac.uk>
diff --git a/zlib/contrib/ada/test.adb b/zlib/contrib/ada/test.adb
new file mode 100644
index 000000000..90773acfa
--- /dev/null
+++ b/zlib/contrib/ada/test.adb
@@ -0,0 +1,463 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $
+
+-- The program has a few aims.
+-- 1. Test ZLib.Ada95 thick binding functionality.
+-- 2. Show the example of use main functionality of the ZLib.Ada95 binding.
+-- 3. Build this program automatically compile all ZLib.Ada95 packages under
+-- GNAT Ada95 compiler.
+
+with ZLib.Streams;
+with Ada.Streams.Stream_IO;
+with Ada.Numerics.Discrete_Random;
+
+with Ada.Text_IO;
+
+with Ada.Calendar;
+
+procedure Test is
+
+ use Ada.Streams;
+ use Stream_IO;
+
+ ------------------------------------
+ -- Test configuration parameters --
+ ------------------------------------
+
+ File_Size : Count := 100_000;
+ Continuous : constant Boolean := False;
+
+ Header : constant ZLib.Header_Type := ZLib.Default;
+ -- ZLib.None;
+ -- ZLib.Auto;
+ -- ZLib.GZip;
+ -- Do not use Header other then Default in ZLib versions 1.1.4
+ -- and older.
+
+ Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
+ Init_Random : constant := 10;
+
+ -- End --
+
+ In_File_Name : constant String := "testzlib.in";
+ -- Name of the input file
+
+ Z_File_Name : constant String := "testzlib.zlb";
+ -- Name of the compressed file.
+
+ Out_File_Name : constant String := "testzlib.out";
+ -- Name of the decompressed file.
+
+ File_In : File_Type;
+ File_Out : File_Type;
+ File_Back : File_Type;
+ File_Z : ZLib.Streams.Stream_Type;
+
+ Filter : ZLib.Filter_Type;
+
+ Time_Stamp : Ada.Calendar.Time;
+
+ procedure Generate_File;
+ -- Generate file of spetsified size with some random data.
+ -- The random data is repeatable, for the good compression.
+
+ procedure Compare_Streams
+ (Left, Right : in out Root_Stream_Type'Class);
+ -- The procedure compearing data in 2 streams.
+ -- It is for compare data before and after compression/decompression.
+
+ procedure Compare_Files (Left, Right : String);
+ -- Compare files. Based on the Compare_Streams.
+
+ procedure Copy_Streams
+ (Source, Target : in out Root_Stream_Type'Class;
+ Buffer_Size : in Stream_Element_Offset := 1024);
+ -- Copying data from one stream to another. It is for test stream
+ -- interface of the library.
+
+ procedure Data_In
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+ -- this procedure is for generic instantiation of
+ -- ZLib.Generic_Translate.
+ -- reading data from the File_In.
+
+ procedure Data_Out (Item : in Stream_Element_Array);
+ -- this procedure is for generic instantiation of
+ -- ZLib.Generic_Translate.
+ -- writing data to the File_Out.
+
+ procedure Stamp;
+ -- Store the timestamp to the local variable.
+
+ procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
+ -- Print the time statistic with the message.
+
+ procedure Translate is new ZLib.Generic_Translate
+ (Data_In => Data_In,
+ Data_Out => Data_Out);
+ -- This procedure is moving data from File_In to File_Out
+ -- with compression or decompression, depend on initialization of
+ -- Filter parameter.
+
+ -------------------
+ -- Compare_Files --
+ -------------------
+
+ procedure Compare_Files (Left, Right : String) is
+ Left_File, Right_File : File_Type;
+ begin
+ Open (Left_File, In_File, Left);
+ Open (Right_File, In_File, Right);
+ Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
+ Close (Left_File);
+ Close (Right_File);
+ end Compare_Files;
+
+ ---------------------
+ -- Compare_Streams --
+ ---------------------
+
+ procedure Compare_Streams
+ (Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
+ is
+ Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
+ Left_Last, Right_Last : Stream_Element_Offset;
+ begin
+ loop
+ Read (Left, Left_Buffer, Left_Last);
+ Read (Right, Right_Buffer, Right_Last);
+
+ if Left_Last /= Right_Last then
+ Ada.Text_IO.Put_Line ("Compare error :"
+ & Stream_Element_Offset'Image (Left_Last)
+ & " /= "
+ & Stream_Element_Offset'Image (Right_Last));
+
+ raise Constraint_Error;
+
+ elsif Left_Buffer (0 .. Left_Last)
+ /= Right_Buffer (0 .. Right_Last)
+ then
+ Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
+ raise Constraint_Error;
+
+ end if;
+
+ exit when Left_Last < Left_Buffer'Last;
+ end loop;
+ end Compare_Streams;
+
+ ------------------
+ -- Copy_Streams --
+ ------------------
+
+ procedure Copy_Streams
+ (Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
+ Buffer_Size : in Stream_Element_Offset := 1024)
+ is
+ Buffer : Stream_Element_Array (1 .. Buffer_Size);
+ Last : Stream_Element_Offset;
+ begin
+ loop
+ Read (Source, Buffer, Last);
+ Write (Target, Buffer (1 .. Last));
+
+ exit when Last < Buffer'Last;
+ end loop;
+ end Copy_Streams;
+
+ -------------
+ -- Data_In --
+ -------------
+
+ procedure Data_In
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Read (File_In, Item, Last);
+ end Data_In;
+
+ --------------
+ -- Data_Out --
+ --------------
+
+ procedure Data_Out (Item : in Stream_Element_Array) is
+ begin
+ Write (File_Out, Item);
+ end Data_Out;
+
+ -------------------
+ -- Generate_File --
+ -------------------
+
+ procedure Generate_File is
+ subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
+
+ package Random_Elements is
+ new Ada.Numerics.Discrete_Random (Visible_Symbols);
+
+ Gen : Random_Elements.Generator;
+ Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
+
+ Buffer_Count : constant Count := File_Size / Buffer'Length;
+ -- Number of same buffers in the packet.
+
+ Density : constant Count := 30; -- from 0 to Buffer'Length - 2;
+
+ procedure Fill_Buffer (J, D : in Count);
+ -- Change the part of the buffer.
+
+ -----------------
+ -- Fill_Buffer --
+ -----------------
+
+ procedure Fill_Buffer (J, D : in Count) is
+ begin
+ for K in 0 .. D loop
+ Buffer
+ (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
+ := Random_Elements.Random (Gen);
+
+ end loop;
+ end Fill_Buffer;
+
+ begin
+ Random_Elements.Reset (Gen, Init_Random);
+
+ Create (File_In, Out_File, In_File_Name);
+
+ Fill_Buffer (1, Buffer'Length - 2);
+
+ for J in 1 .. Buffer_Count loop
+ Write (File_In, Buffer);
+
+ Fill_Buffer (J, Density);
+ end loop;
+
+ -- fill remain size.
+
+ Write
+ (File_In,
+ Buffer
+ (1 .. Stream_Element_Offset
+ (File_Size - Buffer'Length * Buffer_Count)));
+
+ Flush (File_In);
+ Close (File_In);
+ end Generate_File;
+
+ ---------------------
+ -- Print_Statistic --
+ ---------------------
+
+ procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
+ use Ada.Calendar;
+ use Ada.Text_IO;
+
+ package Count_IO is new Integer_IO (ZLib.Count);
+
+ Curr_Dur : Duration := Clock - Time_Stamp;
+ begin
+ Put (Msg);
+
+ Set_Col (20);
+ Ada.Text_IO.Put ("size =");
+
+ Count_IO.Put
+ (Data_Size,
+ Width => Stream_IO.Count'Image (File_Size)'Length);
+
+ Put_Line (" duration =" & Duration'Image (Curr_Dur));
+ end Print_Statistic;
+
+ -----------
+ -- Stamp --
+ -----------
+
+ procedure Stamp is
+ begin
+ Time_Stamp := Ada.Calendar.Clock;
+ end Stamp;
+
+begin
+ Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
+
+ loop
+ Generate_File;
+
+ for Level in ZLib.Compression_Level'Range loop
+
+ Ada.Text_IO.Put_Line ("Level ="
+ & ZLib.Compression_Level'Image (Level));
+
+ -- Test generic interface.
+ Open (File_In, In_File, In_File_Name);
+ Create (File_Out, Out_File, Z_File_Name);
+
+ Stamp;
+
+ -- Deflate using generic instantiation.
+
+ ZLib.Deflate_Init
+ (Filter => Filter,
+ Level => Level,
+ Strategy => Strategy,
+ Header => Header);
+
+ Translate (Filter);
+ Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
+ ZLib.Close (Filter);
+
+ Close (File_In);
+ Close (File_Out);
+
+ Open (File_In, In_File, Z_File_Name);
+ Create (File_Out, Out_File, Out_File_Name);
+
+ Stamp;
+
+ -- Inflate using generic instantiation.
+
+ ZLib.Inflate_Init (Filter, Header => Header);
+
+ Translate (Filter);
+ Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
+
+ ZLib.Close (Filter);
+
+ Close (File_In);
+ Close (File_Out);
+
+ Compare_Files (In_File_Name, Out_File_Name);
+
+ -- Test stream interface.
+
+ -- Compress to the back stream.
+
+ Open (File_In, In_File, In_File_Name);
+ Create (File_Back, Out_File, Z_File_Name);
+
+ Stamp;
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.Out_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => True,
+ Level => Level,
+ Strategy => Strategy,
+ Header => Header);
+
+ Copy_Streams
+ (Source => Stream (File_In).all,
+ Target => File_Z);
+
+ -- Flushing internal buffers to the back stream.
+
+ ZLib.Streams.Flush (File_Z, ZLib.Finish);
+
+ Print_Statistic ("Write compress",
+ ZLib.Streams.Write_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+
+ Close (File_In);
+ Close (File_Back);
+
+ -- Compare reading from original file and from
+ -- decompression stream.
+
+ Open (File_In, In_File, In_File_Name);
+ Open (File_Back, In_File, Z_File_Name);
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.In_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => True,
+ Header => Header);
+
+ Stamp;
+ Compare_Streams (Stream (File_In).all, File_Z);
+
+ Print_Statistic ("Read decompress",
+ ZLib.Streams.Read_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+ Close (File_In);
+ Close (File_Back);
+
+ -- Compress by reading from compression stream.
+
+ Open (File_Back, In_File, In_File_Name);
+ Create (File_Out, Out_File, Z_File_Name);
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.In_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => False,
+ Level => Level,
+ Strategy => Strategy,
+ Header => Header);
+
+ Stamp;
+ Copy_Streams
+ (Source => File_Z,
+ Target => Stream (File_Out).all);
+
+ Print_Statistic ("Read compress",
+ ZLib.Streams.Read_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+
+ Close (File_Out);
+ Close (File_Back);
+
+ -- Decompress to decompression stream.
+
+ Open (File_In, In_File, Z_File_Name);
+ Create (File_Back, Out_File, Out_File_Name);
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.Out_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => False,
+ Header => Header);
+
+ Stamp;
+
+ Copy_Streams
+ (Source => Stream (File_In).all,
+ Target => File_Z);
+
+ Print_Statistic ("Write decompress",
+ ZLib.Streams.Write_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+ Close (File_In);
+ Close (File_Back);
+
+ Compare_Files (In_File_Name, Out_File_Name);
+ end loop;
+
+ Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
+
+ exit when not Continuous;
+
+ File_Size := File_Size + 1;
+ end loop;
+end Test;
diff --git a/zlib/contrib/ada/zlib-streams.adb b/zlib/contrib/ada/zlib-streams.adb
new file mode 100644
index 000000000..b6497bae2
--- /dev/null
+++ b/zlib/contrib/ada/zlib-streams.adb
@@ -0,0 +1,225 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
+
+with Ada.Unchecked_Deallocation;
+
+package body ZLib.Streams is
+
+ -----------
+ -- Close --
+ -----------
+
+ procedure Close (Stream : in out Stream_Type) is
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Stream_Element_Array, Buffer_Access);
+ begin
+ if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
+ -- We should flush the data written by the writer.
+
+ Flush (Stream, Finish);
+
+ Close (Stream.Writer);
+ end if;
+
+ if Stream.Mode = In_Stream or Stream.Mode = Duplex then
+ Close (Stream.Reader);
+ Free (Stream.Buffer);
+ end if;
+ end Close;
+
+ ------------
+ -- Create --
+ ------------
+
+ procedure Create
+ (Stream : out Stream_Type;
+ Mode : in Stream_Mode;
+ Back : in Stream_Access;
+ Back_Compressed : in Boolean;
+ Level : in Compression_Level := Default_Compression;
+ Strategy : in Strategy_Type := Default_Strategy;
+ Header : in Header_Type := Default;
+ Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size;
+ Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size)
+ is
+
+ subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
+
+ procedure Init_Filter
+ (Filter : in out Filter_Type;
+ Compress : in Boolean);
+
+ -----------------
+ -- Init_Filter --
+ -----------------
+
+ procedure Init_Filter
+ (Filter : in out Filter_Type;
+ Compress : in Boolean) is
+ begin
+ if Compress then
+ Deflate_Init
+ (Filter, Level, Strategy, Header => Header);
+ else
+ Inflate_Init (Filter, Header => Header);
+ end if;
+ end Init_Filter;
+
+ begin
+ Stream.Back := Back;
+ Stream.Mode := Mode;
+
+ if Mode = Out_Stream or Mode = Duplex then
+ Init_Filter (Stream.Writer, Back_Compressed);
+ Stream.Buffer_Size := Write_Buffer_Size;
+ else
+ Stream.Buffer_Size := 0;
+ end if;
+
+ if Mode = In_Stream or Mode = Duplex then
+ Init_Filter (Stream.Reader, not Back_Compressed);
+
+ Stream.Buffer := new Buffer_Subtype;
+ Stream.Rest_First := Stream.Buffer'Last + 1;
+ Stream.Rest_Last := Stream.Buffer'Last;
+ end if;
+ end Create;
+
+ -----------
+ -- Flush --
+ -----------
+
+ procedure Flush
+ (Stream : in out Stream_Type;
+ Mode : in Flush_Mode := Sync_Flush)
+ is
+ Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
+ Last : Stream_Element_Offset;
+ begin
+ loop
+ Flush (Stream.Writer, Buffer, Last, Mode);
+
+ Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
+
+ exit when Last < Buffer'Last;
+ end loop;
+ end Flush;
+
+ -------------
+ -- Is_Open --
+ -------------
+
+ function Is_Open (Stream : Stream_Type) return Boolean is
+ begin
+ return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
+ end Is_Open;
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Stream : in out Stream_Type;
+ Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset)
+ is
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Ada.Streams.Read (Stream.Back.all, Item, Last);
+ end Read;
+
+ procedure Read is new ZLib.Read
+ (Read => Read,
+ Buffer => Stream.Buffer.all,
+ Rest_First => Stream.Rest_First,
+ Rest_Last => Stream.Rest_Last);
+
+ begin
+ Read (Stream.Reader, Item, Last);
+ end Read;
+
+ -------------------
+ -- Read_Total_In --
+ -------------------
+
+ function Read_Total_In (Stream : in Stream_Type) return Count is
+ begin
+ return Total_In (Stream.Reader);
+ end Read_Total_In;
+
+ --------------------
+ -- Read_Total_Out --
+ --------------------
+
+ function Read_Total_Out (Stream : in Stream_Type) return Count is
+ begin
+ return Total_Out (Stream.Reader);
+ end Read_Total_Out;
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write
+ (Stream : in out Stream_Type;
+ Item : in Stream_Element_Array)
+ is
+
+ procedure Write (Item : in Stream_Element_Array);
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write (Item : in Stream_Element_Array) is
+ begin
+ Ada.Streams.Write (Stream.Back.all, Item);
+ end Write;
+
+ procedure Write is new ZLib.Write
+ (Write => Write,
+ Buffer_Size => Stream.Buffer_Size);
+
+ begin
+ Write (Stream.Writer, Item, No_Flush);
+ end Write;
+
+ --------------------
+ -- Write_Total_In --
+ --------------------
+
+ function Write_Total_In (Stream : in Stream_Type) return Count is
+ begin
+ return Total_In (Stream.Writer);
+ end Write_Total_In;
+
+ ---------------------
+ -- Write_Total_Out --
+ ---------------------
+
+ function Write_Total_Out (Stream : in Stream_Type) return Count is
+ begin
+ return Total_Out (Stream.Writer);
+ end Write_Total_Out;
+
+end ZLib.Streams;
diff --git a/zlib/contrib/ada/zlib-streams.ads b/zlib/contrib/ada/zlib-streams.ads
new file mode 100644
index 000000000..f0193c6ba
--- /dev/null
+++ b/zlib/contrib/ada/zlib-streams.ads
@@ -0,0 +1,114 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
+
+package ZLib.Streams is
+
+ type Stream_Mode is (In_Stream, Out_Stream, Duplex);
+
+ type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
+
+ type Stream_Type is
+ new Ada.Streams.Root_Stream_Type with private;
+
+ procedure Read
+ (Stream : in out Stream_Type;
+ Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+
+ procedure Write
+ (Stream : in out Stream_Type;
+ Item : in Ada.Streams.Stream_Element_Array);
+
+ procedure Flush
+ (Stream : in out Stream_Type;
+ Mode : in Flush_Mode := Sync_Flush);
+ -- Flush the written data to the back stream,
+ -- all data placed to the compressor is flushing to the Back stream.
+ -- Should not be used untill necessary, becouse it is decreasing
+ -- compression.
+
+ function Read_Total_In (Stream : in Stream_Type) return Count;
+ pragma Inline (Read_Total_In);
+ -- Return total number of bytes read from back stream so far.
+
+ function Read_Total_Out (Stream : in Stream_Type) return Count;
+ pragma Inline (Read_Total_Out);
+ -- Return total number of bytes read so far.
+
+ function Write_Total_In (Stream : in Stream_Type) return Count;
+ pragma Inline (Write_Total_In);
+ -- Return total number of bytes written so far.
+
+ function Write_Total_Out (Stream : in Stream_Type) return Count;
+ pragma Inline (Write_Total_Out);
+ -- Return total number of bytes written to the back stream.
+
+ procedure Create
+ (Stream : out Stream_Type;
+ Mode : in Stream_Mode;
+ Back : in Stream_Access;
+ Back_Compressed : in Boolean;
+ Level : in Compression_Level := Default_Compression;
+ Strategy : in Strategy_Type := Default_Strategy;
+ Header : in Header_Type := Default;
+ Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size;
+ Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size);
+ -- Create the Comression/Decompression stream.
+ -- If mode is In_Stream then Write operation is disabled.
+ -- If mode is Out_Stream then Read operation is disabled.
+
+ -- If Back_Compressed is true then
+ -- Data written to the Stream is compressing to the Back stream
+ -- and data read from the Stream is decompressed data from the Back stream.
+
+ -- If Back_Compressed is false then
+ -- Data written to the Stream is decompressing to the Back stream
+ -- and data read from the Stream is compressed data from the Back stream.
+
+ -- !!! When the Need_Header is False ZLib-Ada is using undocumented
+ -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers.
+
+ function Is_Open (Stream : Stream_Type) return Boolean;
+
+ procedure Close (Stream : in out Stream_Type);
+
+private
+
+ use Ada.Streams;
+
+ type Buffer_Access is access all Stream_Element_Array;
+
+ type Stream_Type
+ is new Root_Stream_Type with
+ record
+ Mode : Stream_Mode;
+
+ Buffer : Buffer_Access;
+ Rest_First : Stream_Element_Offset;
+ Rest_Last : Stream_Element_Offset;
+ -- Buffer for Read operation.
+ -- We need to have this buffer in the record
+ -- becouse not all read data from back stream
+ -- could be processed during the read operation.
+
+ Buffer_Size : Stream_Element_Offset;
+ -- Buffer size for write operation.
+ -- We do not need to have this buffer
+ -- in the record becouse all data could be
+ -- processed in the write operation.
+
+ Back : Stream_Access;
+ Reader : Filter_Type;
+ Writer : Filter_Type;
+ end record;
+
+end ZLib.Streams;
diff --git a/zlib/contrib/ada/zlib-thin.adb b/zlib/contrib/ada/zlib-thin.adb
new file mode 100644
index 000000000..0ca4a7120
--- /dev/null
+++ b/zlib/contrib/ada/zlib-thin.adb
@@ -0,0 +1,141 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
+
+package body ZLib.Thin is
+
+ ZLIB_VERSION : constant Chars_Ptr := zlibVersion;
+
+ Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit;
+
+ --------------
+ -- Avail_In --
+ --------------
+
+ function Avail_In (Strm : in Z_Stream) return UInt is
+ begin
+ return Strm.Avail_In;
+ end Avail_In;
+
+ ---------------
+ -- Avail_Out --
+ ---------------
+
+ function Avail_Out (Strm : in Z_Stream) return UInt is
+ begin
+ return Strm.Avail_Out;
+ end Avail_Out;
+
+ ------------------
+ -- Deflate_Init --
+ ------------------
+
+ function Deflate_Init
+ (strm : Z_Streamp;
+ level : Int;
+ method : Int;
+ windowBits : Int;
+ memLevel : Int;
+ strategy : Int)
+ return Int is
+ begin
+ return deflateInit2
+ (strm,
+ level,
+ method,
+ windowBits,
+ memLevel,
+ strategy,
+ ZLIB_VERSION,
+ Z_Stream_Size);
+ end Deflate_Init;
+
+ ------------------
+ -- Inflate_Init --
+ ------------------
+
+ function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
+ begin
+ return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
+ end Inflate_Init;
+
+ ------------------------
+ -- Last_Error_Message --
+ ------------------------
+
+ function Last_Error_Message (Strm : in Z_Stream) return String is
+ use Interfaces.C.Strings;
+ begin
+ if Strm.msg = Null_Ptr then
+ return "";
+ else
+ return Value (Strm.msg);
+ end if;
+ end Last_Error_Message;
+
+ ------------
+ -- Set_In --
+ ------------
+
+ procedure Set_In
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt) is
+ begin
+ Strm.Next_In := Buffer;
+ Strm.Avail_In := Size;
+ end Set_In;
+
+ ------------------
+ -- Set_Mem_Func --
+ ------------------
+
+ procedure Set_Mem_Func
+ (Strm : in out Z_Stream;
+ Opaque : in Voidp;
+ Alloc : in alloc_func;
+ Free : in free_func) is
+ begin
+ Strm.opaque := Opaque;
+ Strm.zalloc := Alloc;
+ Strm.zfree := Free;
+ end Set_Mem_Func;
+
+ -------------
+ -- Set_Out --
+ -------------
+
+ procedure Set_Out
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt) is
+ begin
+ Strm.Next_Out := Buffer;
+ Strm.Avail_Out := Size;
+ end Set_Out;
+
+ --------------
+ -- Total_In --
+ --------------
+
+ function Total_In (Strm : in Z_Stream) return ULong is
+ begin
+ return Strm.Total_In;
+ end Total_In;
+
+ ---------------
+ -- Total_Out --
+ ---------------
+
+ function Total_Out (Strm : in Z_Stream) return ULong is
+ begin
+ return Strm.Total_Out;
+ end Total_Out;
+
+end ZLib.Thin;
diff --git a/zlib/contrib/ada/zlib-thin.ads b/zlib/contrib/ada/zlib-thin.ads
new file mode 100644
index 000000000..d4407eb80
--- /dev/null
+++ b/zlib/contrib/ada/zlib-thin.ads
@@ -0,0 +1,450 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
+
+with Interfaces.C.Strings;
+
+with System;
+
+private package ZLib.Thin is
+
+ -- From zconf.h
+
+ MAX_MEM_LEVEL : constant := 9; -- zconf.h:105
+ -- zconf.h:105
+ MAX_WBITS : constant := 15; -- zconf.h:115
+ -- 32K LZ77 window
+ -- zconf.h:115
+ SEEK_SET : constant := 8#0000#; -- zconf.h:244
+ -- Seek from beginning of file.
+ -- zconf.h:244
+ SEEK_CUR : constant := 1; -- zconf.h:245
+ -- Seek from current position.
+ -- zconf.h:245
+ SEEK_END : constant := 2; -- zconf.h:246
+ -- Set file pointer to EOF plus "offset"
+ -- zconf.h:246
+
+ type Byte is new Interfaces.C.unsigned_char; -- 8 bits
+ -- zconf.h:214
+ type UInt is new Interfaces.C.unsigned; -- 16 bits or more
+ -- zconf.h:216
+ type Int is new Interfaces.C.int;
+
+ type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more
+ -- zconf.h:217
+ subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;
+
+ type ULong_Access is access ULong;
+ type Int_Access is access Int;
+
+ subtype Voidp is System.Address; -- zconf.h:232
+
+ subtype Byte_Access is Voidp;
+
+ Nul : constant Voidp := System.Null_Address;
+ -- end from zconf
+
+ Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125
+ -- zlib.h:125
+ Z_PARTIAL_FLUSH : constant := 1; -- zlib.h:126
+ -- will be removed, use
+ -- Z_SYNC_FLUSH instead
+ -- zlib.h:126
+ Z_SYNC_FLUSH : constant := 2; -- zlib.h:127
+ -- zlib.h:127
+ Z_FULL_FLUSH : constant := 3; -- zlib.h:128
+ -- zlib.h:128
+ Z_FINISH : constant := 4; -- zlib.h:129
+ -- zlib.h:129
+ Z_OK : constant := 8#0000#; -- zlib.h:132
+ -- zlib.h:132
+ Z_STREAM_END : constant := 1; -- zlib.h:133
+ -- zlib.h:133
+ Z_NEED_DICT : constant := 2; -- zlib.h:134
+ -- zlib.h:134
+ Z_ERRNO : constant := -1; -- zlib.h:135
+ -- zlib.h:135
+ Z_STREAM_ERROR : constant := -2; -- zlib.h:136
+ -- zlib.h:136
+ Z_DATA_ERROR : constant := -3; -- zlib.h:137
+ -- zlib.h:137
+ Z_MEM_ERROR : constant := -4; -- zlib.h:138
+ -- zlib.h:138
+ Z_BUF_ERROR : constant := -5; -- zlib.h:139
+ -- zlib.h:139
+ Z_VERSION_ERROR : constant := -6; -- zlib.h:140
+ -- zlib.h:140
+ Z_NO_COMPRESSION : constant := 8#0000#; -- zlib.h:145
+ -- zlib.h:145
+ Z_BEST_SPEED : constant := 1; -- zlib.h:146
+ -- zlib.h:146
+ Z_BEST_COMPRESSION : constant := 9; -- zlib.h:147
+ -- zlib.h:147
+ Z_DEFAULT_COMPRESSION : constant := -1; -- zlib.h:148
+ -- zlib.h:148
+ Z_FILTERED : constant := 1; -- zlib.h:151
+ -- zlib.h:151
+ Z_HUFFMAN_ONLY : constant := 2; -- zlib.h:152
+ -- zlib.h:152
+ Z_DEFAULT_STRATEGY : constant := 8#0000#; -- zlib.h:153
+ -- zlib.h:153
+ Z_BINARY : constant := 8#0000#; -- zlib.h:156
+ -- zlib.h:156
+ Z_ASCII : constant := 1; -- zlib.h:157
+ -- zlib.h:157
+ Z_UNKNOWN : constant := 2; -- zlib.h:158
+ -- zlib.h:158
+ Z_DEFLATED : constant := 8; -- zlib.h:161
+ -- zlib.h:161
+ Z_NULL : constant := 8#0000#; -- zlib.h:164
+ -- for initializing zalloc, zfree, opaque
+ -- zlib.h:164
+ type gzFile is new Voidp; -- zlib.h:646
+
+ type Z_Stream is private;
+
+ type Z_Streamp is access all Z_Stream; -- zlib.h:89
+
+ type alloc_func is access function
+ (Opaque : Voidp;
+ Items : UInt;
+ Size : UInt)
+ return Voidp; -- zlib.h:63
+
+ type free_func is access procedure (opaque : Voidp; address : Voidp);
+
+ function zlibVersion return Chars_Ptr;
+
+ function Deflate (strm : Z_Streamp; flush : Int) return Int;
+
+ function DeflateEnd (strm : Z_Streamp) return Int;
+
+ function Inflate (strm : Z_Streamp; flush : Int) return Int;
+
+ function InflateEnd (strm : Z_Streamp) return Int;
+
+ function deflateSetDictionary
+ (strm : Z_Streamp;
+ dictionary : Byte_Access;
+ dictLength : UInt)
+ return Int;
+
+ function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int;
+ -- zlib.h:478
+
+ function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495
+
+ function deflateParams
+ (strm : Z_Streamp;
+ level : Int;
+ strategy : Int)
+ return Int; -- zlib.h:506
+
+ function inflateSetDictionary
+ (strm : Z_Streamp;
+ dictionary : Byte_Access;
+ dictLength : UInt)
+ return Int; -- zlib.h:548
+
+ function inflateSync (strm : Z_Streamp) return Int; -- zlib.h:565
+
+ function inflateReset (strm : Z_Streamp) return Int; -- zlib.h:580
+
+ function compress
+ (dest : Byte_Access;
+ destLen : ULong_Access;
+ source : Byte_Access;
+ sourceLen : ULong)
+ return Int; -- zlib.h:601
+
+ function compress2
+ (dest : Byte_Access;
+ destLen : ULong_Access;
+ source : Byte_Access;
+ sourceLen : ULong;
+ level : Int)
+ return Int; -- zlib.h:615
+
+ function uncompress
+ (dest : Byte_Access;
+ destLen : ULong_Access;
+ source : Byte_Access;
+ sourceLen : ULong)
+ return Int;
+
+ function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile;
+
+ function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile;
+
+ function gzsetparams
+ (file : gzFile;
+ level : Int;
+ strategy : Int)
+ return Int;
+
+ function gzread
+ (file : gzFile;
+ buf : Voidp;
+ len : UInt)
+ return Int;
+
+ function gzwrite
+ (file : in gzFile;
+ buf : in Voidp;
+ len : in UInt)
+ return Int;
+
+ function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int;
+
+ function gzputs (file : in gzFile; s : in Chars_Ptr) return Int;
+
+ function gzgets
+ (file : gzFile;
+ buf : Chars_Ptr;
+ len : Int)
+ return Chars_Ptr;
+
+ function gzputc (file : gzFile; char : Int) return Int;
+
+ function gzgetc (file : gzFile) return Int;
+
+ function gzflush (file : gzFile; flush : Int) return Int;
+
+ function gzseek
+ (file : gzFile;
+ offset : Int;
+ whence : Int)
+ return Int;
+
+ function gzrewind (file : gzFile) return Int;
+
+ function gztell (file : gzFile) return Int;
+
+ function gzeof (file : gzFile) return Int;
+
+ function gzclose (file : gzFile) return Int;
+
+ function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr;
+
+ function adler32
+ (adler : ULong;
+ buf : Byte_Access;
+ len : UInt)
+ return ULong;
+
+ function crc32
+ (crc : ULong;
+ buf : Byte_Access;
+ len : UInt)
+ return ULong;
+
+ function deflateInit
+ (strm : Z_Streamp;
+ level : Int;
+ version : Chars_Ptr;
+ stream_size : Int)
+ return Int;
+
+ function deflateInit2
+ (strm : Z_Streamp;
+ level : Int;
+ method : Int;
+ windowBits : Int;
+ memLevel : Int;
+ strategy : Int;
+ version : Chars_Ptr;
+ stream_size : Int)
+ return Int;
+
+ function Deflate_Init
+ (strm : Z_Streamp;
+ level : Int;
+ method : Int;
+ windowBits : Int;
+ memLevel : Int;
+ strategy : Int)
+ return Int;
+ pragma Inline (Deflate_Init);
+
+ function inflateInit
+ (strm : Z_Streamp;
+ version : Chars_Ptr;
+ stream_size : Int)
+ return Int;
+
+ function inflateInit2
+ (strm : in Z_Streamp;
+ windowBits : in Int;
+ version : in Chars_Ptr;
+ stream_size : in Int)
+ return Int;
+
+ function inflateBackInit
+ (strm : in Z_Streamp;
+ windowBits : in Int;
+ window : in Byte_Access;
+ version : in Chars_Ptr;
+ stream_size : in Int)
+ return Int;
+ -- Size of window have to be 2**windowBits.
+
+ function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int;
+ pragma Inline (Inflate_Init);
+
+ function zError (err : Int) return Chars_Ptr;
+
+ function inflateSyncPoint (z : Z_Streamp) return Int;
+
+ function get_crc_table return ULong_Access;
+
+ -- Interface to the available fields of the z_stream structure.
+ -- The application must update next_in and avail_in when avail_in has
+ -- dropped to zero. It must update next_out and avail_out when avail_out
+ -- has dropped to zero. The application must initialize zalloc, zfree and
+ -- opaque before calling the init function.
+
+ procedure Set_In
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt);
+ pragma Inline (Set_In);
+
+ procedure Set_Out
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt);
+ pragma Inline (Set_Out);
+
+ procedure Set_Mem_Func
+ (Strm : in out Z_Stream;
+ Opaque : in Voidp;
+ Alloc : in alloc_func;
+ Free : in free_func);
+ pragma Inline (Set_Mem_Func);
+
+ function Last_Error_Message (Strm : in Z_Stream) return String;
+ pragma Inline (Last_Error_Message);
+
+ function Avail_Out (Strm : in Z_Stream) return UInt;
+ pragma Inline (Avail_Out);
+
+ function Avail_In (Strm : in Z_Stream) return UInt;
+ pragma Inline (Avail_In);
+
+ function Total_In (Strm : in Z_Stream) return ULong;
+ pragma Inline (Total_In);
+
+ function Total_Out (Strm : in Z_Stream) return ULong;
+ pragma Inline (Total_Out);
+
+ function inflateCopy
+ (dest : in Z_Streamp;
+ Source : in Z_Streamp)
+ return Int;
+
+ function compressBound (Source_Len : in ULong) return ULong;
+
+ function deflateBound
+ (Strm : in Z_Streamp;
+ Source_Len : in ULong)
+ return ULong;
+
+ function gzungetc (C : in Int; File : in gzFile) return Int;
+
+ function zlibCompileFlags return ULong;
+
+private
+
+ type Z_Stream is record -- zlib.h:68
+ Next_In : Voidp := Nul; -- next input byte
+ Avail_In : UInt := 0; -- number of bytes available at next_in
+ Total_In : ULong := 0; -- total nb of input bytes read so far
+ Next_Out : Voidp := Nul; -- next output byte should be put there
+ Avail_Out : UInt := 0; -- remaining free space at next_out
+ Total_Out : ULong := 0; -- total nb of bytes output so far
+ msg : Chars_Ptr; -- last error message, NULL if no error
+ state : Voidp; -- not visible by applications
+ zalloc : alloc_func := null; -- used to allocate the internal state
+ zfree : free_func := null; -- used to free the internal state
+ opaque : Voidp; -- private data object passed to
+ -- zalloc and zfree
+ data_type : Int; -- best guess about the data type:
+ -- ascii or binary
+ adler : ULong; -- adler32 value of the uncompressed
+ -- data
+ reserved : ULong; -- reserved for future use
+ end record;
+
+ pragma Convention (C, Z_Stream);
+
+ pragma Import (C, zlibVersion, "zlibVersion");
+ pragma Import (C, Deflate, "deflate");
+ pragma Import (C, DeflateEnd, "deflateEnd");
+ pragma Import (C, Inflate, "inflate");
+ pragma Import (C, InflateEnd, "inflateEnd");
+ pragma Import (C, deflateSetDictionary, "deflateSetDictionary");
+ pragma Import (C, deflateCopy, "deflateCopy");
+ pragma Import (C, deflateReset, "deflateReset");
+ pragma Import (C, deflateParams, "deflateParams");
+ pragma Import (C, inflateSetDictionary, "inflateSetDictionary");
+ pragma Import (C, inflateSync, "inflateSync");
+ pragma Import (C, inflateReset, "inflateReset");
+ pragma Import (C, compress, "compress");
+ pragma Import (C, compress2, "compress2");
+ pragma Import (C, uncompress, "uncompress");
+ pragma Import (C, gzopen, "gzopen");
+ pragma Import (C, gzdopen, "gzdopen");
+ pragma Import (C, gzsetparams, "gzsetparams");
+ pragma Import (C, gzread, "gzread");
+ pragma Import (C, gzwrite, "gzwrite");
+ pragma Import (C, gzprintf, "gzprintf");
+ pragma Import (C, gzputs, "gzputs");
+ pragma Import (C, gzgets, "gzgets");
+ pragma Import (C, gzputc, "gzputc");
+ pragma Import (C, gzgetc, "gzgetc");
+ pragma Import (C, gzflush, "gzflush");
+ pragma Import (C, gzseek, "gzseek");
+ pragma Import (C, gzrewind, "gzrewind");
+ pragma Import (C, gztell, "gztell");
+ pragma Import (C, gzeof, "gzeof");
+ pragma Import (C, gzclose, "gzclose");
+ pragma Import (C, gzerror, "gzerror");
+ pragma Import (C, adler32, "adler32");
+ pragma Import (C, crc32, "crc32");
+ pragma Import (C, deflateInit, "deflateInit_");
+ pragma Import (C, inflateInit, "inflateInit_");
+ pragma Import (C, deflateInit2, "deflateInit2_");
+ pragma Import (C, inflateInit2, "inflateInit2_");
+ pragma Import (C, zError, "zError");
+ pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
+ pragma Import (C, get_crc_table, "get_crc_table");
+
+ -- since zlib 1.2.0:
+
+ pragma Import (C, inflateCopy, "inflateCopy");
+ pragma Import (C, compressBound, "compressBound");
+ pragma Import (C, deflateBound, "deflateBound");
+ pragma Import (C, gzungetc, "gzungetc");
+ pragma Import (C, zlibCompileFlags, "zlibCompileFlags");
+
+ pragma Import (C, inflateBackInit, "inflateBackInit_");
+
+ -- I stopped binding the inflateBack routines, becouse realize that
+ -- it does not support zlib and gzip headers for now, and have no
+ -- symmetric deflateBack routines.
+ -- ZLib-Ada is symmetric regarding deflate/inflate data transformation
+ -- and has a similar generic callback interface for the
+ -- deflate/inflate transformation based on the regular Deflate/Inflate
+ -- routines.
+
+ -- pragma Import (C, inflateBack, "inflateBack");
+ -- pragma Import (C, inflateBackEnd, "inflateBackEnd");
+
+end ZLib.Thin;
diff --git a/zlib/contrib/ada/zlib.adb b/zlib/contrib/ada/zlib.adb
new file mode 100644
index 000000000..8b6fd686a
--- /dev/null
+++ b/zlib/contrib/ada/zlib.adb
@@ -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;
diff --git a/zlib/contrib/ada/zlib.ads b/zlib/contrib/ada/zlib.ads
new file mode 100644
index 000000000..79ffc4095
--- /dev/null
+++ b/zlib/contrib/ada/zlib.ads
@@ -0,0 +1,328 @@
+------------------------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
+-- --
+-- This library is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or (at --
+-- your option) any later version. --
+-- --
+-- This library is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public License --
+-- along with this library; if not, write to the Free Software Foundation, --
+-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+------------------------------------------------------------------------------
+
+-- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $
+
+with Ada.Streams;
+
+with Interfaces;
+
+package ZLib is
+
+ ZLib_Error : exception;
+ Status_Error : exception;
+
+ type Compression_Level is new Integer range -1 .. 9;
+
+ type Flush_Mode is private;
+
+ type Compression_Method is private;
+
+ type Window_Bits_Type is new Integer range 8 .. 15;
+
+ type Memory_Level_Type is new Integer range 1 .. 9;
+
+ type Unsigned_32 is new Interfaces.Unsigned_32;
+
+ type Strategy_Type is private;
+
+ type Header_Type is (None, Auto, Default, GZip);
+ -- Header type usage have a some limitation for inflate.
+ -- See comment for Inflate_Init.
+
+ subtype Count is Ada.Streams.Stream_Element_Count;
+
+ Default_Memory_Level : constant Memory_Level_Type := 8;
+ Default_Window_Bits : constant Window_Bits_Type := 15;
+
+ ----------------------------------
+ -- Compression method constants --
+ ----------------------------------
+
+ Deflated : constant Compression_Method;
+ -- Only one method allowed in this ZLib version
+
+ ---------------------------------
+ -- Compression level constants --
+ ---------------------------------
+
+ No_Compression : constant Compression_Level := 0;
+ Best_Speed : constant Compression_Level := 1;
+ Best_Compression : constant Compression_Level := 9;
+ Default_Compression : constant Compression_Level := -1;
+
+ --------------------------
+ -- Flush mode constants --
+ --------------------------
+
+ No_Flush : constant Flush_Mode;
+ -- Regular way for compression, no flush
+
+ Partial_Flush : constant Flush_Mode;
+ -- Will be removed, use Z_SYNC_FLUSH instead
+
+ Sync_Flush : constant Flush_Mode;
+ -- All pending output is flushed to the output buffer and the output
+ -- is aligned on a byte boundary, so that the decompressor can get all
+ -- input data available so far. (In particular avail_in is zero after the
+ -- call if enough output space has been provided before the call.)
+ -- Flushing may degrade compression for some compression algorithms and so
+ -- it should be used only when necessary.
+
+ Block_Flush : constant Flush_Mode;
+ -- Z_BLOCK requests that inflate() stop
+ -- if and when it get to the next deflate block boundary. When decoding the
+ -- zlib or gzip format, this will cause inflate() to return immediately
+ -- after the header and before the first block. When doing a raw inflate,
+ -- inflate() will go ahead and process the first block, and will return
+ -- when it gets to the end of that block, or when it runs out of data.
+
+ Full_Flush : constant Flush_Mode;
+ -- All output is flushed as with SYNC_FLUSH, and the compression state
+ -- is reset so that decompression can restart from this point if previous
+ -- compressed data has been damaged or if random access is desired. Using
+ -- Full_Flush too often can seriously degrade the compression.
+
+ Finish : constant Flush_Mode;
+ -- Just for tell the compressor that input data is complete.
+
+ ------------------------------------
+ -- Compression strategy constants --
+ ------------------------------------
+
+ -- RLE stategy could be used only in version 1.2.0 and later.
+
+ Filtered : constant Strategy_Type;
+ Huffman_Only : constant Strategy_Type;
+ RLE : constant Strategy_Type;
+ Default_Strategy : constant Strategy_Type;
+
+ Default_Buffer_Size : constant := 4096;
+
+ type Filter_Type is tagged limited private;
+ -- The filter is for compression and for decompression.
+ -- The usage of the type is depend of its initialization.
+
+ function Version return String;
+ pragma Inline (Version);
+ -- Return string representation of the ZLib version.
+
+ 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);
+ -- Compressor initialization.
+ -- When Header parameter is Auto or Default, then default zlib header
+ -- would be provided for compressed data.
+ -- When Header is GZip, then gzip header would be set instead of
+ -- default header.
+ -- When Header is None, no header would be set for compressed data.
+
+ procedure Inflate_Init
+ (Filter : in out Filter_Type;
+ Window_Bits : in Window_Bits_Type := Default_Window_Bits;
+ Header : in Header_Type := Default);
+ -- Decompressor initialization.
+ -- Default header type mean that ZLib default header is expecting in the
+ -- input compressed stream.
+ -- Header type None mean that no header is expecting in the input stream.
+ -- GZip header type mean that GZip header is expecting in the
+ -- input compressed stream.
+ -- Auto header type mean that header type (GZip or Native) would be
+ -- detected automatically in the input stream.
+ -- Note that header types parameter values None, GZip and Auto are
+ -- supported for inflate routine only in ZLib versions 1.2.0.2 and later.
+ -- Deflate_Init is supporting all header types.
+
+ function Is_Open (Filter : in Filter_Type) return Boolean;
+ pragma Inline (Is_Open);
+ -- Is the filter opened for compression or decompression.
+
+ procedure Close
+ (Filter : in out Filter_Type;
+ Ignore_Error : in Boolean := False);
+ -- Closing the compression or decompressor.
+ -- If stream is closing before the complete and Ignore_Error is False,
+ -- The exception would be raised.
+
+ generic
+ with procedure Data_In
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+ with procedure Data_Out
+ (Item : in Ada.Streams.Stream_Element_Array);
+ procedure Generic_Translate
+ (Filter : in out Filter_Type;
+ In_Buffer_Size : in Integer := Default_Buffer_Size;
+ Out_Buffer_Size : in Integer := Default_Buffer_Size);
+ -- Compress/decompress data fetch from Data_In routine and pass the result
+ -- to the Data_Out routine. User should provide Data_In and Data_Out
+ -- for compression/decompression data flow.
+ -- Compression or decompression depend on Filter initialization.
+
+ function Total_In (Filter : in Filter_Type) return Count;
+ pragma Inline (Total_In);
+ -- Returns total number of input bytes read so far
+
+ function Total_Out (Filter : in Filter_Type) return Count;
+ pragma Inline (Total_Out);
+ -- Returns total number of bytes output so far
+
+ function CRC32
+ (CRC : in Unsigned_32;
+ Data : in Ada.Streams.Stream_Element_Array)
+ return Unsigned_32;
+ pragma Inline (CRC32);
+ -- Compute CRC32, it could be necessary for make gzip format
+
+ procedure CRC32
+ (CRC : in out Unsigned_32;
+ Data : in Ada.Streams.Stream_Element_Array);
+ pragma Inline (CRC32);
+ -- Compute CRC32, it could be necessary for make gzip format
+
+ -------------------------------------------------
+ -- Below is more complex low level routines. --
+ -------------------------------------------------
+
+ 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);
+ -- Compress/decompress the In_Data buffer and place the result into
+ -- Out_Data. In_Last is the index of last element from In_Data accepted by
+ -- the Filter. Out_Last is the last element of the received data from
+ -- Filter. To tell the filter that incoming data are complete put the
+ -- Flush parameter to Finish.
+
+ function Stream_End (Filter : in Filter_Type) return Boolean;
+ pragma Inline (Stream_End);
+ -- Return the true when the stream is complete.
+
+ 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);
+ pragma Inline (Flush);
+ -- Flushing the data from the compressor.
+
+ generic
+ with procedure Write
+ (Item : in Ada.Streams.Stream_Element_Array);
+ -- User should provide this routine for accept
+ -- compressed/decompressed data.
+
+ Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size;
+ -- Buffer size for Write user routine.
+
+ procedure Write
+ (Filter : in out Filter_Type;
+ Item : in Ada.Streams.Stream_Element_Array;
+ Flush : in Flush_Mode := No_Flush);
+ -- Compress/Decompress data from Item to the generic parameter procedure
+ -- Write. Output buffer size could be set in Buffer_Size generic parameter.
+
+ generic
+ with procedure Read
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+ -- User should provide data for compression/decompression
+ -- thru this routine.
+
+ Buffer : in out Ada.Streams.Stream_Element_Array;
+ -- Buffer for keep remaining data from the previous
+ -- back read.
+
+ Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset;
+ -- Rest_First have to be initialized to Buffer'Last + 1
+ -- Rest_Last have to be initialized to Buffer'Last
+ -- before usage.
+
+ Allow_Read_Some : in Boolean := False;
+ -- Is it allowed to return Last < Item'Last before end of data.
+
+ 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);
+ -- Compress/Decompress data from generic parameter procedure Read to the
+ -- Item. User should provide Buffer and initialized Rest_First, Rest_Last
+ -- indicators. If Allow_Read_Some is True, Read routines could return
+ -- Last < Item'Last only at end of stream.
+
+private
+
+ use Ada.Streams;
+
+ pragma Assert (Ada.Streams.Stream_Element'Size = 8);
+ pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8);
+
+ type Flush_Mode is new Integer range 0 .. 5;
+
+ type Compression_Method is new Integer range 8 .. 8;
+
+ type Strategy_Type is new Integer range 0 .. 3;
+
+ No_Flush : constant Flush_Mode := 0;
+ Partial_Flush : constant Flush_Mode := 1;
+ Sync_Flush : constant Flush_Mode := 2;
+ Full_Flush : constant Flush_Mode := 3;
+ Finish : constant Flush_Mode := 4;
+ Block_Flush : constant Flush_Mode := 5;
+
+ Filtered : constant Strategy_Type := 1;
+ Huffman_Only : constant Strategy_Type := 2;
+ RLE : constant Strategy_Type := 3;
+ Default_Strategy : constant Strategy_Type := 0;
+
+ Deflated : constant Compression_Method := 8;
+
+ type Z_Stream;
+
+ type Z_Stream_Access is access all Z_Stream;
+
+ type Filter_Type is tagged limited record
+ Strm : Z_Stream_Access;
+ Compression : Boolean;
+ Stream_End : Boolean;
+ Header : Header_Type;
+ CRC : Unsigned_32;
+ Offset : Stream_Element_Offset;
+ -- Offset for gzip header/footer output.
+ end record;
+
+end ZLib;
diff --git a/zlib/contrib/ada/zlib.gpr b/zlib/contrib/ada/zlib.gpr
new file mode 100644
index 000000000..296b22aa9
--- /dev/null
+++ b/zlib/contrib/ada/zlib.gpr
@@ -0,0 +1,20 @@
+project Zlib is
+
+ for Languages use ("Ada");
+ for Source_Dirs use (".");
+ for Object_Dir use ".";
+ for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");
+
+ package Compiler is
+ for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
+ end Compiler;
+
+ package Linker is
+ for Default_Switches ("ada") use ("-lz");
+ end Linker;
+
+ package Builder is
+ for Default_Switches ("ada") use ("-s", "-gnatQ");
+ end Builder;
+
+end Zlib;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 07:35:15 +0000