Fossil SCM

Carry forward [511ad59ae3] to the zlib 1.2.13 update: exclude all files from the contrib/ada subdirectory.

florian 2022-11-20 07:37 zlib-update

Commit aafa682bb9eac95e0ee722c18b28ceb43b5b82a360d1de9f142c86a9dd6f0d9f

Parent dc13e1e50e309d1…

12 files changed -90 -145 -147 -65 -450 -217 -106 -133 -442 -693 -301 -20

- compat/zlib/contrib/ada/buffer_demo.adb - compat/zlib/contrib/ada/mtest.adb - compat/zlib/contrib/ada/read.adb - compat/zlib/contrib/ada/readme.txt - compat/zlib/contrib/ada/test.adb - compat/zlib/contrib/ada/zlib-streams.adb - compat/zlib/contrib/ada/zlib-streams.ads - compat/zlib/contrib/ada/zlib-thin.adb - compat/zlib/contrib/ada/zlib-thin.ads - compat/zlib/contrib/ada/zlib.adb - compat/zlib/contrib/ada/zlib.ads - compat/zlib/contrib/ada/zlib.gpr

D compat/zlib/contrib/ada/buffer_demo.adb

-90

		--- a/compat/zlib/contrib/ada/buffer_demo.adb
		+++ b/compat/zlib/contrib/ada/buffer_demo.adb
		@@ -1,106 +0,0 @@
		-----------------------------------------------------------------
		--- 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 $
1		-
		--- This demo program provided by Dr Steve Sangwine <[email protected]>
		---
		--- 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.
2		-
		--- This program compresses a string of text, and then decompresses the
		--- compressed text into a buffer of the same size as the original text.
3		-
4		-with Ada.Streams; use Ada.Streams;
5		-with Ada.Text_IO;
6		-
7		-with ZLib; use ZLib;
8		-
9		-procedure Buffer_Demo is
10		- EOL : Character renames ASCII.LF;
11		- Text : constant String
12		- := "Four score and seven years ago our fathers brought forth," & EOL &
13		- "upon this continent, a new nation, conceived in liberty," & EOL &
14		- "and dedicated to the proposition that `all men are created equal'.";
15		-
16		- Source : Stream_Element_Array (1 .. Text'Length);
17		- for Source'Address use Text'Address;
18		-
19		-begin
20		- Ada.Text_IO.Put (Text);
21		- Ada.Text_IO.New_Line;
22		- Ada.Text_IO.Put_Line
23		- ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
24		-
25		- declare
26		- Compressed_Data : Stream_Element_Array (1 .. Text'Length);
27		- L : Stream_Element_Offset;
28		- begin
29		- Compress : declare
30		- Compressor : Filter_Type;
31		- I : Stream_Element_Offset;
32		- begin
33		- Deflate_Init (Compressor);
34		-
35		- -- Compress the whole of T at once.
36		-
37		- Translate (Compressor, Source, I, Compressed_Data, L, Finish);
38		- pragma Assert (I = Source'Last);
39		-
40		- Close (Compressor);
41		-
42		- Ada.Text_IO.Put_Line
43		- ("Compressed size : "
44		- & Stream_Element_Offset'Image (L) & " bytes");
45		- end Compress;
46		-
47		- -- Now we decompress the data, passing short blocks of data to Zlib
48		- -- (because this demonstrates the problem - the last block passed will
49		- -- contain checksum information and there will be no output, only a
50		- -- check inside Zlib that the checksum is correct).
51		-
52		- Decompress : declare
53		- Decompressor : Filter_Type;
54		-
55		- Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
56		-
57		- Block_Size : constant := 4;
58		- -- This makes sure that the last block contains
59		- -- only Adler checksum data.
60		-
61		- P : Stream_Element_Offset := Compressed_Data'First - 1;
62		- O : Stream_Element_Offset;
63		- begin
64		- Inflate_Init (Decompressor);
65		-
66		- loop
67		- Translate
68		- (Decompressor,
69		- Compressed_Data
70		- (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
71		- P,
72		- Uncompressed_Data
73		- (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
74		- O,
75		- No_Flush);
76		-
77		- Ada.Text_IO.Put_Line
78		- ("Total in : " & Count'Image (Total_In (Decompressor)) &
79		- ", out : " & Count'Image (Total_Out (Decompressor)));
80		-
81		- exit when P = L;
82		- end loop;
83		-
84		- Ada.Text_IO.New_Line;
85		- Ada.Text_IO.Put_Line
86		- ("Decompressed text matches original text : "
87		- & Boolean'Image (Uncompressed_Data = Source));
88		- end Decompress;
89		- end;
90		-end Buffer_Demo;

	--- a/compat/zlib/contrib/ada/buffer_demo.adb
	+++ b/compat/zlib/contrib/ada/buffer_demo.adb
	@@ -1,106 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $
1
	--- This demo program provided by Dr Steve Sangwine <[email protected]>
	---
	--- 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.
2
	--- This program compresses a string of text, and then decompresses the
	--- compressed text into a buffer of the same size as the original text.
3
4	with Ada.Streams; use Ada.Streams;
5	with Ada.Text_IO;
6
7	with ZLib; use ZLib;
8
9	procedure Buffer_Demo is
10	EOL : Character renames ASCII.LF;
11	Text : constant String
12	:= "Four score and seven years ago our fathers brought forth," & EOL &
13	"upon this continent, a new nation, conceived in liberty," & EOL &
14	"and dedicated to the proposition that `all men are created equal'.";
15
16	Source : Stream_Element_Array (1 .. Text'Length);
17	for Source'Address use Text'Address;
18
19	begin
20	Ada.Text_IO.Put (Text);
21	Ada.Text_IO.New_Line;
22	Ada.Text_IO.Put_Line
23	("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
24
25	declare
26	Compressed_Data : Stream_Element_Array (1 .. Text'Length);
27	L : Stream_Element_Offset;
28	begin
29	Compress : declare
30	Compressor : Filter_Type;
31	I : Stream_Element_Offset;
32	begin
33	Deflate_Init (Compressor);
34
35	-- Compress the whole of T at once.
36
37	Translate (Compressor, Source, I, Compressed_Data, L, Finish);
38	pragma Assert (I = Source'Last);
39
40	Close (Compressor);
41
42	Ada.Text_IO.Put_Line
43	("Compressed size : "
44	& Stream_Element_Offset'Image (L) & " bytes");
45	end Compress;
46
47	-- Now we decompress the data, passing short blocks of data to Zlib
48	-- (because this demonstrates the problem - the last block passed will
49	-- contain checksum information and there will be no output, only a
50	-- check inside Zlib that the checksum is correct).
51
52	Decompress : declare
53	Decompressor : Filter_Type;
54
55	Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
56
57	Block_Size : constant := 4;
58	-- This makes sure that the last block contains
59	-- only Adler checksum data.
60
61	P : Stream_Element_Offset := Compressed_Data'First - 1;
62	O : Stream_Element_Offset;
63	begin
64	Inflate_Init (Decompressor);
65
66	loop
67	Translate
68	(Decompressor,
69	Compressed_Data
70	(P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
71	P,
72	Uncompressed_Data
73	(Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
74	O,
75	No_Flush);
76
77	Ada.Text_IO.Put_Line
78	("Total in : " & Count'Image (Total_In (Decompressor)) &
79	", out : " & Count'Image (Total_Out (Decompressor)));
80
81	exit when P = L;
82	end loop;
83
84	Ada.Text_IO.New_Line;
85	Ada.Text_IO.Put_Line
86	("Decompressed text matches original text : "
87	& Boolean'Image (Uncompressed_Data = Source));
88	end Decompress;
89	end;
90	end Buffer_Demo;

	--- a/compat/zlib/contrib/ada/buffer_demo.adb
	+++ b/compat/zlib/contrib/ada/buffer_demo.adb
	@@ -1,106 +0,0 @@
	-----------------------------------------------------------------
	--- 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 <[email protected]>
	---
	--- 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.

D compat/zlib/contrib/ada/mtest.adb

-145

		--- a/compat/zlib/contrib/ada/mtest.adb
		+++ b/compat/zlib/contrib/ada/mtest.adb
		@@ -1,156 +0,0 @@
		-----------------------------------------------------------------
		--- 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 $
1		-
2		-with ZLib;
3		-with Ada.Streams;
4		-with Ada.Numerics.Discrete_Random;
5		-with Ada.Text_IO;
6		-with Ada.Exceptions;
7		-with Ada.Task_Identification;
8		-
9		-procedure MTest is
10		- use Ada.Streams;
11		- use ZLib;
12		-
13		- Stop : Boolean := False;
14		-
15		- pragma Atomic (Stop);
16		-
17		- subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
18		-
19		- package Random_Elements is
20		- new Ada.Numerics.Discrete_Random (Visible_Symbols);
21		-
22		- task type Test_Task;
23		-
24		- task body Test_Task is
25		- Buffer : Stream_Element_Array (1 .. 100_000);
26		- Gen : Random_Elements.Generator;
27		-
28		- Buffer_First : Stream_Element_Offset;
29		- Compare_First : Stream_Element_Offset;
30		-
31		- Deflate : Filter_Type;
32		- Inflate : Filter_Type;
33		-
34		- procedure Further (Item : in Stream_Element_Array);
35		-
36		- procedure Read_Buffer
37		- (Item : out Ada.Streams.Stream_Element_Array;
38		- Last : out Ada.Streams.Stream_Element_Offset);
39		-
40		- -------------
41		- -- Further --
42		- -------------
43		-
44		- procedure Further (Item : in Stream_Element_Array) is
45		-
46		- procedure Compare (Item : in Stream_Element_Array);
47		-
48		- -------------
49		- -- Compare --
50		- -------------
51		-
52		- procedure Compare (Item : in Stream_Element_Array) is
53		- Next_First : Stream_Element_Offset := Compare_First + Item'Length;
54		- begin
55		- if Buffer (Compare_First .. Next_First - 1) /= Item then
56		- raise Program_Error;
57		- end if;
58		-
59		- Compare_First := Next_First;
60		- end Compare;
61		-
62		- procedure Compare_Write is new ZLib.Write (Write => Compare);
63		- begin
64		- Compare_Write (Inflate, Item, No_Flush);
65		- end Further;
66		-
67		- -----------------
68		- -- Read_Buffer --
69		- -----------------
70		-
71		- procedure Read_Buffer
72		- (Item : out Ada.Streams.Stream_Element_Array;
73		- Last : out Ada.Streams.Stream_Element_Offset)
74		- is
75		- Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First;
76		- Next_First : Stream_Element_Offset;
77		- begin
78		- if Item'Length <= Buff_Diff then
79		- Last := Item'Last;
80		-
81		- Next_First := Buffer_First + Item'Length;
82		-
83		- Item := Buffer (Buffer_First .. Next_First - 1);
84		-
85		- Buffer_First := Next_First;
86		- else
87		- Last := Item'First + Buff_Diff;
88		- Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);
89		- Buffer_First := Buffer'Last + 1;
90		- end if;
91		- end Read_Buffer;
92		-
93		- procedure Translate is new Generic_Translate
94		- (Data_In => Read_Buffer,
95		- Data_Out => Further);
96		-
97		- begin
98		- Random_Elements.Reset (Gen);
99		-
100		- Buffer := (others => 20);
101		-
102		- Main : loop
103		- for J in Buffer'Range loop
104		- Buffer (J) := Random_Elements.Random (Gen);
105		-
106		- Deflate_Init (Deflate);
107		- Inflate_Init (Inflate);
108		-
109		- Buffer_First := Buffer'First;
110		- Compare_First := Buffer'First;
111		-
112		- Translate (Deflate);
113		-
114		- if Compare_First /= Buffer'Last + 1 then
115		- raise Program_Error;
116		- end if;
117		-
118		- Ada.Text_IO.Put_Line
119		- (Ada.Task_Identification.Image
120		- (Ada.Task_Identification.Current_Task)
121		- & Stream_Element_Offset'Image (J)
122		- & ZLib.Count'Image (Total_Out (Deflate)));
123		-
124		- Close (Deflate);
125		- Close (Inflate);
126		-
127		- exit Main when Stop;
128		- end loop;
129		- end loop Main;
130		- exception
131		- when E : others =>
132		- Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
133		- Stop := True;
134		- end Test_Task;
135		-
136		- Test : array (1 .. 4) of Test_Task;
137		-
138		- pragma Unreferenced (Test);
139		-
140		- Dummy : Character;
141		-
142		-begin
143		- Ada.Text_IO.Get_Immediate (Dummy);
144		- Stop := True;
145		-end MTest;

	--- a/compat/zlib/contrib/ada/mtest.adb
	+++ b/compat/zlib/contrib/ada/mtest.adb
	@@ -1,156 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $
1
2	with ZLib;
3	with Ada.Streams;
4	with Ada.Numerics.Discrete_Random;
5	with Ada.Text_IO;
6	with Ada.Exceptions;
7	with Ada.Task_Identification;
8
9	procedure MTest is
10	use Ada.Streams;
11	use ZLib;
12
13	Stop : Boolean := False;
14
15	pragma Atomic (Stop);
16
17	subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
18
19	package Random_Elements is
20	new Ada.Numerics.Discrete_Random (Visible_Symbols);
21
22	task type Test_Task;
23
24	task body Test_Task is
25	Buffer : Stream_Element_Array (1 .. 100_000);
26	Gen : Random_Elements.Generator;
27
28	Buffer_First : Stream_Element_Offset;
29	Compare_First : Stream_Element_Offset;
30
31	Deflate : Filter_Type;
32	Inflate : Filter_Type;
33
34	procedure Further (Item : in Stream_Element_Array);
35
36	procedure Read_Buffer
37	(Item : out Ada.Streams.Stream_Element_Array;
38	Last : out Ada.Streams.Stream_Element_Offset);
39
40	-------------
41	-- Further --
42	-------------
43
44	procedure Further (Item : in Stream_Element_Array) is
45
46	procedure Compare (Item : in Stream_Element_Array);
47
48	-------------
49	-- Compare --
50	-------------
51
52	procedure Compare (Item : in Stream_Element_Array) is
53	Next_First : Stream_Element_Offset := Compare_First + Item'Length;
54	begin
55	if Buffer (Compare_First .. Next_First - 1) /= Item then
56	raise Program_Error;
57	end if;
58
59	Compare_First := Next_First;
60	end Compare;
61
62	procedure Compare_Write is new ZLib.Write (Write => Compare);
63	begin
64	Compare_Write (Inflate, Item, No_Flush);
65	end Further;
66
67	-----------------
68	-- Read_Buffer --
69	-----------------
70
71	procedure Read_Buffer
72	(Item : out Ada.Streams.Stream_Element_Array;
73	Last : out Ada.Streams.Stream_Element_Offset)
74	is
75	Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First;
76	Next_First : Stream_Element_Offset;
77	begin
78	if Item'Length <= Buff_Diff then
79	Last := Item'Last;
80
81	Next_First := Buffer_First + Item'Length;
82
83	Item := Buffer (Buffer_First .. Next_First - 1);
84
85	Buffer_First := Next_First;
86	else
87	Last := Item'First + Buff_Diff;
88	Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);
89	Buffer_First := Buffer'Last + 1;
90	end if;
91	end Read_Buffer;
92
93	procedure Translate is new Generic_Translate
94	(Data_In => Read_Buffer,
95	Data_Out => Further);
96
97	begin
98	Random_Elements.Reset (Gen);
99
100	Buffer := (others => 20);
101
102	Main : loop
103	for J in Buffer'Range loop
104	Buffer (J) := Random_Elements.Random (Gen);
105
106	Deflate_Init (Deflate);
107	Inflate_Init (Inflate);
108
109	Buffer_First := Buffer'First;
110	Compare_First := Buffer'First;
111
112	Translate (Deflate);
113
114	if Compare_First /= Buffer'Last + 1 then
115	raise Program_Error;
116	end if;
117
118	Ada.Text_IO.Put_Line
119	(Ada.Task_Identification.Image
120	(Ada.Task_Identification.Current_Task)
121	& Stream_Element_Offset'Image (J)
122	& ZLib.Count'Image (Total_Out (Deflate)));
123
124	Close (Deflate);
125	Close (Inflate);
126
127	exit Main when Stop;
128	end loop;
129	end loop Main;
130	exception
131	when E : others =>
132	Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
133	Stop := True;
134	end Test_Task;
135
136	Test : array (1 .. 4) of Test_Task;
137
138	pragma Unreferenced (Test);
139
140	Dummy : Character;
141
142	begin
143	Ada.Text_IO.Get_Immediate (Dummy);
144	Stop := True;
145	end MTest;

	--- a/compat/zlib/contrib/ada/mtest.adb
	+++ b/compat/zlib/contrib/ada/mtest.adb
	@@ -1,156 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/read.adb

-147

		--- a/compat/zlib/contrib/ada/read.adb
		+++ b/compat/zlib/contrib/ada/read.adb
		@@ -1,156 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
2		-
		--- Test/demo program for the generic read interface.
3		-
4		-with Ada.Numerics.Discrete_Random;
5		-with Ada.Streams;
6		-with Ada.Text_IO;
7		-
8		-with ZLib;
9		-
10		-procedure Read is
11		-
12		- use Ada.Streams;
13		-
14		- ------------------------------------
15		- -- Test configuration parameters --
16		- ------------------------------------
17		-
18		- File_Size : Stream_Element_Offset := 100_000;
19		-
20		- Continuous : constant Boolean := False;
21		- -- If this constant is True, the test would be repeated again and again,
22		- -- with increment File_Size for every iteration.
23		-
24		- Header : constant ZLib.Header_Type := ZLib.Default;
25		- -- Do not use Header other than Default in ZLib versions 1.1.4 and older.
26		-
27		- Init_Random : constant := 8;
28		- -- We are using the same random sequence, in case of we catch bug,
29		- -- so we would be able to reproduce it.
30		-
31		- -- End --
32		-
33		- Pack_Size : Stream_Element_Offset;
34		- Offset : Stream_Element_Offset;
35		-
36		- Filter : ZLib.Filter_Type;
37		-
38		- subtype Visible_Symbols
39		- is Stream_Element range 16#20# .. 16#7E#;
40		-
41		- package Random_Elements is new
42		- Ada.Numerics.Discrete_Random (Visible_Symbols);
43		-
44		- Gen : Random_Elements.Generator;
45		- Period : constant Stream_Element_Offset := 200;
46		- -- Period constant variable for random generator not to be very random.
47		- -- Bigger period, harder random.
48		-
49		- Read_Buffer : Stream_Element_Array (1 .. 2048);
50		- Read_First : Stream_Element_Offset;
51		- Read_Last : Stream_Element_Offset;
52		-
53		- procedure Reset;
54		-
55		- procedure Read
56		- (Item : out Stream_Element_Array;
57		- Last : out Stream_Element_Offset);
58		- -- this procedure is for generic instantiation of
59		- -- ZLib.Read
60		- -- reading data from the File_In.
61		-
62		- procedure Read is new ZLib.Read
63		- (Read,
64		- Read_Buffer,
65		- Rest_First => Read_First,
66		- Rest_Last => Read_Last);
67		-
68		- ----------
69		- -- Read --
70		- ----------
71		-
72		- procedure Read
73		- (Item : out Stream_Element_Array;
74		- Last : out Stream_Element_Offset) is
75		- begin
76		- Last := Stream_Element_Offset'Min
77		- (Item'Last,
78		- Item'First + File_Size - Offset);
79		-
80		- for J in Item'First .. Last loop
81		- if J < Item'First + Period then
82		- Item (J) := Random_Elements.Random (Gen);
83		- else
84		- Item (J) := Item (J - Period);
85		- end if;
86		-
87		- Offset := Offset + 1;
88		- end loop;
89		- end Read;
90		-
91		- -----------
92		- -- Reset --
93		- -----------
94		-
95		- procedure Reset is
96		- begin
97		- Random_Elements.Reset (Gen, Init_Random);
98		- Pack_Size := 0;
99		- Offset := 1;
100		- Read_First := Read_Buffer'Last + 1;
101		- Read_Last := Read_Buffer'Last;
102		- end Reset;
103		-
104		-begin
105		- Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
106		-
107		- loop
108		- for Level in ZLib.Compression_Level'Range loop
109		-
110		- Ada.Text_IO.Put ("Level ="
111		- & ZLib.Compression_Level'Image (Level));
112		-
113		- -- Deflate using generic instantiation.
114		-
115		- ZLib.Deflate_Init
116		- (Filter,
117		- Level,
118		- Header => Header);
119		-
120		- Reset;
121		-
122		- Ada.Text_IO.Put
123		- (Stream_Element_Offset'Image (File_Size) & " ->");
124		-
125		- loop
126		- declare
127		- Buffer : Stream_Element_Array (1 .. 1024);
128		- Last : Stream_Element_Offset;
129		- begin
130		- Read (Filter, Buffer, Last);
131		-
132		- Pack_Size := Pack_Size + Last - Buffer'First + 1;
133		-
134		- exit when Last < Buffer'Last;
135		- end;
136		- end loop;
137		-
138		- Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
139		-
140		- ZLib.Close (Filter);
141		- end loop;
142		-
143		- exit when not Continuous;
144		-
145		- File_Size := File_Size + 1;
146		- end loop;
147		-end Read;

	--- a/compat/zlib/contrib/ada/read.adb
	+++ b/compat/zlib/contrib/ada/read.adb
	@@ -1,156 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
2
	--- Test/demo program for the generic read interface.
3
4	with Ada.Numerics.Discrete_Random;
5	with Ada.Streams;
6	with Ada.Text_IO;
7
8	with ZLib;
9
10	procedure Read is
11
12	use Ada.Streams;
13
14	------------------------------------
15	-- Test configuration parameters --
16	------------------------------------
17
18	File_Size : Stream_Element_Offset := 100_000;
19
20	Continuous : constant Boolean := False;
21	-- If this constant is True, the test would be repeated again and again,
22	-- with increment File_Size for every iteration.
23
24	Header : constant ZLib.Header_Type := ZLib.Default;
25	-- Do not use Header other than Default in ZLib versions 1.1.4 and older.
26
27	Init_Random : constant := 8;
28	-- We are using the same random sequence, in case of we catch bug,
29	-- so we would be able to reproduce it.
30
31	-- End --
32
33	Pack_Size : Stream_Element_Offset;
34	Offset : Stream_Element_Offset;
35
36	Filter : ZLib.Filter_Type;
37
38	subtype Visible_Symbols
39	is Stream_Element range 16#20# .. 16#7E#;
40
41	package Random_Elements is new
42	Ada.Numerics.Discrete_Random (Visible_Symbols);
43
44	Gen : Random_Elements.Generator;
45	Period : constant Stream_Element_Offset := 200;
46	-- Period constant variable for random generator not to be very random.
47	-- Bigger period, harder random.
48
49	Read_Buffer : Stream_Element_Array (1 .. 2048);
50	Read_First : Stream_Element_Offset;
51	Read_Last : Stream_Element_Offset;
52
53	procedure Reset;
54
55	procedure Read
56	(Item : out Stream_Element_Array;
57	Last : out Stream_Element_Offset);
58	-- this procedure is for generic instantiation of
59	-- ZLib.Read
60	-- reading data from the File_In.
61
62	procedure Read is new ZLib.Read
63	(Read,
64	Read_Buffer,
65	Rest_First => Read_First,
66	Rest_Last => Read_Last);
67
68	----------
69	-- Read --
70	----------
71
72	procedure Read
73	(Item : out Stream_Element_Array;
74	Last : out Stream_Element_Offset) is
75	begin
76	Last := Stream_Element_Offset'Min
77	(Item'Last,
78	Item'First + File_Size - Offset);
79
80	for J in Item'First .. Last loop
81	if J < Item'First + Period then
82	Item (J) := Random_Elements.Random (Gen);
83	else
84	Item (J) := Item (J - Period);
85	end if;
86
87	Offset := Offset + 1;
88	end loop;
89	end Read;
90
91	-----------
92	-- Reset --
93	-----------
94
95	procedure Reset is
96	begin
97	Random_Elements.Reset (Gen, Init_Random);
98	Pack_Size := 0;
99	Offset := 1;
100	Read_First := Read_Buffer'Last + 1;
101	Read_Last := Read_Buffer'Last;
102	end Reset;
103
104	begin
105	Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
106
107	loop
108	for Level in ZLib.Compression_Level'Range loop
109
110	Ada.Text_IO.Put ("Level ="
111	& ZLib.Compression_Level'Image (Level));
112
113	-- Deflate using generic instantiation.
114
115	ZLib.Deflate_Init
116	(Filter,
117	Level,
118	Header => Header);
119
120	Reset;
121
122	Ada.Text_IO.Put
123	(Stream_Element_Offset'Image (File_Size) & " ->");
124
125	loop
126	declare
127	Buffer : Stream_Element_Array (1 .. 1024);
128	Last : Stream_Element_Offset;
129	begin
130	Read (Filter, Buffer, Last);
131
132	Pack_Size := Pack_Size + Last - Buffer'First + 1;
133
134	exit when Last < Buffer'Last;
135	end;
136	end loop;
137
138	Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
139
140	ZLib.Close (Filter);
141	end loop;
142
143	exit when not Continuous;
144
145	File_Size := File_Size + 1;
146	end loop;
147	end Read;

	--- a/compat/zlib/contrib/ada/read.adb
	+++ b/compat/zlib/contrib/ada/read.adb
	@@ -1,156 +0,0 @@
	-----------------------------------------------------------------
	--- 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.

D compat/zlib/contrib/ada/readme.txt

-65

		--- a/compat/zlib/contrib/ada/readme.txt
		+++ b/compat/zlib/contrib/ada/readme.txt
		@@ -1,65 +0,0 @@
1		- ZLib for Ada thick binding (ZLib.Ada)
2		- Release 1.3
3		-
4		-ZLib.Ada is a thick binding interface to the popular ZLib data
5		-compression library, available at http://www.gzip.org/zlib/.
6		-It provides Ada-style access to the ZLib C library.
7		-
8		-
9		- Here are the main changes since ZLib.Ada 1.2:
10		-
11		-- Attension: ZLib.Read generic routine have a initialization requirement
12		- for Read_Last parameter now. It is a bit incompartible with previous version,
13		- but extends functionality, we could use new parameters Allow_Read_Some and
14		- Flush now.
15		-
16		-- Added Is_Open routines to ZLib and ZLib.Streams packages.
17		-
18		-- Add pragma Assert to check Stream_Element is 8 bit.
19		-
20		-- Fix extraction to buffer with exact known decompressed size. Error reported by
21		- Steve Sangwine.
22		-
23		-- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits
24		- computers. Patch provided by Pascal Obry.
25		-
26		-- Add Status_Error exception definition.
27		-
28		-- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit.
29		-
30		-
31		- How to build ZLib.Ada under GNAT
32		-
33		-You should have the ZLib library already build on your computer, before
34		-building ZLib.Ada. Make the directory of ZLib.Ada sources current and
35		-issue the command:
36		-
37		- gnatmake test -largs -L<directory where libz.a is> -lz
38		-
39		-Or use the GNAT project file build for GNAT 3.15 or later:
40		-
41		- gnatmake -Pzlib.gpr -L<directory where libz.a is>
42		-
43		-
44		- How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2
45		-
46		-1. Make a project with all .ads and .adb files from the distribution.
47		-2. Build the libz.a library from the ZLib C sources.
48		-3. Rename libz.a to z.lib.
49		-4. Add the library z.lib to the project.
50		-5. Add the libc.lib library from the ObjectAda distribution to the project.
51		-6. Build the executable using test.adb as a main procedure.
52		-
53		-
54		- How to use ZLib.Ada
55		-
56		-The source files test.adb and read.adb are small demo programs that show
57		-the main functionality of ZLib.Ada.
58		-
59		-The routines from the package specifications are commented.
60		-
61		-
62		-Homepage: http://zlib-ada.sourceforge.net/
63		-Author: Dmitriy Anisimkov <[email protected]>
64		-
65		-Contributors: Pascal Obry <[email protected]>, Steve Sangwine <[email protected]>

	--- a/compat/zlib/contrib/ada/readme.txt
	+++ b/compat/zlib/contrib/ada/readme.txt
	@@ -1,65 +0,0 @@
1	ZLib for Ada thick binding (ZLib.Ada)
2	Release 1.3
3
4	ZLib.Ada is a thick binding interface to the popular ZLib data
5	compression library, available at http://www.gzip.org/zlib/.
6	It provides Ada-style access to the ZLib C library.
7
8
9	Here are the main changes since ZLib.Ada 1.2:
10
11	- Attension: ZLib.Read generic routine have a initialization requirement
12	for Read_Last parameter now. It is a bit incompartible with previous version,
13	but extends functionality, we could use new parameters Allow_Read_Some and
14	Flush now.
15
16	- Added Is_Open routines to ZLib and ZLib.Streams packages.
17
18	- Add pragma Assert to check Stream_Element is 8 bit.
19
20	- Fix extraction to buffer with exact known decompressed size. Error reported by
21	Steve Sangwine.
22
23	- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits
24	computers. Patch provided by Pascal Obry.
25
26	- Add Status_Error exception definition.
27
28	- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit.
29
30
31	How to build ZLib.Ada under GNAT
32
33	You should have the ZLib library already build on your computer, before
34	building ZLib.Ada. Make the directory of ZLib.Ada sources current and
35	issue the command:
36
37	gnatmake test -largs -L<directory where libz.a is> -lz
38
39	Or use the GNAT project file build for GNAT 3.15 or later:
40
41	gnatmake -Pzlib.gpr -L<directory where libz.a is>
42
43
44	How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2
45
46	1. Make a project with all .ads and .adb files from the distribution.
47	2. Build the libz.a library from the ZLib C sources.
48	3. Rename libz.a to z.lib.
49	4. Add the library z.lib to the project.
50	5. Add the libc.lib library from the ObjectAda distribution to the project.
51	6. Build the executable using test.adb as a main procedure.
52
53
54	How to use ZLib.Ada
55
56	The source files test.adb and read.adb are small demo programs that show
57	the main functionality of ZLib.Ada.
58
59	The routines from the package specifications are commented.
60
61
62	Homepage: http://zlib-ada.sourceforge.net/
63	Author: Dmitriy Anisimkov <[email protected]>
64
65	Contributors: Pascal Obry <[email protected]>, Steve Sangwine <[email protected]>

	--- a/compat/zlib/contrib/ada/readme.txt
	+++ b/compat/zlib/contrib/ada/readme.txt
	@@ -1,65 +0,0 @@

D compat/zlib/contrib/ada/test.adb

-450

		--- a/compat/zlib/contrib/ada/test.adb
		+++ b/compat/zlib/contrib/ada/test.adb
		@@ -1,463 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $
2		-
		--- 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.
3		-
4		-with ZLib.Streams;
5		-with Ada.Streams.Stream_IO;
6		-with Ada.Numerics.Discrete_Random;
7		-
8		-with Ada.Text_IO;
9		-
10		-with Ada.Calendar;
11		-
12		-procedure Test is
13		-
14		- use Ada.Streams;
15		- use Stream_IO;
16		-
17		- ------------------------------------
18		- -- Test configuration parameters --
19		- ------------------------------------
20		-
21		- File_Size : Count := 100_000;
22		- Continuous : constant Boolean := False;
23		-
24		- Header : constant ZLib.Header_Type := ZLib.Default;
25		- -- ZLib.None;
26		- -- ZLib.Auto;
27		- -- ZLib.GZip;
28		- -- Do not use Header other then Default in ZLib versions 1.1.4
29		- -- and older.
30		-
31		- Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
32		- Init_Random : constant := 10;
33		-
34		- -- End --
35		-
36		- In_File_Name : constant String := "testzlib.in";
37		- -- Name of the input file
38		-
39		- Z_File_Name : constant String := "testzlib.zlb";
40		- -- Name of the compressed file.
41		-
42		- Out_File_Name : constant String := "testzlib.out";
43		- -- Name of the decompressed file.
44		-
45		- File_In : File_Type;
46		- File_Out : File_Type;
47		- File_Back : File_Type;
48		- File_Z : ZLib.Streams.Stream_Type;
49		-
50		- Filter : ZLib.Filter_Type;
51		-
52		- Time_Stamp : Ada.Calendar.Time;
53		-
54		- procedure Generate_File;
55		- -- Generate file of spetsified size with some random data.
56		- -- The random data is repeatable, for the good compression.
57		-
58		- procedure Compare_Streams
59		- (Left, Right : in out Root_Stream_Type'Class);
60		- -- The procedure compearing data in 2 streams.
61		- -- It is for compare data before and after compression/decompression.
62		-
63		- procedure Compare_Files (Left, Right : String);
64		- -- Compare files. Based on the Compare_Streams.
65		-
66		- procedure Copy_Streams
67		- (Source, Target : in out Root_Stream_Type'Class;
68		- Buffer_Size : in Stream_Element_Offset := 1024);
69		- -- Copying data from one stream to another. It is for test stream
70		- -- interface of the library.
71		-
72		- procedure Data_In
73		- (Item : out Stream_Element_Array;
74		- Last : out Stream_Element_Offset);
75		- -- this procedure is for generic instantiation of
76		- -- ZLib.Generic_Translate.
77		- -- reading data from the File_In.
78		-
79		- procedure Data_Out (Item : in Stream_Element_Array);
80		- -- this procedure is for generic instantiation of
81		- -- ZLib.Generic_Translate.
82		- -- writing data to the File_Out.
83		-
84		- procedure Stamp;
85		- -- Store the timestamp to the local variable.
86		-
87		- procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
88		- -- Print the time statistic with the message.
89		-
90		- procedure Translate is new ZLib.Generic_Translate
91		- (Data_In => Data_In,
92		- Data_Out => Data_Out);
93		- -- This procedure is moving data from File_In to File_Out
94		- -- with compression or decompression, depend on initialization of
95		- -- Filter parameter.
96		-
97		- -------------------
98		- -- Compare_Files --
99		- -------------------
100		-
101		- procedure Compare_Files (Left, Right : String) is
102		- Left_File, Right_File : File_Type;
103		- begin
104		- Open (Left_File, In_File, Left);
105		- Open (Right_File, In_File, Right);
106		- Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
107		- Close (Left_File);
108		- Close (Right_File);
109		- end Compare_Files;
110		-
111		- ---------------------
112		- -- Compare_Streams --
113		- ---------------------
114		-
115		- procedure Compare_Streams
116		- (Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
117		- is
118		- Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
119		- Left_Last, Right_Last : Stream_Element_Offset;
120		- begin
121		- loop
122		- Read (Left, Left_Buffer, Left_Last);
123		- Read (Right, Right_Buffer, Right_Last);
124		-
125		- if Left_Last /= Right_Last then
126		- Ada.Text_IO.Put_Line ("Compare error :"
127		- & Stream_Element_Offset'Image (Left_Last)
128		- & " /= "
129		- & Stream_Element_Offset'Image (Right_Last));
130		-
131		- raise Constraint_Error;
132		-
133		- elsif Left_Buffer (0 .. Left_Last)
134		- /= Right_Buffer (0 .. Right_Last)
135		- then
136		- Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
137		- raise Constraint_Error;
138		-
139		- end if;
140		-
141		- exit when Left_Last < Left_Buffer'Last;
142		- end loop;
143		- end Compare_Streams;
144		-
145		- ------------------
146		- -- Copy_Streams --
147		- ------------------
148		-
149		- procedure Copy_Streams
150		- (Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
151		- Buffer_Size : in Stream_Element_Offset := 1024)
152		- is
153		- Buffer : Stream_Element_Array (1 .. Buffer_Size);
154		- Last : Stream_Element_Offset;
155		- begin
156		- loop
157		- Read (Source, Buffer, Last);
158		- Write (Target, Buffer (1 .. Last));
159		-
160		- exit when Last < Buffer'Last;
161		- end loop;
162		- end Copy_Streams;
163		-
164		- -------------
165		- -- Data_In --
166		- -------------
167		-
168		- procedure Data_In
169		- (Item : out Stream_Element_Array;
170		- Last : out Stream_Element_Offset) is
171		- begin
172		- Read (File_In, Item, Last);
173		- end Data_In;
174		-
175		- --------------
176		- -- Data_Out --
177		- --------------
178		-
179		- procedure Data_Out (Item : in Stream_Element_Array) is
180		- begin
181		- Write (File_Out, Item);
182		- end Data_Out;
183		-
184		- -------------------
185		- -- Generate_File --
186		- -------------------
187		-
188		- procedure Generate_File is
189		- subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
190		-
191		- package Random_Elements is
192		- new Ada.Numerics.Discrete_Random (Visible_Symbols);
193		-
194		- Gen : Random_Elements.Generator;
195		- Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
196		-
197		- Buffer_Count : constant Count := File_Size / Buffer'Length;
198		- -- Number of same buffers in the packet.
199		-
200		- Density : constant Count := 30; -- from 0 to Buffer'Length - 2;
201		-
202		- procedure Fill_Buffer (J, D : in Count);
203		- -- Change the part of the buffer.
204		-
205		- -----------------
206		- -- Fill_Buffer --
207		- -----------------
208		-
209		- procedure Fill_Buffer (J, D : in Count) is
210		- begin
211		- for K in 0 .. D loop
212		- Buffer
213		- (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
214		- := Random_Elements.Random (Gen);
215		-
216		- end loop;
217		- end Fill_Buffer;
218		-
219		- begin
220		- Random_Elements.Reset (Gen, Init_Random);
221		-
222		- Create (File_In, Out_File, In_File_Name);
223		-
224		- Fill_Buffer (1, Buffer'Length - 2);
225		-
226		- for J in 1 .. Buffer_Count loop
227		- Write (File_In, Buffer);
228		-
229		- Fill_Buffer (J, Density);
230		- end loop;
231		-
232		- -- fill remain size.
233		-
234		- Write
235		- (File_In,
236		- Buffer
237		- (1 .. Stream_Element_Offset
238		- (File_Size - Buffer'Length * Buffer_Count)));
239		-
240		- Flush (File_In);
241		- Close (File_In);
242		- end Generate_File;
243		-
244		- ---------------------
245		- -- Print_Statistic --
246		- ---------------------
247		-
248		- procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
249		- use Ada.Calendar;
250		- use Ada.Text_IO;
251		-
252		- package Count_IO is new Integer_IO (ZLib.Count);
253		-
254		- Curr_Dur : Duration := Clock - Time_Stamp;
255		- begin
256		- Put (Msg);
257		-
258		- Set_Col (20);
259		- Ada.Text_IO.Put ("size =");
260		-
261		- Count_IO.Put
262		- (Data_Size,
263		- Width => Stream_IO.Count'Image (File_Size)'Length);
264		-
265		- Put_Line (" duration =" & Duration'Image (Curr_Dur));
266		- end Print_Statistic;
267		-
268		- -----------
269		- -- Stamp --
270		- -----------
271		-
272		- procedure Stamp is
273		- begin
274		- Time_Stamp := Ada.Calendar.Clock;
275		- end Stamp;
276		-
277		-begin
278		- Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
279		-
280		- loop
281		- Generate_File;
282		-
283		- for Level in ZLib.Compression_Level'Range loop
284		-
285		- Ada.Text_IO.Put_Line ("Level ="
286		- & ZLib.Compression_Level'Image (Level));
287		-
288		- -- Test generic interface.
289		- Open (File_In, In_File, In_File_Name);
290		- Create (File_Out, Out_File, Z_File_Name);
291		-
292		- Stamp;
293		-
294		- -- Deflate using generic instantiation.
295		-
296		- ZLib.Deflate_Init
297		- (Filter => Filter,
298		- Level => Level,
299		- Strategy => Strategy,
300		- Header => Header);
301		-
302		- Translate (Filter);
303		- Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
304		- ZLib.Close (Filter);
305		-
306		- Close (File_In);
307		- Close (File_Out);
308		-
309		- Open (File_In, In_File, Z_File_Name);
310		- Create (File_Out, Out_File, Out_File_Name);
311		-
312		- Stamp;
313		-
314		- -- Inflate using generic instantiation.
315		-
316		- ZLib.Inflate_Init (Filter, Header => Header);
317		-
318		- Translate (Filter);
319		- Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
320		-
321		- ZLib.Close (Filter);
322		-
323		- Close (File_In);
324		- Close (File_Out);
325		-
326		- Compare_Files (In_File_Name, Out_File_Name);
327		-
328		- -- Test stream interface.
329		-
330		- -- Compress to the back stream.
331		-
332		- Open (File_In, In_File, In_File_Name);
333		- Create (File_Back, Out_File, Z_File_Name);
334		-
335		- Stamp;
336		-
337		- ZLib.Streams.Create
338		- (Stream => File_Z,
339		- Mode => ZLib.Streams.Out_Stream,
340		- Back => ZLib.Streams.Stream_Access
341		- (Stream (File_Back)),
342		- Back_Compressed => True,
343		- Level => Level,
344		- Strategy => Strategy,
345		- Header => Header);
346		-
347		- Copy_Streams
348		- (Source => Stream (File_In).all,
349		- Target => File_Z);
350		-
351		- -- Flushing internal buffers to the back stream.
352		-
353		- ZLib.Streams.Flush (File_Z, ZLib.Finish);
354		-
355		- Print_Statistic ("Write compress",
356		- ZLib.Streams.Write_Total_Out (File_Z));
357		-
358		- ZLib.Streams.Close (File_Z);
359		-
360		- Close (File_In);
361		- Close (File_Back);
362		-
363		- -- Compare reading from original file and from
364		- -- decompression stream.
365		-
366		- Open (File_In, In_File, In_File_Name);
367		- Open (File_Back, In_File, Z_File_Name);
368		-
369		- ZLib.Streams.Create
370		- (Stream => File_Z,
371		- Mode => ZLib.Streams.In_Stream,
372		- Back => ZLib.Streams.Stream_Access
373		- (Stream (File_Back)),
374		- Back_Compressed => True,
375		- Header => Header);
376		-
377		- Stamp;
378		- Compare_Streams (Stream (File_In).all, File_Z);
379		-
380		- Print_Statistic ("Read decompress",
381		- ZLib.Streams.Read_Total_Out (File_Z));
382		-
383		- ZLib.Streams.Close (File_Z);
384		- Close (File_In);
385		- Close (File_Back);
386		-
387		- -- Compress by reading from compression stream.
388		-
389		- Open (File_Back, In_File, In_File_Name);
390		- Create (File_Out, Out_File, Z_File_Name);
391		-
392		- ZLib.Streams.Create
393		- (Stream => File_Z,
394		- Mode => ZLib.Streams.In_Stream,
395		- Back => ZLib.Streams.Stream_Access
396		- (Stream (File_Back)),
397		- Back_Compressed => False,
398		- Level => Level,
399		- Strategy => Strategy,
400		- Header => Header);
401		-
402		- Stamp;
403		- Copy_Streams
404		- (Source => File_Z,
405		- Target => Stream (File_Out).all);
406		-
407		- Print_Statistic ("Read compress",
408		- ZLib.Streams.Read_Total_Out (File_Z));
409		-
410		- ZLib.Streams.Close (File_Z);
411		-
412		- Close (File_Out);
413		- Close (File_Back);
414		-
415		- -- Decompress to decompression stream.
416		-
417		- Open (File_In, In_File, Z_File_Name);
418		- Create (File_Back, Out_File, Out_File_Name);
419		-
420		- ZLib.Streams.Create
421		- (Stream => File_Z,
422		- Mode => ZLib.Streams.Out_Stream,
423		- Back => ZLib.Streams.Stream_Access
424		- (Stream (File_Back)),
425		- Back_Compressed => False,
426		- Header => Header);
427		-
428		- Stamp;
429		-
430		- Copy_Streams
431		- (Source => Stream (File_In).all,
432		- Target => File_Z);
433		-
434		- Print_Statistic ("Write decompress",
435		- ZLib.Streams.Write_Total_Out (File_Z));
436		-
437		- ZLib.Streams.Close (File_Z);
438		- Close (File_In);
439		- Close (File_Back);
440		-
441		- Compare_Files (In_File_Name, Out_File_Name);
442		- end loop;
443		-
444		- Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
445		-
446		- exit when not Continuous;
447		-
448		- File_Size := File_Size + 1;
449		- end loop;
450		-end Test;

	--- a/compat/zlib/contrib/ada/test.adb
	+++ b/compat/zlib/contrib/ada/test.adb
	@@ -1,463 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $
2
	--- 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.
3
4	with ZLib.Streams;
5	with Ada.Streams.Stream_IO;
6	with Ada.Numerics.Discrete_Random;
7
8	with Ada.Text_IO;
9
10	with Ada.Calendar;
11
12	procedure Test is
13
14	use Ada.Streams;
15	use Stream_IO;
16
17	------------------------------------
18	-- Test configuration parameters --
19	------------------------------------
20
21	File_Size : Count := 100_000;
22	Continuous : constant Boolean := False;
23
24	Header : constant ZLib.Header_Type := ZLib.Default;
25	-- ZLib.None;
26	-- ZLib.Auto;
27	-- ZLib.GZip;
28	-- Do not use Header other then Default in ZLib versions 1.1.4
29	-- and older.
30
31	Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
32	Init_Random : constant := 10;
33
34	-- End --
35
36	In_File_Name : constant String := "testzlib.in";
37	-- Name of the input file
38
39	Z_File_Name : constant String := "testzlib.zlb";
40	-- Name of the compressed file.
41
42	Out_File_Name : constant String := "testzlib.out";
43	-- Name of the decompressed file.
44
45	File_In : File_Type;
46	File_Out : File_Type;
47	File_Back : File_Type;
48	File_Z : ZLib.Streams.Stream_Type;
49
50	Filter : ZLib.Filter_Type;
51
52	Time_Stamp : Ada.Calendar.Time;
53
54	procedure Generate_File;
55	-- Generate file of spetsified size with some random data.
56	-- The random data is repeatable, for the good compression.
57
58	procedure Compare_Streams
59	(Left, Right : in out Root_Stream_Type'Class);
60	-- The procedure compearing data in 2 streams.
61	-- It is for compare data before and after compression/decompression.
62
63	procedure Compare_Files (Left, Right : String);
64	-- Compare files. Based on the Compare_Streams.
65
66	procedure Copy_Streams
67	(Source, Target : in out Root_Stream_Type'Class;
68	Buffer_Size : in Stream_Element_Offset := 1024);
69	-- Copying data from one stream to another. It is for test stream
70	-- interface of the library.
71
72	procedure Data_In
73	(Item : out Stream_Element_Array;
74	Last : out Stream_Element_Offset);
75	-- this procedure is for generic instantiation of
76	-- ZLib.Generic_Translate.
77	-- reading data from the File_In.
78
79	procedure Data_Out (Item : in Stream_Element_Array);
80	-- this procedure is for generic instantiation of
81	-- ZLib.Generic_Translate.
82	-- writing data to the File_Out.
83
84	procedure Stamp;
85	-- Store the timestamp to the local variable.
86
87	procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
88	-- Print the time statistic with the message.
89
90	procedure Translate is new ZLib.Generic_Translate
91	(Data_In => Data_In,
92	Data_Out => Data_Out);
93	-- This procedure is moving data from File_In to File_Out
94	-- with compression or decompression, depend on initialization of
95	-- Filter parameter.
96
97	-------------------
98	-- Compare_Files --
99	-------------------
100
101	procedure Compare_Files (Left, Right : String) is
102	Left_File, Right_File : File_Type;
103	begin
104	Open (Left_File, In_File, Left);
105	Open (Right_File, In_File, Right);
106	Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
107	Close (Left_File);
108	Close (Right_File);
109	end Compare_Files;
110
111	---------------------
112	-- Compare_Streams --
113	---------------------
114
115	procedure Compare_Streams
116	(Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
117	is
118	Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
119	Left_Last, Right_Last : Stream_Element_Offset;
120	begin
121	loop
122	Read (Left, Left_Buffer, Left_Last);
123	Read (Right, Right_Buffer, Right_Last);
124
125	if Left_Last /= Right_Last then
126	Ada.Text_IO.Put_Line ("Compare error :"
127	& Stream_Element_Offset'Image (Left_Last)
128	& " /= "
129	& Stream_Element_Offset'Image (Right_Last));
130
131	raise Constraint_Error;
132
133	elsif Left_Buffer (0 .. Left_Last)
134	/= Right_Buffer (0 .. Right_Last)
135	then
136	Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
137	raise Constraint_Error;
138
139	end if;
140
141	exit when Left_Last < Left_Buffer'Last;
142	end loop;
143	end Compare_Streams;
144
145	------------------
146	-- Copy_Streams --
147	------------------
148
149	procedure Copy_Streams
150	(Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
151	Buffer_Size : in Stream_Element_Offset := 1024)
152	is
153	Buffer : Stream_Element_Array (1 .. Buffer_Size);
154	Last : Stream_Element_Offset;
155	begin
156	loop
157	Read (Source, Buffer, Last);
158	Write (Target, Buffer (1 .. Last));
159
160	exit when Last < Buffer'Last;
161	end loop;
162	end Copy_Streams;
163
164	-------------
165	-- Data_In --
166	-------------
167
168	procedure Data_In
169	(Item : out Stream_Element_Array;
170	Last : out Stream_Element_Offset) is
171	begin
172	Read (File_In, Item, Last);
173	end Data_In;
174
175	--------------
176	-- Data_Out --
177	--------------
178
179	procedure Data_Out (Item : in Stream_Element_Array) is
180	begin
181	Write (File_Out, Item);
182	end Data_Out;
183
184	-------------------
185	-- Generate_File --
186	-------------------
187
188	procedure Generate_File is
189	subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
190
191	package Random_Elements is
192	new Ada.Numerics.Discrete_Random (Visible_Symbols);
193
194	Gen : Random_Elements.Generator;
195	Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
196
197	Buffer_Count : constant Count := File_Size / Buffer'Length;
198	-- Number of same buffers in the packet.
199
200	Density : constant Count := 30; -- from 0 to Buffer'Length - 2;
201
202	procedure Fill_Buffer (J, D : in Count);
203	-- Change the part of the buffer.
204
205	-----------------
206	-- Fill_Buffer --
207	-----------------
208
209	procedure Fill_Buffer (J, D : in Count) is
210	begin
211	for K in 0 .. D loop
212	Buffer
213	(Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
214	:= Random_Elements.Random (Gen);
215
216	end loop;
217	end Fill_Buffer;
218
219	begin
220	Random_Elements.Reset (Gen, Init_Random);
221
222	Create (File_In, Out_File, In_File_Name);
223
224	Fill_Buffer (1, Buffer'Length - 2);
225
226	for J in 1 .. Buffer_Count loop
227	Write (File_In, Buffer);
228
229	Fill_Buffer (J, Density);
230	end loop;
231
232	-- fill remain size.
233
234	Write
235	(File_In,
236	Buffer
237	(1 .. Stream_Element_Offset
238	(File_Size - Buffer'Length * Buffer_Count)));
239
240	Flush (File_In);
241	Close (File_In);
242	end Generate_File;
243
244	---------------------
245	-- Print_Statistic --
246	---------------------
247
248	procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
249	use Ada.Calendar;
250	use Ada.Text_IO;
251
252	package Count_IO is new Integer_IO (ZLib.Count);
253
254	Curr_Dur : Duration := Clock - Time_Stamp;
255	begin
256	Put (Msg);
257
258	Set_Col (20);
259	Ada.Text_IO.Put ("size =");
260
261	Count_IO.Put
262	(Data_Size,
263	Width => Stream_IO.Count'Image (File_Size)'Length);
264
265	Put_Line (" duration =" & Duration'Image (Curr_Dur));
266	end Print_Statistic;
267
268	-----------
269	-- Stamp --
270	-----------
271
272	procedure Stamp is
273	begin
274	Time_Stamp := Ada.Calendar.Clock;
275	end Stamp;
276
277	begin
278	Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
279
280	loop
281	Generate_File;
282
283	for Level in ZLib.Compression_Level'Range loop
284
285	Ada.Text_IO.Put_Line ("Level ="
286	& ZLib.Compression_Level'Image (Level));
287
288	-- Test generic interface.
289	Open (File_In, In_File, In_File_Name);
290	Create (File_Out, Out_File, Z_File_Name);
291
292	Stamp;
293
294	-- Deflate using generic instantiation.
295
296	ZLib.Deflate_Init
297	(Filter => Filter,
298	Level => Level,
299	Strategy => Strategy,
300	Header => Header);
301
302	Translate (Filter);
303	Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
304	ZLib.Close (Filter);
305
306	Close (File_In);
307	Close (File_Out);
308
309	Open (File_In, In_File, Z_File_Name);
310	Create (File_Out, Out_File, Out_File_Name);
311
312	Stamp;
313
314	-- Inflate using generic instantiation.
315
316	ZLib.Inflate_Init (Filter, Header => Header);
317
318	Translate (Filter);
319	Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
320
321	ZLib.Close (Filter);
322
323	Close (File_In);
324	Close (File_Out);
325
326	Compare_Files (In_File_Name, Out_File_Name);
327
328	-- Test stream interface.
329
330	-- Compress to the back stream.
331
332	Open (File_In, In_File, In_File_Name);
333	Create (File_Back, Out_File, Z_File_Name);
334
335	Stamp;
336
337	ZLib.Streams.Create
338	(Stream => File_Z,
339	Mode => ZLib.Streams.Out_Stream,
340	Back => ZLib.Streams.Stream_Access
341	(Stream (File_Back)),
342	Back_Compressed => True,
343	Level => Level,
344	Strategy => Strategy,
345	Header => Header);
346
347	Copy_Streams
348	(Source => Stream (File_In).all,
349	Target => File_Z);
350
351	-- Flushing internal buffers to the back stream.
352
353	ZLib.Streams.Flush (File_Z, ZLib.Finish);
354
355	Print_Statistic ("Write compress",
356	ZLib.Streams.Write_Total_Out (File_Z));
357
358	ZLib.Streams.Close (File_Z);
359
360	Close (File_In);
361	Close (File_Back);
362
363	-- Compare reading from original file and from
364	-- decompression stream.
365
366	Open (File_In, In_File, In_File_Name);
367	Open (File_Back, In_File, Z_File_Name);
368
369	ZLib.Streams.Create
370	(Stream => File_Z,
371	Mode => ZLib.Streams.In_Stream,
372	Back => ZLib.Streams.Stream_Access
373	(Stream (File_Back)),
374	Back_Compressed => True,
375	Header => Header);
376
377	Stamp;
378	Compare_Streams (Stream (File_In).all, File_Z);
379
380	Print_Statistic ("Read decompress",
381	ZLib.Streams.Read_Total_Out (File_Z));
382
383	ZLib.Streams.Close (File_Z);
384	Close (File_In);
385	Close (File_Back);
386
387	-- Compress by reading from compression stream.
388
389	Open (File_Back, In_File, In_File_Name);
390	Create (File_Out, Out_File, Z_File_Name);
391
392	ZLib.Streams.Create
393	(Stream => File_Z,
394	Mode => ZLib.Streams.In_Stream,
395	Back => ZLib.Streams.Stream_Access
396	(Stream (File_Back)),
397	Back_Compressed => False,
398	Level => Level,
399	Strategy => Strategy,
400	Header => Header);
401
402	Stamp;
403	Copy_Streams
404	(Source => File_Z,
405	Target => Stream (File_Out).all);
406
407	Print_Statistic ("Read compress",
408	ZLib.Streams.Read_Total_Out (File_Z));
409
410	ZLib.Streams.Close (File_Z);
411
412	Close (File_Out);
413	Close (File_Back);
414
415	-- Decompress to decompression stream.
416
417	Open (File_In, In_File, Z_File_Name);
418	Create (File_Back, Out_File, Out_File_Name);
419
420	ZLib.Streams.Create
421	(Stream => File_Z,
422	Mode => ZLib.Streams.Out_Stream,
423	Back => ZLib.Streams.Stream_Access
424	(Stream (File_Back)),
425	Back_Compressed => False,
426	Header => Header);
427
428	Stamp;
429
430	Copy_Streams
431	(Source => Stream (File_In).all,
432	Target => File_Z);
433
434	Print_Statistic ("Write decompress",
435	ZLib.Streams.Write_Total_Out (File_Z));
436
437	ZLib.Streams.Close (File_Z);
438	Close (File_In);
439	Close (File_Back);
440
441	Compare_Files (In_File_Name, Out_File_Name);
442	end loop;
443
444	Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
445
446	exit when not Continuous;
447
448	File_Size := File_Size + 1;
449	end loop;
450	end Test;

	--- a/compat/zlib/contrib/ada/test.adb
	+++ b/compat/zlib/contrib/ada/test.adb
	@@ -1,463 +0,0 @@
	-----------------------------------------------------------------
	--- 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.

D compat/zlib/contrib/ada/zlib-streams.adb

-217

		--- a/compat/zlib/contrib/ada/zlib-streams.adb
		+++ b/compat/zlib/contrib/ada/zlib-streams.adb
		@@ -1,225 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
2		-
3		-with Ada.Unchecked_Deallocation;
4		-
5		-package body ZLib.Streams is
6		-
7		- -----------
8		- -- Close --
9		- -----------
10		-
11		- procedure Close (Stream : in out Stream_Type) is
12		- procedure Free is new Ada.Unchecked_Deallocation
13		- (Stream_Element_Array, Buffer_Access);
14		- begin
15		- if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
16		- -- We should flush the data written by the writer.
17		-
18		- Flush (Stream, Finish);
19		-
20		- Close (Stream.Writer);
21		- end if;
22		-
23		- if Stream.Mode = In_Stream or Stream.Mode = Duplex then
24		- Close (Stream.Reader);
25		- Free (Stream.Buffer);
26		- end if;
27		- end Close;
28		-
29		- ------------
30		- -- Create --
31		- ------------
32		-
33		- procedure Create
34		- (Stream : out Stream_Type;
35		- Mode : in Stream_Mode;
36		- Back : in Stream_Access;
37		- Back_Compressed : in Boolean;
38		- Level : in Compression_Level := Default_Compression;
39		- Strategy : in Strategy_Type := Default_Strategy;
40		- Header : in Header_Type := Default;
41		- Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
42		- := Default_Buffer_Size;
43		- Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
44		- := Default_Buffer_Size)
45		- is
46		-
47		- subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
48		-
49		- procedure Init_Filter
50		- (Filter : in out Filter_Type;
51		- Compress : in Boolean);
52		-
53		- -----------------
54		- -- Init_Filter --
55		- -----------------
56		-
57		- procedure Init_Filter
58		- (Filter : in out Filter_Type;
59		- Compress : in Boolean) is
60		- begin
61		- if Compress then
62		- Deflate_Init
63		- (Filter, Level, Strategy, Header => Header);
64		- else
65		- Inflate_Init (Filter, Header => Header);
66		- end if;
67		- end Init_Filter;
68		-
69		- begin
70		- Stream.Back := Back;
71		- Stream.Mode := Mode;
72		-
73		- if Mode = Out_Stream or Mode = Duplex then
74		- Init_Filter (Stream.Writer, Back_Compressed);
75		- Stream.Buffer_Size := Write_Buffer_Size;
76		- else
77		- Stream.Buffer_Size := 0;
78		- end if;
79		-
80		- if Mode = In_Stream or Mode = Duplex then
81		- Init_Filter (Stream.Reader, not Back_Compressed);
82		-
83		- Stream.Buffer := new Buffer_Subtype;
84		- Stream.Rest_First := Stream.Buffer'Last + 1;
85		- Stream.Rest_Last := Stream.Buffer'Last;
86		- end if;
87		- end Create;
88		-
89		- -----------
90		- -- Flush --
91		- -----------
92		-
93		- procedure Flush
94		- (Stream : in out Stream_Type;
95		- Mode : in Flush_Mode := Sync_Flush)
96		- is
97		- Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
98		- Last : Stream_Element_Offset;
99		- begin
100		- loop
101		- Flush (Stream.Writer, Buffer, Last, Mode);
102		-
103		- Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
104		-
105		- exit when Last < Buffer'Last;
106		- end loop;
107		- end Flush;
108		-
109		- -------------
110		- -- Is_Open --
111		- -------------
112		-
113		- function Is_Open (Stream : Stream_Type) return Boolean is
114		- begin
115		- return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
116		- end Is_Open;
117		-
118		- ----------
119		- -- Read --
120		- ----------
121		-
122		- procedure Read
123		- (Stream : in out Stream_Type;
124		- Item : out Stream_Element_Array;
125		- Last : out Stream_Element_Offset)
126		- is
127		-
128		- procedure Read
129		- (Item : out Stream_Element_Array;
130		- Last : out Stream_Element_Offset);
131		-
132		- ----------
133		- -- Read --
134		- ----------
135		-
136		- procedure Read
137		- (Item : out Stream_Element_Array;
138		- Last : out Stream_Element_Offset) is
139		- begin
140		- Ada.Streams.Read (Stream.Back.all, Item, Last);
141		- end Read;
142		-
143		- procedure Read is new ZLib.Read
144		- (Read => Read,
145		- Buffer => Stream.Buffer.all,
146		- Rest_First => Stream.Rest_First,
147		- Rest_Last => Stream.Rest_Last);
148		-
149		- begin
150		- Read (Stream.Reader, Item, Last);
151		- end Read;
152		-
153		- -------------------
154		- -- Read_Total_In --
155		- -------------------
156		-
157		- function Read_Total_In (Stream : in Stream_Type) return Count is
158		- begin
159		- return Total_In (Stream.Reader);
160		- end Read_Total_In;
161		-
162		- --------------------
163		- -- Read_Total_Out --
164		- --------------------
165		-
166		- function Read_Total_Out (Stream : in Stream_Type) return Count is
167		- begin
168		- return Total_Out (Stream.Reader);
169		- end Read_Total_Out;
170		-
171		- -----------
172		- -- Write --
173		- -----------
174		-
175		- procedure Write
176		- (Stream : in out Stream_Type;
177		- Item : in Stream_Element_Array)
178		- is
179		-
180		- procedure Write (Item : in Stream_Element_Array);
181		-
182		- -----------
183		- -- Write --
184		- -----------
185		-
186		- procedure Write (Item : in Stream_Element_Array) is
187		- begin
188		- Ada.Streams.Write (Stream.Back.all, Item);
189		- end Write;
190		-
191		- procedure Write is new ZLib.Write
192		- (Write => Write,
193		- Buffer_Size => Stream.Buffer_Size);
194		-
195		- begin
196		- Write (Stream.Writer, Item, No_Flush);
197		- end Write;
198		-
199		- --------------------
200		- -- Write_Total_In --
201		- --------------------
202		-
203		- function Write_Total_In (Stream : in Stream_Type) return Count is
204		- begin
205		- return Total_In (Stream.Writer);
206		- end Write_Total_In;
207		-
208		- ---------------------
209		- -- Write_Total_Out --
210		- ---------------------
211		-
212		- function Write_Total_Out (Stream : in Stream_Type) return Count is
213		- begin
214		- return Total_Out (Stream.Writer);
215		- end Write_Total_Out;
216		-
217		-end ZLib.Streams;

	--- a/compat/zlib/contrib/ada/zlib-streams.adb
	+++ b/compat/zlib/contrib/ada/zlib-streams.adb
	@@ -1,225 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
2
3	with Ada.Unchecked_Deallocation;
4
5	package body ZLib.Streams is
6
7	-----------
8	-- Close --
9	-----------
10
11	procedure Close (Stream : in out Stream_Type) is
12	procedure Free is new Ada.Unchecked_Deallocation
13	(Stream_Element_Array, Buffer_Access);
14	begin
15	if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
16	-- We should flush the data written by the writer.
17
18	Flush (Stream, Finish);
19
20	Close (Stream.Writer);
21	end if;
22
23	if Stream.Mode = In_Stream or Stream.Mode = Duplex then
24	Close (Stream.Reader);
25	Free (Stream.Buffer);
26	end if;
27	end Close;
28
29	------------
30	-- Create --
31	------------
32
33	procedure Create
34	(Stream : out Stream_Type;
35	Mode : in Stream_Mode;
36	Back : in Stream_Access;
37	Back_Compressed : in Boolean;
38	Level : in Compression_Level := Default_Compression;
39	Strategy : in Strategy_Type := Default_Strategy;
40	Header : in Header_Type := Default;
41	Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
42	:= Default_Buffer_Size;
43	Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
44	:= Default_Buffer_Size)
45	is
46
47	subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
48
49	procedure Init_Filter
50	(Filter : in out Filter_Type;
51	Compress : in Boolean);
52
53	-----------------
54	-- Init_Filter --
55	-----------------
56
57	procedure Init_Filter
58	(Filter : in out Filter_Type;
59	Compress : in Boolean) is
60	begin
61	if Compress then
62	Deflate_Init
63	(Filter, Level, Strategy, Header => Header);
64	else
65	Inflate_Init (Filter, Header => Header);
66	end if;
67	end Init_Filter;
68
69	begin
70	Stream.Back := Back;
71	Stream.Mode := Mode;
72
73	if Mode = Out_Stream or Mode = Duplex then
74	Init_Filter (Stream.Writer, Back_Compressed);
75	Stream.Buffer_Size := Write_Buffer_Size;
76	else
77	Stream.Buffer_Size := 0;
78	end if;
79
80	if Mode = In_Stream or Mode = Duplex then
81	Init_Filter (Stream.Reader, not Back_Compressed);
82
83	Stream.Buffer := new Buffer_Subtype;
84	Stream.Rest_First := Stream.Buffer'Last + 1;
85	Stream.Rest_Last := Stream.Buffer'Last;
86	end if;
87	end Create;
88
89	-----------
90	-- Flush --
91	-----------
92
93	procedure Flush
94	(Stream : in out Stream_Type;
95	Mode : in Flush_Mode := Sync_Flush)
96	is
97	Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
98	Last : Stream_Element_Offset;
99	begin
100	loop
101	Flush (Stream.Writer, Buffer, Last, Mode);
102
103	Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
104
105	exit when Last < Buffer'Last;
106	end loop;
107	end Flush;
108
109	-------------
110	-- Is_Open --
111	-------------
112
113	function Is_Open (Stream : Stream_Type) return Boolean is
114	begin
115	return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
116	end Is_Open;
117
118	----------
119	-- Read --
120	----------
121
122	procedure Read
123	(Stream : in out Stream_Type;
124	Item : out Stream_Element_Array;
125	Last : out Stream_Element_Offset)
126	is
127
128	procedure Read
129	(Item : out Stream_Element_Array;
130	Last : out Stream_Element_Offset);
131
132	----------
133	-- Read --
134	----------
135
136	procedure Read
137	(Item : out Stream_Element_Array;
138	Last : out Stream_Element_Offset) is
139	begin
140	Ada.Streams.Read (Stream.Back.all, Item, Last);
141	end Read;
142
143	procedure Read is new ZLib.Read
144	(Read => Read,
145	Buffer => Stream.Buffer.all,
146	Rest_First => Stream.Rest_First,
147	Rest_Last => Stream.Rest_Last);
148
149	begin
150	Read (Stream.Reader, Item, Last);
151	end Read;
152
153	-------------------
154	-- Read_Total_In --
155	-------------------
156
157	function Read_Total_In (Stream : in Stream_Type) return Count is
158	begin
159	return Total_In (Stream.Reader);
160	end Read_Total_In;
161
162	--------------------
163	-- Read_Total_Out --
164	--------------------
165
166	function Read_Total_Out (Stream : in Stream_Type) return Count is
167	begin
168	return Total_Out (Stream.Reader);
169	end Read_Total_Out;
170
171	-----------
172	-- Write --
173	-----------
174
175	procedure Write
176	(Stream : in out Stream_Type;
177	Item : in Stream_Element_Array)
178	is
179
180	procedure Write (Item : in Stream_Element_Array);
181
182	-----------
183	-- Write --
184	-----------
185
186	procedure Write (Item : in Stream_Element_Array) is
187	begin
188	Ada.Streams.Write (Stream.Back.all, Item);
189	end Write;
190
191	procedure Write is new ZLib.Write
192	(Write => Write,
193	Buffer_Size => Stream.Buffer_Size);
194
195	begin
196	Write (Stream.Writer, Item, No_Flush);
197	end Write;
198
199	--------------------
200	-- Write_Total_In --
201	--------------------
202
203	function Write_Total_In (Stream : in Stream_Type) return Count is
204	begin
205	return Total_In (Stream.Writer);
206	end Write_Total_In;
207
208	---------------------
209	-- Write_Total_Out --
210	---------------------
211
212	function Write_Total_Out (Stream : in Stream_Type) return Count is
213	begin
214	return Total_Out (Stream.Writer);
215	end Write_Total_Out;
216
217	end ZLib.Streams;

	--- a/compat/zlib/contrib/ada/zlib-streams.adb
	+++ b/compat/zlib/contrib/ada/zlib-streams.adb
	@@ -1,225 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/zlib-streams.ads

-106

		--- a/compat/zlib/contrib/ada/zlib-streams.ads
		+++ b/compat/zlib/contrib/ada/zlib-streams.ads
		@@ -1,114 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
2		-
3		-package ZLib.Streams is
4		-
5		- type Stream_Mode is (In_Stream, Out_Stream, Duplex);
6		-
7		- type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
8		-
9		- type Stream_Type is
10		- new Ada.Streams.Root_Stream_Type with private;
11		-
12		- procedure Read
13		- (Stream : in out Stream_Type;
14		- Item : out Ada.Streams.Stream_Element_Array;
15		- Last : out Ada.Streams.Stream_Element_Offset);
16		-
17		- procedure Write
18		- (Stream : in out Stream_Type;
19		- Item : in Ada.Streams.Stream_Element_Array);
20		-
21		- procedure Flush
22		- (Stream : in out Stream_Type;
23		- Mode : in Flush_Mode := Sync_Flush);
24		- -- Flush the written data to the back stream,
25		- -- all data placed to the compressor is flushing to the Back stream.
26		- -- Should not be used until necessary, because it is decreasing
27		- -- compression.
28		-
29		- function Read_Total_In (Stream : in Stream_Type) return Count;
30		- pragma Inline (Read_Total_In);
31		- -- Return total number of bytes read from back stream so far.
32		-
33		- function Read_Total_Out (Stream : in Stream_Type) return Count;
34		- pragma Inline (Read_Total_Out);
35		- -- Return total number of bytes read so far.
36		-
37		- function Write_Total_In (Stream : in Stream_Type) return Count;
38		- pragma Inline (Write_Total_In);
39		- -- Return total number of bytes written so far.
40		-
41		- function Write_Total_Out (Stream : in Stream_Type) return Count;
42		- pragma Inline (Write_Total_Out);
43		- -- Return total number of bytes written to the back stream.
44		-
45		- procedure Create
46		- (Stream : out Stream_Type;
47		- Mode : in Stream_Mode;
48		- Back : in Stream_Access;
49		- Back_Compressed : in Boolean;
50		- Level : in Compression_Level := Default_Compression;
51		- Strategy : in Strategy_Type := Default_Strategy;
52		- Header : in Header_Type := Default;
53		- Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
54		- := Default_Buffer_Size;
55		- Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
56		- := Default_Buffer_Size);
57		- -- Create the Comression/Decompression stream.
58		- -- If mode is In_Stream then Write operation is disabled.
59		- -- If mode is Out_Stream then Read operation is disabled.
60		-
61		- -- If Back_Compressed is true then
62		- -- Data written to the Stream is compressing to the Back stream
63		- -- and data read from the Stream is decompressed data from the Back stream.
64		-
65		- -- If Back_Compressed is false then
66		- -- Data written to the Stream is decompressing to the Back stream
67		- -- and data read from the Stream is compressed data from the Back stream.
68		-
69		- -- !!! When the Need_Header is False ZLib-Ada is using undocumented
70		- -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers.
71		-
72		- function Is_Open (Stream : Stream_Type) return Boolean;
73		-
74		- procedure Close (Stream : in out Stream_Type);
75		-
76		-private
77		-
78		- use Ada.Streams;
79		-
80		- type Buffer_Access is access all Stream_Element_Array;
81		-
82		- type Stream_Type
83		- is new Root_Stream_Type with
84		- record
85		- Mode : Stream_Mode;
86		-
87		- Buffer : Buffer_Access;
88		- Rest_First : Stream_Element_Offset;
89		- Rest_Last : Stream_Element_Offset;
90		- -- Buffer for Read operation.
91		- -- We need to have this buffer in the record
92		- -- because not all read data from back stream
93		- -- could be processed during the read operation.
94		-
95		- Buffer_Size : Stream_Element_Offset;
96		- -- Buffer size for write operation.
97		- -- We do not need to have this buffer
98		- -- in the record because all data could be
99		- -- processed in the write operation.
100		-
101		- Back : Stream_Access;
102		- Reader : Filter_Type;
103		- Writer : Filter_Type;
104		- end record;
105		-
106		-end ZLib.Streams;

	--- a/compat/zlib/contrib/ada/zlib-streams.ads
	+++ b/compat/zlib/contrib/ada/zlib-streams.ads
	@@ -1,114 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
2
3	package ZLib.Streams is
4
5	type Stream_Mode is (In_Stream, Out_Stream, Duplex);
6
7	type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
8
9	type Stream_Type is
10	new Ada.Streams.Root_Stream_Type with private;
11
12	procedure Read
13	(Stream : in out Stream_Type;
14	Item : out Ada.Streams.Stream_Element_Array;
15	Last : out Ada.Streams.Stream_Element_Offset);
16
17	procedure Write
18	(Stream : in out Stream_Type;
19	Item : in Ada.Streams.Stream_Element_Array);
20
21	procedure Flush
22	(Stream : in out Stream_Type;
23	Mode : in Flush_Mode := Sync_Flush);
24	-- Flush the written data to the back stream,
25	-- all data placed to the compressor is flushing to the Back stream.
26	-- Should not be used until necessary, because it is decreasing
27	-- compression.
28
29	function Read_Total_In (Stream : in Stream_Type) return Count;
30	pragma Inline (Read_Total_In);
31	-- Return total number of bytes read from back stream so far.
32
33	function Read_Total_Out (Stream : in Stream_Type) return Count;
34	pragma Inline (Read_Total_Out);
35	-- Return total number of bytes read so far.
36
37	function Write_Total_In (Stream : in Stream_Type) return Count;
38	pragma Inline (Write_Total_In);
39	-- Return total number of bytes written so far.
40
41	function Write_Total_Out (Stream : in Stream_Type) return Count;
42	pragma Inline (Write_Total_Out);
43	-- Return total number of bytes written to the back stream.
44
45	procedure Create
46	(Stream : out Stream_Type;
47	Mode : in Stream_Mode;
48	Back : in Stream_Access;
49	Back_Compressed : in Boolean;
50	Level : in Compression_Level := Default_Compression;
51	Strategy : in Strategy_Type := Default_Strategy;
52	Header : in Header_Type := Default;
53	Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
54	:= Default_Buffer_Size;
55	Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
56	:= Default_Buffer_Size);
57	-- Create the Comression/Decompression stream.
58	-- If mode is In_Stream then Write operation is disabled.
59	-- If mode is Out_Stream then Read operation is disabled.
60
61	-- If Back_Compressed is true then
62	-- Data written to the Stream is compressing to the Back stream
63	-- and data read from the Stream is decompressed data from the Back stream.
64
65	-- If Back_Compressed is false then
66	-- Data written to the Stream is decompressing to the Back stream
67	-- and data read from the Stream is compressed data from the Back stream.
68
69	-- !!! When the Need_Header is False ZLib-Ada is using undocumented
70	-- ZLib 1.1.4 functionality to do not create/wait for ZLib headers.
71
72	function Is_Open (Stream : Stream_Type) return Boolean;
73
74	procedure Close (Stream : in out Stream_Type);
75
76	private
77
78	use Ada.Streams;
79
80	type Buffer_Access is access all Stream_Element_Array;
81
82	type Stream_Type
83	is new Root_Stream_Type with
84	record
85	Mode : Stream_Mode;
86
87	Buffer : Buffer_Access;
88	Rest_First : Stream_Element_Offset;
89	Rest_Last : Stream_Element_Offset;
90	-- Buffer for Read operation.
91	-- We need to have this buffer in the record
92	-- because not all read data from back stream
93	-- could be processed during the read operation.
94
95	Buffer_Size : Stream_Element_Offset;
96	-- Buffer size for write operation.
97	-- We do not need to have this buffer
98	-- in the record because all data could be
99	-- processed in the write operation.
100
101	Back : Stream_Access;
102	Reader : Filter_Type;
103	Writer : Filter_Type;
104	end record;
105
106	end ZLib.Streams;

	--- a/compat/zlib/contrib/ada/zlib-streams.ads
	+++ b/compat/zlib/contrib/ada/zlib-streams.ads
	@@ -1,114 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/zlib-thin.adb

-133

		--- a/compat/zlib/contrib/ada/zlib-thin.adb
		+++ b/compat/zlib/contrib/ada/zlib-thin.adb
		@@ -1,141 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
2		-
3		-package body ZLib.Thin is
4		-
5		- ZLIB_VERSION : constant Chars_Ptr := zlibVersion;
6		-
7		- Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit;
8		-
9		- --------------
10		- -- Avail_In --
11		- --------------
12		-
13		- function Avail_In (Strm : in Z_Stream) return UInt is
14		- begin
15		- return Strm.Avail_In;
16		- end Avail_In;
17		-
18		- ---------------
19		- -- Avail_Out --
20		- ---------------
21		-
22		- function Avail_Out (Strm : in Z_Stream) return UInt is
23		- begin
24		- return Strm.Avail_Out;
25		- end Avail_Out;
26		-
27		- ------------------
28		- -- Deflate_Init --
29		- ------------------
30		-
31		- function Deflate_Init
32		- (strm : Z_Streamp;
33		- level : Int;
34		- method : Int;
35		- windowBits : Int;
36		- memLevel : Int;
37		- strategy : Int)
38		- return Int is
39		- begin
40		- return deflateInit2
41		- (strm,
42		- level,
43		- method,
44		- windowBits,
45		- memLevel,
46		- strategy,
47		- ZLIB_VERSION,
48		- Z_Stream_Size);
49		- end Deflate_Init;
50		-
51		- ------------------
52		- -- Inflate_Init --
53		- ------------------
54		-
55		- function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
56		- begin
57		- return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
58		- end Inflate_Init;
59		-
60		- ------------------------
61		- -- Last_Error_Message --
62		- ------------------------
63		-
64		- function Last_Error_Message (Strm : in Z_Stream) return String is
65		- use Interfaces.C.Strings;
66		- begin
67		- if Strm.msg = Null_Ptr then
68		- return "";
69		- else
70		- return Value (Strm.msg);
71		- end if;
72		- end Last_Error_Message;
73		-
74		- ------------
75		- -- Set_In --
76		- ------------
77		-
78		- procedure Set_In
79		- (Strm : in out Z_Stream;
80		- Buffer : in Voidp;
81		- Size : in UInt) is
82		- begin
83		- Strm.Next_In := Buffer;
84		- Strm.Avail_In := Size;
85		- end Set_In;
86		-
87		- ------------------
88		- -- Set_Mem_Func --
89		- ------------------
90		-
91		- procedure Set_Mem_Func
92		- (Strm : in out Z_Stream;
93		- Opaque : in Voidp;
94		- Alloc : in alloc_func;
95		- Free : in free_func) is
96		- begin
97		- Strm.opaque := Opaque;
98		- Strm.zalloc := Alloc;
99		- Strm.zfree := Free;
100		- end Set_Mem_Func;
101		-
102		- -------------
103		- -- Set_Out --
104		- -------------
105		-
106		- procedure Set_Out
107		- (Strm : in out Z_Stream;
108		- Buffer : in Voidp;
109		- Size : in UInt) is
110		- begin
111		- Strm.Next_Out := Buffer;
112		- Strm.Avail_Out := Size;
113		- end Set_Out;
114		-
115		- --------------
116		- -- Total_In --
117		- --------------
118		-
119		- function Total_In (Strm : in Z_Stream) return ULong is
120		- begin
121		- return Strm.Total_In;
122		- end Total_In;
123		-
124		- ---------------
125		- -- Total_Out --
126		- ---------------
127		-
128		- function Total_Out (Strm : in Z_Stream) return ULong is
129		- begin
130		- return Strm.Total_Out;
131		- end Total_Out;
132		-
133		-end ZLib.Thin;

	--- a/compat/zlib/contrib/ada/zlib-thin.adb
	+++ b/compat/zlib/contrib/ada/zlib-thin.adb
	@@ -1,141 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
2
3	package body ZLib.Thin is
4
5	ZLIB_VERSION : constant Chars_Ptr := zlibVersion;
6
7	Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit;
8
9	--------------
10	-- Avail_In --
11	--------------
12
13	function Avail_In (Strm : in Z_Stream) return UInt is
14	begin
15	return Strm.Avail_In;
16	end Avail_In;
17
18	---------------
19	-- Avail_Out --
20	---------------
21
22	function Avail_Out (Strm : in Z_Stream) return UInt is
23	begin
24	return Strm.Avail_Out;
25	end Avail_Out;
26
27	------------------
28	-- Deflate_Init --
29	------------------
30
31	function Deflate_Init
32	(strm : Z_Streamp;
33	level : Int;
34	method : Int;
35	windowBits : Int;
36	memLevel : Int;
37	strategy : Int)
38	return Int is
39	begin
40	return deflateInit2
41	(strm,
42	level,
43	method,
44	windowBits,
45	memLevel,
46	strategy,
47	ZLIB_VERSION,
48	Z_Stream_Size);
49	end Deflate_Init;
50
51	------------------
52	-- Inflate_Init --
53	------------------
54
55	function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
56	begin
57	return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
58	end Inflate_Init;
59
60	------------------------
61	-- Last_Error_Message --
62	------------------------
63
64	function Last_Error_Message (Strm : in Z_Stream) return String is
65	use Interfaces.C.Strings;
66	begin
67	if Strm.msg = Null_Ptr then
68	return "";
69	else
70	return Value (Strm.msg);
71	end if;
72	end Last_Error_Message;
73
74	------------
75	-- Set_In --
76	------------
77
78	procedure Set_In
79	(Strm : in out Z_Stream;
80	Buffer : in Voidp;
81	Size : in UInt) is
82	begin
83	Strm.Next_In := Buffer;
84	Strm.Avail_In := Size;
85	end Set_In;
86
87	------------------
88	-- Set_Mem_Func --
89	------------------
90
91	procedure Set_Mem_Func
92	(Strm : in out Z_Stream;
93	Opaque : in Voidp;
94	Alloc : in alloc_func;
95	Free : in free_func) is
96	begin
97	Strm.opaque := Opaque;
98	Strm.zalloc := Alloc;
99	Strm.zfree := Free;
100	end Set_Mem_Func;
101
102	-------------
103	-- Set_Out --
104	-------------
105
106	procedure Set_Out
107	(Strm : in out Z_Stream;
108	Buffer : in Voidp;
109	Size : in UInt) is
110	begin
111	Strm.Next_Out := Buffer;
112	Strm.Avail_Out := Size;
113	end Set_Out;
114
115	--------------
116	-- Total_In --
117	--------------
118
119	function Total_In (Strm : in Z_Stream) return ULong is
120	begin
121	return Strm.Total_In;
122	end Total_In;
123
124	---------------
125	-- Total_Out --
126	---------------
127
128	function Total_Out (Strm : in Z_Stream) return ULong is
129	begin
130	return Strm.Total_Out;
131	end Total_Out;
132
133	end ZLib.Thin;

	--- a/compat/zlib/contrib/ada/zlib-thin.adb
	+++ b/compat/zlib/contrib/ada/zlib-thin.adb
	@@ -1,141 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/zlib-thin.ads

-442

		--- a/compat/zlib/contrib/ada/zlib-thin.ads
		+++ b/compat/zlib/contrib/ada/zlib-thin.ads
		@@ -1,450 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
2		-
3		-with Interfaces.C.Strings;
4		-
5		-with System;
6		-
7		-private package ZLib.Thin is
8		-
9		- -- From zconf.h
10		-
11		- MAX_MEM_LEVEL : constant := 9; -- zconf.h:105
12		- -- zconf.h:105
13		- MAX_WBITS : constant := 15; -- zconf.h:115
14		- -- 32K LZ77 window
15		- -- zconf.h:115
16		- SEEK_SET : constant := 8#0000#; -- zconf.h:244
17		- -- Seek from beginning of file.
18		- -- zconf.h:244
19		- SEEK_CUR : constant := 1; -- zconf.h:245
20		- -- Seek from current position.
21		- -- zconf.h:245
22		- SEEK_END : constant := 2; -- zconf.h:246
23		- -- Set file pointer to EOF plus "offset"
24		- -- zconf.h:246
25		-
26		- type Byte is new Interfaces.C.unsigned_char; -- 8 bits
27		- -- zconf.h:214
28		- type UInt is new Interfaces.C.unsigned; -- 16 bits or more
29		- -- zconf.h:216
30		- type Int is new Interfaces.C.int;
31		-
32		- type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more
33		- -- zconf.h:217
34		- subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;
35		-
36		- type ULong_Access is access ULong;
37		- type Int_Access is access Int;
38		-
39		- subtype Voidp is System.Address; -- zconf.h:232
40		-
41		- subtype Byte_Access is Voidp;
42		-
43		- Nul : constant Voidp := System.Null_Address;
44		- -- end from zconf
45		-
46		- Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125
47		- -- zlib.h:125
48		- Z_PARTIAL_FLUSH : constant := 1; -- zlib.h:126
49		- -- will be removed, use
50		- -- Z_SYNC_FLUSH instead
51		- -- zlib.h:126
52		- Z_SYNC_FLUSH : constant := 2; -- zlib.h:127
53		- -- zlib.h:127
54		- Z_FULL_FLUSH : constant := 3; -- zlib.h:128
55		- -- zlib.h:128
56		- Z_FINISH : constant := 4; -- zlib.h:129
57		- -- zlib.h:129
58		- Z_OK : constant := 8#0000#; -- zlib.h:132
59		- -- zlib.h:132
60		- Z_STREAM_END : constant := 1; -- zlib.h:133
61		- -- zlib.h:133
62		- Z_NEED_DICT : constant := 2; -- zlib.h:134
63		- -- zlib.h:134
64		- Z_ERRNO : constant := -1; -- zlib.h:135
65		- -- zlib.h:135
66		- Z_STREAM_ERROR : constant := -2; -- zlib.h:136
67		- -- zlib.h:136
68		- Z_DATA_ERROR : constant := -3; -- zlib.h:137
69		- -- zlib.h:137
70		- Z_MEM_ERROR : constant := -4; -- zlib.h:138
71		- -- zlib.h:138
72		- Z_BUF_ERROR : constant := -5; -- zlib.h:139
73		- -- zlib.h:139
74		- Z_VERSION_ERROR : constant := -6; -- zlib.h:140
75		- -- zlib.h:140
76		- Z_NO_COMPRESSION : constant := 8#0000#; -- zlib.h:145
77		- -- zlib.h:145
78		- Z_BEST_SPEED : constant := 1; -- zlib.h:146
79		- -- zlib.h:146
80		- Z_BEST_COMPRESSION : constant := 9; -- zlib.h:147
81		- -- zlib.h:147
82		- Z_DEFAULT_COMPRESSION : constant := -1; -- zlib.h:148
83		- -- zlib.h:148
84		- Z_FILTERED : constant := 1; -- zlib.h:151
85		- -- zlib.h:151
86		- Z_HUFFMAN_ONLY : constant := 2; -- zlib.h:152
87		- -- zlib.h:152
88		- Z_DEFAULT_STRATEGY : constant := 8#0000#; -- zlib.h:153
89		- -- zlib.h:153
90		- Z_BINARY : constant := 8#0000#; -- zlib.h:156
91		- -- zlib.h:156
92		- Z_ASCII : constant := 1; -- zlib.h:157
93		- -- zlib.h:157
94		- Z_UNKNOWN : constant := 2; -- zlib.h:158
95		- -- zlib.h:158
96		- Z_DEFLATED : constant := 8; -- zlib.h:161
97		- -- zlib.h:161
98		- Z_NULL : constant := 8#0000#; -- zlib.h:164
99		- -- for initializing zalloc, zfree, opaque
100		- -- zlib.h:164
101		- type gzFile is new Voidp; -- zlib.h:646
102		-
103		- type Z_Stream is private;
104		-
105		- type Z_Streamp is access all Z_Stream; -- zlib.h:89
106		-
107		- type alloc_func is access function
108		- (Opaque : Voidp;
109		- Items : UInt;
110		- Size : UInt)
111		- return Voidp; -- zlib.h:63
112		-
113		- type free_func is access procedure (opaque : Voidp; address : Voidp);
114		-
115		- function zlibVersion return Chars_Ptr;
116		-
117		- function Deflate (strm : Z_Streamp; flush : Int) return Int;
118		-
119		- function DeflateEnd (strm : Z_Streamp) return Int;
120		-
121		- function Inflate (strm : Z_Streamp; flush : Int) return Int;
122		-
123		- function InflateEnd (strm : Z_Streamp) return Int;
124		-
125		- function deflateSetDictionary
126		- (strm : Z_Streamp;
127		- dictionary : Byte_Access;
128		- dictLength : UInt)
129		- return Int;
130		-
131		- function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int;
132		- -- zlib.h:478
133		-
134		- function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495
135		-
136		- function deflateParams
137		- (strm : Z_Streamp;
138		- level : Int;
139		- strategy : Int)
140		- return Int; -- zlib.h:506
141		-
142		- function inflateSetDictionary
143		- (strm : Z_Streamp;
144		- dictionary : Byte_Access;
145		- dictLength : UInt)
146		- return Int; -- zlib.h:548
147		-
148		- function inflateSync (strm : Z_Streamp) return Int; -- zlib.h:565
149		-
150		- function inflateReset (strm : Z_Streamp) return Int; -- zlib.h:580
151		-
152		- function compress
153		- (dest : Byte_Access;
154		- destLen : ULong_Access;
155		- source : Byte_Access;
156		- sourceLen : ULong)
157		- return Int; -- zlib.h:601
158		-
159		- function compress2
160		- (dest : Byte_Access;
161		- destLen : ULong_Access;
162		- source : Byte_Access;
163		- sourceLen : ULong;
164		- level : Int)
165		- return Int; -- zlib.h:615
166		-
167		- function uncompress
168		- (dest : Byte_Access;
169		- destLen : ULong_Access;
170		- source : Byte_Access;
171		- sourceLen : ULong)
172		- return Int;
173		-
174		- function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile;
175		-
176		- function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile;
177		-
178		- function gzsetparams
179		- (file : gzFile;
180		- level : Int;
181		- strategy : Int)
182		- return Int;
183		-
184		- function gzread
185		- (file : gzFile;
186		- buf : Voidp;
187		- len : UInt)
188		- return Int;
189		-
190		- function gzwrite
191		- (file : in gzFile;
192		- buf : in Voidp;
193		- len : in UInt)
194		- return Int;
195		-
196		- function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int;
197		-
198		- function gzputs (file : in gzFile; s : in Chars_Ptr) return Int;
199		-
200		- function gzgets
201		- (file : gzFile;
202		- buf : Chars_Ptr;
203		- len : Int)
204		- return Chars_Ptr;
205		-
206		- function gzputc (file : gzFile; char : Int) return Int;
207		-
208		- function gzgetc (file : gzFile) return Int;
209		-
210		- function gzflush (file : gzFile; flush : Int) return Int;
211		-
212		- function gzseek
213		- (file : gzFile;
214		- offset : Int;
215		- whence : Int)
216		- return Int;
217		-
218		- function gzrewind (file : gzFile) return Int;
219		-
220		- function gztell (file : gzFile) return Int;
221		-
222		- function gzeof (file : gzFile) return Int;
223		-
224		- function gzclose (file : gzFile) return Int;
225		-
226		- function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr;
227		-
228		- function adler32
229		- (adler : ULong;
230		- buf : Byte_Access;
231		- len : UInt)
232		- return ULong;
233		-
234		- function crc32
235		- (crc : ULong;
236		- buf : Byte_Access;
237		- len : UInt)
238		- return ULong;
239		-
240		- function deflateInit
241		- (strm : Z_Streamp;
242		- level : Int;
243		- version : Chars_Ptr;
244		- stream_size : Int)
245		- return Int;
246		-
247		- function deflateInit2
248		- (strm : Z_Streamp;
249		- level : Int;
250		- method : Int;
251		- windowBits : Int;
252		- memLevel : Int;
253		- strategy : Int;
254		- version : Chars_Ptr;
255		- stream_size : Int)
256		- return Int;
257		-
258		- function Deflate_Init
259		- (strm : Z_Streamp;
260		- level : Int;
261		- method : Int;
262		- windowBits : Int;
263		- memLevel : Int;
264		- strategy : Int)
265		- return Int;
266		- pragma Inline (Deflate_Init);
267		-
268		- function inflateInit
269		- (strm : Z_Streamp;
270		- version : Chars_Ptr;
271		- stream_size : Int)
272		- return Int;
273		-
274		- function inflateInit2
275		- (strm : in Z_Streamp;
276		- windowBits : in Int;
277		- version : in Chars_Ptr;
278		- stream_size : in Int)
279		- return Int;
280		-
281		- function inflateBackInit
282		- (strm : in Z_Streamp;
283		- windowBits : in Int;
284		- window : in Byte_Access;
285		- version : in Chars_Ptr;
286		- stream_size : in Int)
287		- return Int;
288		- -- Size of window have to be 2**windowBits.
289		-
290		- function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int;
291		- pragma Inline (Inflate_Init);
292		-
293		- function zError (err : Int) return Chars_Ptr;
294		-
295		- function inflateSyncPoint (z : Z_Streamp) return Int;
296		-
297		- function get_crc_table return ULong_Access;
298		-
299		- -- Interface to the available fields of the z_stream structure.
300		- -- The application must update next_in and avail_in when avail_in has
301		- -- dropped to zero. It must update next_out and avail_out when avail_out
302		- -- has dropped to zero. The application must initialize zalloc, zfree and
303		- -- opaque before calling the init function.
304		-
305		- procedure Set_In
306		- (Strm : in out Z_Stream;
307		- Buffer : in Voidp;
308		- Size : in UInt);
309		- pragma Inline (Set_In);
310		-
311		- procedure Set_Out
312		- (Strm : in out Z_Stream;
313		- Buffer : in Voidp;
314		- Size : in UInt);
315		- pragma Inline (Set_Out);
316		-
317		- procedure Set_Mem_Func
318		- (Strm : in out Z_Stream;
319		- Opaque : in Voidp;
320		- Alloc : in alloc_func;
321		- Free : in free_func);
322		- pragma Inline (Set_Mem_Func);
323		-
324		- function Last_Error_Message (Strm : in Z_Stream) return String;
325		- pragma Inline (Last_Error_Message);
326		-
327		- function Avail_Out (Strm : in Z_Stream) return UInt;
328		- pragma Inline (Avail_Out);
329		-
330		- function Avail_In (Strm : in Z_Stream) return UInt;
331		- pragma Inline (Avail_In);
332		-
333		- function Total_In (Strm : in Z_Stream) return ULong;
334		- pragma Inline (Total_In);
335		-
336		- function Total_Out (Strm : in Z_Stream) return ULong;
337		- pragma Inline (Total_Out);
338		-
339		- function inflateCopy
340		- (dest : in Z_Streamp;
341		- Source : in Z_Streamp)
342		- return Int;
343		-
344		- function compressBound (Source_Len : in ULong) return ULong;
345		-
346		- function deflateBound
347		- (Strm : in Z_Streamp;
348		- Source_Len : in ULong)
349		- return ULong;
350		-
351		- function gzungetc (C : in Int; File : in gzFile) return Int;
352		-
353		- function zlibCompileFlags return ULong;
354		-
355		-private
356		-
357		- type Z_Stream is record -- zlib.h:68
358		- Next_In : Voidp := Nul; -- next input byte
359		- Avail_In : UInt := 0; -- number of bytes available at next_in
360		- Total_In : ULong := 0; -- total nb of input bytes read so far
361		- Next_Out : Voidp := Nul; -- next output byte should be put there
362		- Avail_Out : UInt := 0; -- remaining free space at next_out
363		- Total_Out : ULong := 0; -- total nb of bytes output so far
364		- msg : Chars_Ptr; -- last error message, NULL if no error
365		- state : Voidp; -- not visible by applications
366		- zalloc : alloc_func := null; -- used to allocate the internal state
367		- zfree : free_func := null; -- used to free the internal state
368		- opaque : Voidp; -- private data object passed to
369		- -- zalloc and zfree
370		- data_type : Int; -- best guess about the data type:
371		- -- ascii or binary
372		- adler : ULong; -- adler32 value of the uncompressed
373		- -- data
374		- reserved : ULong; -- reserved for future use
375		- end record;
376		-
377		- pragma Convention (C, Z_Stream);
378		-
379		- pragma Import (C, zlibVersion, "zlibVersion");
380		- pragma Import (C, Deflate, "deflate");
381		- pragma Import (C, DeflateEnd, "deflateEnd");
382		- pragma Import (C, Inflate, "inflate");
383		- pragma Import (C, InflateEnd, "inflateEnd");
384		- pragma Import (C, deflateSetDictionary, "deflateSetDictionary");
385		- pragma Import (C, deflateCopy, "deflateCopy");
386		- pragma Import (C, deflateReset, "deflateReset");
387		- pragma Import (C, deflateParams, "deflateParams");
388		- pragma Import (C, inflateSetDictionary, "inflateSetDictionary");
389		- pragma Import (C, inflateSync, "inflateSync");
390		- pragma Import (C, inflateReset, "inflateReset");
391		- pragma Import (C, compress, "compress");
392		- pragma Import (C, compress2, "compress2");
393		- pragma Import (C, uncompress, "uncompress");
394		- pragma Import (C, gzopen, "gzopen");
395		- pragma Import (C, gzdopen, "gzdopen");
396		- pragma Import (C, gzsetparams, "gzsetparams");
397		- pragma Import (C, gzread, "gzread");
398		- pragma Import (C, gzwrite, "gzwrite");
399		- pragma Import (C, gzprintf, "gzprintf");
400		- pragma Import (C, gzputs, "gzputs");
401		- pragma Import (C, gzgets, "gzgets");
402		- pragma Import (C, gzputc, "gzputc");
403		- pragma Import (C, gzgetc, "gzgetc");
404		- pragma Import (C, gzflush, "gzflush");
405		- pragma Import (C, gzseek, "gzseek");
406		- pragma Import (C, gzrewind, "gzrewind");
407		- pragma Import (C, gztell, "gztell");
408		- pragma Import (C, gzeof, "gzeof");
409		- pragma Import (C, gzclose, "gzclose");
410		- pragma Import (C, gzerror, "gzerror");
411		- pragma Import (C, adler32, "adler32");
412		- pragma Import (C, crc32, "crc32");
413		- pragma Import (C, deflateInit, "deflateInit_");
414		- pragma Import (C, inflateInit, "inflateInit_");
415		- pragma Import (C, deflateInit2, "deflateInit2_");
416		- pragma Import (C, inflateInit2, "inflateInit2_");
417		- pragma Import (C, zError, "zError");
418		- pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
419		- pragma Import (C, get_crc_table, "get_crc_table");
420		-
421		- -- since zlib 1.2.0:
422		-
423		- pragma Import (C, inflateCopy, "inflateCopy");
424		- pragma Import (C, compressBound, "compressBound");
425		- pragma Import (C, deflateBound, "deflateBound");
426		- pragma Import (C, gzungetc, "gzungetc");
427		- pragma Import (C, zlibCompileFlags, "zlibCompileFlags");
428		-
429		- pragma Import (C, inflateBackInit, "inflateBackInit_");
430		-
431		- -- I stopped binding the inflateBack routines, because realize that
432		- -- it does not support zlib and gzip headers for now, and have no
433		- -- symmetric deflateBack routines.
434		- -- ZLib-Ada is symmetric regarding deflate/inflate data transformation
435		- -- and has a similar generic callback interface for the
436		- -- deflate/inflate transformation based on the regular Deflate/Inflate
437		- -- routines.
438		-
439		- -- pragma Import (C, inflateBack, "inflateBack");
440		- -- pragma Import (C, inflateBackEnd, "inflateBackEnd");
441		-
442		-end ZLib.Thin;

	--- a/compat/zlib/contrib/ada/zlib-thin.ads
	+++ b/compat/zlib/contrib/ada/zlib-thin.ads
	@@ -1,450 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2003 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
2
3	with Interfaces.C.Strings;
4
5	with System;
6
7	private package ZLib.Thin is
8
9	-- From zconf.h
10
11	MAX_MEM_LEVEL : constant := 9; -- zconf.h:105
12	-- zconf.h:105
13	MAX_WBITS : constant := 15; -- zconf.h:115
14	-- 32K LZ77 window
15	-- zconf.h:115
16	SEEK_SET : constant := 8#0000#; -- zconf.h:244
17	-- Seek from beginning of file.
18	-- zconf.h:244
19	SEEK_CUR : constant := 1; -- zconf.h:245
20	-- Seek from current position.
21	-- zconf.h:245
22	SEEK_END : constant := 2; -- zconf.h:246
23	-- Set file pointer to EOF plus "offset"
24	-- zconf.h:246
25
26	type Byte is new Interfaces.C.unsigned_char; -- 8 bits
27	-- zconf.h:214
28	type UInt is new Interfaces.C.unsigned; -- 16 bits or more
29	-- zconf.h:216
30	type Int is new Interfaces.C.int;
31
32	type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more
33	-- zconf.h:217
34	subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;
35
36	type ULong_Access is access ULong;
37	type Int_Access is access Int;
38
39	subtype Voidp is System.Address; -- zconf.h:232
40
41	subtype Byte_Access is Voidp;
42
43	Nul : constant Voidp := System.Null_Address;
44	-- end from zconf
45
46	Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125
47	-- zlib.h:125
48	Z_PARTIAL_FLUSH : constant := 1; -- zlib.h:126
49	-- will be removed, use
50	-- Z_SYNC_FLUSH instead
51	-- zlib.h:126
52	Z_SYNC_FLUSH : constant := 2; -- zlib.h:127
53	-- zlib.h:127
54	Z_FULL_FLUSH : constant := 3; -- zlib.h:128
55	-- zlib.h:128
56	Z_FINISH : constant := 4; -- zlib.h:129
57	-- zlib.h:129
58	Z_OK : constant := 8#0000#; -- zlib.h:132
59	-- zlib.h:132
60	Z_STREAM_END : constant := 1; -- zlib.h:133
61	-- zlib.h:133
62	Z_NEED_DICT : constant := 2; -- zlib.h:134
63	-- zlib.h:134
64	Z_ERRNO : constant := -1; -- zlib.h:135
65	-- zlib.h:135
66	Z_STREAM_ERROR : constant := -2; -- zlib.h:136
67	-- zlib.h:136
68	Z_DATA_ERROR : constant := -3; -- zlib.h:137
69	-- zlib.h:137
70	Z_MEM_ERROR : constant := -4; -- zlib.h:138
71	-- zlib.h:138
72	Z_BUF_ERROR : constant := -5; -- zlib.h:139
73	-- zlib.h:139
74	Z_VERSION_ERROR : constant := -6; -- zlib.h:140
75	-- zlib.h:140
76	Z_NO_COMPRESSION : constant := 8#0000#; -- zlib.h:145
77	-- zlib.h:145
78	Z_BEST_SPEED : constant := 1; -- zlib.h:146
79	-- zlib.h:146
80	Z_BEST_COMPRESSION : constant := 9; -- zlib.h:147
81	-- zlib.h:147
82	Z_DEFAULT_COMPRESSION : constant := -1; -- zlib.h:148
83	-- zlib.h:148
84	Z_FILTERED : constant := 1; -- zlib.h:151
85	-- zlib.h:151
86	Z_HUFFMAN_ONLY : constant := 2; -- zlib.h:152
87	-- zlib.h:152
88	Z_DEFAULT_STRATEGY : constant := 8#0000#; -- zlib.h:153
89	-- zlib.h:153
90	Z_BINARY : constant := 8#0000#; -- zlib.h:156
91	-- zlib.h:156
92	Z_ASCII : constant := 1; -- zlib.h:157
93	-- zlib.h:157
94	Z_UNKNOWN : constant := 2; -- zlib.h:158
95	-- zlib.h:158
96	Z_DEFLATED : constant := 8; -- zlib.h:161
97	-- zlib.h:161
98	Z_NULL : constant := 8#0000#; -- zlib.h:164
99	-- for initializing zalloc, zfree, opaque
100	-- zlib.h:164
101	type gzFile is new Voidp; -- zlib.h:646
102
103	type Z_Stream is private;
104
105	type Z_Streamp is access all Z_Stream; -- zlib.h:89
106
107	type alloc_func is access function
108	(Opaque : Voidp;
109	Items : UInt;
110	Size : UInt)
111	return Voidp; -- zlib.h:63
112
113	type free_func is access procedure (opaque : Voidp; address : Voidp);
114
115	function zlibVersion return Chars_Ptr;
116
117	function Deflate (strm : Z_Streamp; flush : Int) return Int;
118
119	function DeflateEnd (strm : Z_Streamp) return Int;
120
121	function Inflate (strm : Z_Streamp; flush : Int) return Int;
122
123	function InflateEnd (strm : Z_Streamp) return Int;
124
125	function deflateSetDictionary
126	(strm : Z_Streamp;
127	dictionary : Byte_Access;
128	dictLength : UInt)
129	return Int;
130
131	function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int;
132	-- zlib.h:478
133
134	function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495
135
136	function deflateParams
137	(strm : Z_Streamp;
138	level : Int;
139	strategy : Int)
140	return Int; -- zlib.h:506
141
142	function inflateSetDictionary
143	(strm : Z_Streamp;
144	dictionary : Byte_Access;
145	dictLength : UInt)
146	return Int; -- zlib.h:548
147
148	function inflateSync (strm : Z_Streamp) return Int; -- zlib.h:565
149
150	function inflateReset (strm : Z_Streamp) return Int; -- zlib.h:580
151
152	function compress
153	(dest : Byte_Access;
154	destLen : ULong_Access;
155	source : Byte_Access;
156	sourceLen : ULong)
157	return Int; -- zlib.h:601
158
159	function compress2
160	(dest : Byte_Access;
161	destLen : ULong_Access;
162	source : Byte_Access;
163	sourceLen : ULong;
164	level : Int)
165	return Int; -- zlib.h:615
166
167	function uncompress
168	(dest : Byte_Access;
169	destLen : ULong_Access;
170	source : Byte_Access;
171	sourceLen : ULong)
172	return Int;
173
174	function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile;
175
176	function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile;
177
178	function gzsetparams
179	(file : gzFile;
180	level : Int;
181	strategy : Int)
182	return Int;
183
184	function gzread
185	(file : gzFile;
186	buf : Voidp;
187	len : UInt)
188	return Int;
189
190	function gzwrite
191	(file : in gzFile;
192	buf : in Voidp;
193	len : in UInt)
194	return Int;
195
196	function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int;
197
198	function gzputs (file : in gzFile; s : in Chars_Ptr) return Int;
199
200	function gzgets
201	(file : gzFile;
202	buf : Chars_Ptr;
203	len : Int)
204	return Chars_Ptr;
205
206	function gzputc (file : gzFile; char : Int) return Int;
207
208	function gzgetc (file : gzFile) return Int;
209
210	function gzflush (file : gzFile; flush : Int) return Int;
211
212	function gzseek
213	(file : gzFile;
214	offset : Int;
215	whence : Int)
216	return Int;
217
218	function gzrewind (file : gzFile) return Int;
219
220	function gztell (file : gzFile) return Int;
221
222	function gzeof (file : gzFile) return Int;
223
224	function gzclose (file : gzFile) return Int;
225
226	function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr;
227
228	function adler32
229	(adler : ULong;
230	buf : Byte_Access;
231	len : UInt)
232	return ULong;
233
234	function crc32
235	(crc : ULong;
236	buf : Byte_Access;
237	len : UInt)
238	return ULong;
239
240	function deflateInit
241	(strm : Z_Streamp;
242	level : Int;
243	version : Chars_Ptr;
244	stream_size : Int)
245	return Int;
246
247	function deflateInit2
248	(strm : Z_Streamp;
249	level : Int;
250	method : Int;
251	windowBits : Int;
252	memLevel : Int;
253	strategy : Int;
254	version : Chars_Ptr;
255	stream_size : Int)
256	return Int;
257
258	function Deflate_Init
259	(strm : Z_Streamp;
260	level : Int;
261	method : Int;
262	windowBits : Int;
263	memLevel : Int;
264	strategy : Int)
265	return Int;
266	pragma Inline (Deflate_Init);
267
268	function inflateInit
269	(strm : Z_Streamp;
270	version : Chars_Ptr;
271	stream_size : Int)
272	return Int;
273
274	function inflateInit2
275	(strm : in Z_Streamp;
276	windowBits : in Int;
277	version : in Chars_Ptr;
278	stream_size : in Int)
279	return Int;
280
281	function inflateBackInit
282	(strm : in Z_Streamp;
283	windowBits : in Int;
284	window : in Byte_Access;
285	version : in Chars_Ptr;
286	stream_size : in Int)
287	return Int;
288	-- Size of window have to be 2**windowBits.
289
290	function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int;
291	pragma Inline (Inflate_Init);
292
293	function zError (err : Int) return Chars_Ptr;
294
295	function inflateSyncPoint (z : Z_Streamp) return Int;
296
297	function get_crc_table return ULong_Access;
298
299	-- Interface to the available fields of the z_stream structure.
300	-- The application must update next_in and avail_in when avail_in has
301	-- dropped to zero. It must update next_out and avail_out when avail_out
302	-- has dropped to zero. The application must initialize zalloc, zfree and
303	-- opaque before calling the init function.
304
305	procedure Set_In
306	(Strm : in out Z_Stream;
307	Buffer : in Voidp;
308	Size : in UInt);
309	pragma Inline (Set_In);
310
311	procedure Set_Out
312	(Strm : in out Z_Stream;
313	Buffer : in Voidp;
314	Size : in UInt);
315	pragma Inline (Set_Out);
316
317	procedure Set_Mem_Func
318	(Strm : in out Z_Stream;
319	Opaque : in Voidp;
320	Alloc : in alloc_func;
321	Free : in free_func);
322	pragma Inline (Set_Mem_Func);
323
324	function Last_Error_Message (Strm : in Z_Stream) return String;
325	pragma Inline (Last_Error_Message);
326
327	function Avail_Out (Strm : in Z_Stream) return UInt;
328	pragma Inline (Avail_Out);
329
330	function Avail_In (Strm : in Z_Stream) return UInt;
331	pragma Inline (Avail_In);
332
333	function Total_In (Strm : in Z_Stream) return ULong;
334	pragma Inline (Total_In);
335
336	function Total_Out (Strm : in Z_Stream) return ULong;
337	pragma Inline (Total_Out);
338
339	function inflateCopy
340	(dest : in Z_Streamp;
341	Source : in Z_Streamp)
342	return Int;
343
344	function compressBound (Source_Len : in ULong) return ULong;
345
346	function deflateBound
347	(Strm : in Z_Streamp;
348	Source_Len : in ULong)
349	return ULong;
350
351	function gzungetc (C : in Int; File : in gzFile) return Int;
352
353	function zlibCompileFlags return ULong;
354
355	private
356
357	type Z_Stream is record -- zlib.h:68
358	Next_In : Voidp := Nul; -- next input byte
359	Avail_In : UInt := 0; -- number of bytes available at next_in
360	Total_In : ULong := 0; -- total nb of input bytes read so far
361	Next_Out : Voidp := Nul; -- next output byte should be put there
362	Avail_Out : UInt := 0; -- remaining free space at next_out
363	Total_Out : ULong := 0; -- total nb of bytes output so far
364	msg : Chars_Ptr; -- last error message, NULL if no error
365	state : Voidp; -- not visible by applications
366	zalloc : alloc_func := null; -- used to allocate the internal state
367	zfree : free_func := null; -- used to free the internal state
368	opaque : Voidp; -- private data object passed to
369	-- zalloc and zfree
370	data_type : Int; -- best guess about the data type:
371	-- ascii or binary
372	adler : ULong; -- adler32 value of the uncompressed
373	-- data
374	reserved : ULong; -- reserved for future use
375	end record;
376
377	pragma Convention (C, Z_Stream);
378
379	pragma Import (C, zlibVersion, "zlibVersion");
380	pragma Import (C, Deflate, "deflate");
381	pragma Import (C, DeflateEnd, "deflateEnd");
382	pragma Import (C, Inflate, "inflate");
383	pragma Import (C, InflateEnd, "inflateEnd");
384	pragma Import (C, deflateSetDictionary, "deflateSetDictionary");
385	pragma Import (C, deflateCopy, "deflateCopy");
386	pragma Import (C, deflateReset, "deflateReset");
387	pragma Import (C, deflateParams, "deflateParams");
388	pragma Import (C, inflateSetDictionary, "inflateSetDictionary");
389	pragma Import (C, inflateSync, "inflateSync");
390	pragma Import (C, inflateReset, "inflateReset");
391	pragma Import (C, compress, "compress");
392	pragma Import (C, compress2, "compress2");
393	pragma Import (C, uncompress, "uncompress");
394	pragma Import (C, gzopen, "gzopen");
395	pragma Import (C, gzdopen, "gzdopen");
396	pragma Import (C, gzsetparams, "gzsetparams");
397	pragma Import (C, gzread, "gzread");
398	pragma Import (C, gzwrite, "gzwrite");
399	pragma Import (C, gzprintf, "gzprintf");
400	pragma Import (C, gzputs, "gzputs");
401	pragma Import (C, gzgets, "gzgets");
402	pragma Import (C, gzputc, "gzputc");
403	pragma Import (C, gzgetc, "gzgetc");
404	pragma Import (C, gzflush, "gzflush");
405	pragma Import (C, gzseek, "gzseek");
406	pragma Import (C, gzrewind, "gzrewind");
407	pragma Import (C, gztell, "gztell");
408	pragma Import (C, gzeof, "gzeof");
409	pragma Import (C, gzclose, "gzclose");
410	pragma Import (C, gzerror, "gzerror");
411	pragma Import (C, adler32, "adler32");
412	pragma Import (C, crc32, "crc32");
413	pragma Import (C, deflateInit, "deflateInit_");
414	pragma Import (C, inflateInit, "inflateInit_");
415	pragma Import (C, deflateInit2, "deflateInit2_");
416	pragma Import (C, inflateInit2, "inflateInit2_");
417	pragma Import (C, zError, "zError");
418	pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
419	pragma Import (C, get_crc_table, "get_crc_table");
420
421	-- since zlib 1.2.0:
422
423	pragma Import (C, inflateCopy, "inflateCopy");
424	pragma Import (C, compressBound, "compressBound");
425	pragma Import (C, deflateBound, "deflateBound");
426	pragma Import (C, gzungetc, "gzungetc");
427	pragma Import (C, zlibCompileFlags, "zlibCompileFlags");
428
429	pragma Import (C, inflateBackInit, "inflateBackInit_");
430
431	-- I stopped binding the inflateBack routines, because realize that
432	-- it does not support zlib and gzip headers for now, and have no
433	-- symmetric deflateBack routines.
434	-- ZLib-Ada is symmetric regarding deflate/inflate data transformation
435	-- and has a similar generic callback interface for the
436	-- deflate/inflate transformation based on the regular Deflate/Inflate
437	-- routines.
438
439	-- pragma Import (C, inflateBack, "inflateBack");
440	-- pragma Import (C, inflateBackEnd, "inflateBackEnd");
441
442	end ZLib.Thin;

	--- a/compat/zlib/contrib/ada/zlib-thin.ads
	+++ b/compat/zlib/contrib/ada/zlib-thin.ads
	@@ -1,450 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/zlib.adb

-693

		--- a/compat/zlib/contrib/ada/zlib.adb
		+++ b/compat/zlib/contrib/ada/zlib.adb
		@@ -1,701 +0,0 @@
		-----------------------------------------------------------------
		--- ZLib for Ada thick binding. --
		--- --
		--- Copyright (C) 2002-2004 Dmitriy Anisimkov --
		--- --
		--- Open source license information is in the zlib.ads file. --
		-----------------------------------------------------------------
1		-
		--- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
2		-
3		-with Ada.Exceptions;
4		-with Ada.Unchecked_Conversion;
5		-with Ada.Unchecked_Deallocation;
6		-
7		-with Interfaces.C.Strings;
8		-
9		-with ZLib.Thin;
10		-
11		-package body ZLib is
12		-
13		- use type Thin.Int;
14		-
15		- type Z_Stream is new Thin.Z_Stream;
16		-
17		- type Return_Code_Enum is
18		- (OK,
19		- STREAM_END,
20		- NEED_DICT,
21		- ERRNO,
22		- STREAM_ERROR,
23		- DATA_ERROR,
24		- MEM_ERROR,
25		- BUF_ERROR,
26		- VERSION_ERROR);
27		-
28		- type Flate_Step_Function is access
29		- function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
30		- pragma Convention (C, Flate_Step_Function);
31		-
32		- type Flate_End_Function is access
33		- function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
34		- pragma Convention (C, Flate_End_Function);
35		-
36		- type Flate_Type is record
37		- Step : Flate_Step_Function;
38		- Done : Flate_End_Function;
39		- end record;
40		-
41		- subtype Footer_Array is Stream_Element_Array (1 .. 8);
42		-
43		- Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
44		- := (16#1f#, 16#8b#, -- Magic header
45		- 16#08#, -- Z_DEFLATED
46		- 16#00#, -- Flags
47		- 16#00#, 16#00#, 16#00#, 16#00#, -- Time
48		- 16#00#, -- XFlags
49		- 16#03# -- OS code
50		- );
51		- -- The simplest gzip header is not for informational, but just for
52		- -- gzip format compatibility.
53		- -- Note that some code below is using assumption
54		- -- Simple_GZip_Header'Last > Footer_Array'Last, so do not make
55		- -- Simple_GZip_Header'Last <= Footer_Array'Last.
56		-
57		- Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
58		- := (0 => OK,
59		- 1 => STREAM_END,
60		- 2 => NEED_DICT,
61		- -1 => ERRNO,
62		- -2 => STREAM_ERROR,
63		- -3 => DATA_ERROR,
64		- -4 => MEM_ERROR,
65		- -5 => BUF_ERROR,
66		- -6 => VERSION_ERROR);
67		-
68		- Flate : constant array (Boolean) of Flate_Type
69		- := (True => (Step => Thin.Deflate'Access,
70		- Done => Thin.DeflateEnd'Access),
71		- False => (Step => Thin.Inflate'Access,
72		- Done => Thin.InflateEnd'Access));
73		-
74		- Flush_Finish : constant array (Boolean) of Flush_Mode
75		- := (True => Finish, False => No_Flush);
76		-
77		- procedure Raise_Error (Stream : in Z_Stream);
78		- pragma Inline (Raise_Error);
79		-
80		- procedure Raise_Error (Message : in String);
81		- pragma Inline (Raise_Error);
82		-
83		- procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
84		-
85		- procedure Free is new Ada.Unchecked_Deallocation
86		- (Z_Stream, Z_Stream_Access);
87		-
88		- function To_Thin_Access is new Ada.Unchecked_Conversion
89		- (Z_Stream_Access, Thin.Z_Streamp);
90		-
91		- procedure Translate_GZip
92		- (Filter : in out Filter_Type;
93		- In_Data : in Ada.Streams.Stream_Element_Array;
94		- In_Last : out Ada.Streams.Stream_Element_Offset;
95		- Out_Data : out Ada.Streams.Stream_Element_Array;
96		- Out_Last : out Ada.Streams.Stream_Element_Offset;
97		- Flush : in Flush_Mode);
98		- -- Separate translate routine for make gzip header.
99		-
100		- procedure Translate_Auto
101		- (Filter : in out Filter_Type;
102		- In_Data : in Ada.Streams.Stream_Element_Array;
103		- In_Last : out Ada.Streams.Stream_Element_Offset;
104		- Out_Data : out Ada.Streams.Stream_Element_Array;
105		- Out_Last : out Ada.Streams.Stream_Element_Offset;
106		- Flush : in Flush_Mode);
107		- -- translate routine without additional headers.
108		-
109		- -----------------
110		- -- Check_Error --
111		- -----------------
112		-
113		- procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
114		- use type Thin.Int;
115		- begin
116		- if Code /= Thin.Z_OK then
117		- Raise_Error
118		- (Return_Code_Enum'Image (Return_Code (Code))
119		- & ": " & Last_Error_Message (Stream));
120		- end if;
121		- end Check_Error;
122		-
123		- -----------
124		- -- Close --
125		- -----------
126		-
127		- procedure Close
128		- (Filter : in out Filter_Type;
129		- Ignore_Error : in Boolean := False)
130		- is
131		- Code : Thin.Int;
132		- begin
133		- if not Ignore_Error and then not Is_Open (Filter) then
134		- raise Status_Error;
135		- end if;
136		-
137		- Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
138		-
139		- if Ignore_Error or else Code = Thin.Z_OK then
140		- Free (Filter.Strm);
141		- else
142		- declare
143		- Error_Message : constant String
144		- := Last_Error_Message (Filter.Strm.all);
145		- begin
146		- Free (Filter.Strm);
147		- Ada.Exceptions.Raise_Exception
148		- (ZLib_Error'Identity,
149		- Return_Code_Enum'Image (Return_Code (Code))
150		- & ": " & Error_Message);
151		- end;
152		- end if;
153		- end Close;
154		-
155		- -----------
156		- -- CRC32 --
157		- -----------
158		-
159		- function CRC32
160		- (CRC : in Unsigned_32;
161		- Data : in Ada.Streams.Stream_Element_Array)
162		- return Unsigned_32
163		- is
164		- use Thin;
165		- begin
166		- return Unsigned_32 (crc32 (ULong (CRC),
167		- Data'Address,
168		- Data'Length));
169		- end CRC32;
170		-
171		- procedure CRC32
172		- (CRC : in out Unsigned_32;
173		- Data : in Ada.Streams.Stream_Element_Array) is
174		- begin
175		- CRC := CRC32 (CRC, Data);
176		- end CRC32;
177		-
178		- ------------------
179		- -- Deflate_Init --
180		- ------------------
181		-
182		- procedure Deflate_Init
183		- (Filter : in out Filter_Type;
184		- Level : in Compression_Level := Default_Compression;
185		- Strategy : in Strategy_Type := Default_Strategy;
186		- Method : in Compression_Method := Deflated;
187		- Window_Bits : in Window_Bits_Type := Default_Window_Bits;
188		- Memory_Level : in Memory_Level_Type := Default_Memory_Level;
189		- Header : in Header_Type := Default)
190		- is
191		- use type Thin.Int;
192		- Win_Bits : Thin.Int := Thin.Int (Window_Bits);
193		- begin
194		- if Is_Open (Filter) then
195		- raise Status_Error;
196		- end if;
197		-
198		- -- We allow ZLib to make header only in case of default header type.
199		- -- Otherwise we would either do header by ourselfs, or do not do
200		- -- header at all.
201		-
202		- if Header = None or else Header = GZip then
203		- Win_Bits := -Win_Bits;
204		- end if;
205		-
206		- -- For the GZip CRC calculation and make headers.
207		-
208		- if Header = GZip then
209		- Filter.CRC := 0;
210		- Filter.Offset := Simple_GZip_Header'First;
211		- else
212		- Filter.Offset := Simple_GZip_Header'Last + 1;
213		- end if;
214		-
215		- Filter.Strm := new Z_Stream;
216		- Filter.Compression := True;
217		- Filter.Stream_End := False;
218		- Filter.Header := Header;
219		-
220		- if Thin.Deflate_Init
221		- (To_Thin_Access (Filter.Strm),
222		- Level => Thin.Int (Level),
223		- method => Thin.Int (Method),
224		- windowBits => Win_Bits,
225		- memLevel => Thin.Int (Memory_Level),
226		- strategy => Thin.Int (Strategy)) /= Thin.Z_OK
227		- then
228		- Raise_Error (Filter.Strm.all);
229		- end if;
230		- end Deflate_Init;
231		-
232		- -----------
233		- -- Flush --
234		- -----------
235		-
236		- procedure Flush
237		- (Filter : in out Filter_Type;
238		- Out_Data : out Ada.Streams.Stream_Element_Array;
239		- Out_Last : out Ada.Streams.Stream_Element_Offset;
240		- Flush : in Flush_Mode)
241		- is
242		- No_Data : Stream_Element_Array := (1 .. 0 => 0);
243		- Last : Stream_Element_Offset;
244		- begin
245		- Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
246		- end Flush;
247		-
248		- -----------------------
249		- -- Generic_Translate --
250		- -----------------------
251		-
252		- procedure Generic_Translate
253		- (Filter : in out ZLib.Filter_Type;
254		- In_Buffer_Size : in Integer := Default_Buffer_Size;
255		- Out_Buffer_Size : in Integer := Default_Buffer_Size)
256		- is
257		- In_Buffer : Stream_Element_Array
258		- (1 .. Stream_Element_Offset (In_Buffer_Size));
259		- Out_Buffer : Stream_Element_Array
260		- (1 .. Stream_Element_Offset (Out_Buffer_Size));
261		- Last : Stream_Element_Offset;
262		- In_Last : Stream_Element_Offset;
263		- In_First : Stream_Element_Offset;
264		- Out_Last : Stream_Element_Offset;
265		- begin
266		- Main : loop
267		- Data_In (In_Buffer, Last);
268		-
269		- In_First := In_Buffer'First;
270		-
271		- loop
272		- Translate
273		- (Filter => Filter,
274		- In_Data => In_Buffer (In_First .. Last),
275		- In_Last => In_Last,
276		- Out_Data => Out_Buffer,
277		- Out_Last => Out_Last,
278		- Flush => Flush_Finish (Last < In_Buffer'First));
279		-
280		- if Out_Buffer'First <= Out_Last then
281		- Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
282		- end if;
283		-
284		- exit Main when Stream_End (Filter);
285		-
286		- -- The end of in buffer.
287		-
288		- exit when In_Last = Last;
289		-
290		- In_First := In_Last + 1;
291		- end loop;
292		- end loop Main;
293		-
294		- end Generic_Translate;
295		-
296		- ------------------
297		- -- Inflate_Init --
298		- ------------------
299		-
300		- procedure Inflate_Init
301		- (Filter : in out Filter_Type;
302		- Window_Bits : in Window_Bits_Type := Default_Window_Bits;
303		- Header : in Header_Type := Default)
304		- is
305		- use type Thin.Int;
306		- Win_Bits : Thin.Int := Thin.Int (Window_Bits);
307		-
308		- procedure Check_Version;
309		- -- Check the latest header types compatibility.
310		-
311		- procedure Check_Version is
312		- begin
313		- if Version <= "1.1.4" then
314		- Raise_Error
315		- ("Inflate header type " & Header_Type'Image (Header)
316		- & " incompatible with ZLib version " & Version);
317		- end if;
318		- end Check_Version;
319		-
320		- begin
321		- if Is_Open (Filter) then
322		- raise Status_Error;
323		- end if;
324		-
325		- case Header is
326		- when None =>
327		- Check_Version;
328		-
329		- -- Inflate data without headers determined
330		- -- by negative Win_Bits.
331		-
332		- Win_Bits := -Win_Bits;
333		- when GZip =>
334		- Check_Version;
335		-
336		- -- Inflate gzip data defined by flag 16.
337		-
338		- Win_Bits := Win_Bits + 16;
339		- when Auto =>
340		- Check_Version;
341		-
342		- -- Inflate with automatic detection
343		- -- of gzip or native header defined by flag 32.
344		-
345		- Win_Bits := Win_Bits + 32;
346		- when Default => null;
347		- end case;
348		-
349		- Filter.Strm := new Z_Stream;
350		- Filter.Compression := False;
351		- Filter.Stream_End := False;
352		- Filter.Header := Header;
353		-
354		- if Thin.Inflate_Init
355		- (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
356		- then
357		- Raise_Error (Filter.Strm.all);
358		- end if;
359		- end Inflate_Init;
360		-
361		- -------------
362		- -- Is_Open --
363		- -------------
364		-
365		- function Is_Open (Filter : in Filter_Type) return Boolean is
366		- begin
367		- return Filter.Strm /= null;
368		- end Is_Open;
369		-
370		- -----------------
371		- -- Raise_Error --
372		- -----------------
373		-
374		- procedure Raise_Error (Message : in String) is
375		- begin
376		- Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
377		- end Raise_Error;
378		-
379		- procedure Raise_Error (Stream : in Z_Stream) is
380		- begin
381		- Raise_Error (Last_Error_Message (Stream));
382		- end Raise_Error;
383		-
384		- ----------
385		- -- Read --
386		- ----------
387		-
388		- procedure Read
389		- (Filter : in out Filter_Type;
390		- Item : out Ada.Streams.Stream_Element_Array;
391		- Last : out Ada.Streams.Stream_Element_Offset;
392		- Flush : in Flush_Mode := No_Flush)
393		- is
394		- In_Last : Stream_Element_Offset;
395		- Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
396		- V_Flush : Flush_Mode := Flush;
397		-
398		- begin
399		- pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
400		- pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
401		-
402		- loop
403		- if Rest_Last = Buffer'First - 1 then
404		- V_Flush := Finish;
405		-
406		- elsif Rest_First > Rest_Last then
407		- Read (Buffer, Rest_Last);
408		- Rest_First := Buffer'First;
409		-
410		- if Rest_Last < Buffer'First then
411		- V_Flush := Finish;
412		- end if;
413		- end if;
414		-
415		- Translate
416		- (Filter => Filter,
417		- In_Data => Buffer (Rest_First .. Rest_Last),
418		- In_Last => In_Last,
419		- Out_Data => Item (Item_First .. Item'Last),
420		- Out_Last => Last,
421		- Flush => V_Flush);
422		-
423		- Rest_First := In_Last + 1;
424		-
425		- exit when Stream_End (Filter)
426		- or else Last = Item'Last
427		- or else (Last >= Item'First and then Allow_Read_Some);
428		-
429		- Item_First := Last + 1;
430		- end loop;
431		- end Read;
432		-
433		- ----------------
434		- -- Stream_End --
435		- ----------------
436		-
437		- function Stream_End (Filter : in Filter_Type) return Boolean is
438		- begin
439		- if Filter.Header = GZip and Filter.Compression then
440		- return Filter.Stream_End
441		- and then Filter.Offset = Footer_Array'Last + 1;
442		- else
443		- return Filter.Stream_End;
444		- end if;
445		- end Stream_End;
446		-
447		- --------------
448		- -- Total_In --
449		- --------------
450		-
451		- function Total_In (Filter : in Filter_Type) return Count is
452		- begin
453		- return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
454		- end Total_In;
455		-
456		- ---------------
457		- -- Total_Out --
458		- ---------------
459		-
460		- function Total_Out (Filter : in Filter_Type) return Count is
461		- begin
462		- return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
463		- end Total_Out;
464		-
465		- ---------------
466		- -- Translate --
467		- ---------------
468		-
469		- procedure Translate
470		- (Filter : in out Filter_Type;
471		- In_Data : in Ada.Streams.Stream_Element_Array;
472		- In_Last : out Ada.Streams.Stream_Element_Offset;
473		- Out_Data : out Ada.Streams.Stream_Element_Array;
474		- Out_Last : out Ada.Streams.Stream_Element_Offset;
475		- Flush : in Flush_Mode) is
476		- begin
477		- if Filter.Header = GZip and then Filter.Compression then
478		- Translate_GZip
479		- (Filter => Filter,
480		- In_Data => In_Data,
481		- In_Last => In_Last,
482		- Out_Data => Out_Data,
483		- Out_Last => Out_Last,
484		- Flush => Flush);
485		- else
486		- Translate_Auto
487		- (Filter => Filter,
488		- In_Data => In_Data,
489		- In_Last => In_Last,
490		- Out_Data => Out_Data,
491		- Out_Last => Out_Last,
492		- Flush => Flush);
493		- end if;
494		- end Translate;
495		-
496		- --------------------
497		- -- Translate_Auto --
498		- --------------------
499		-
500		- procedure Translate_Auto
501		- (Filter : in out Filter_Type;
502		- In_Data : in Ada.Streams.Stream_Element_Array;
503		- In_Last : out Ada.Streams.Stream_Element_Offset;
504		- Out_Data : out Ada.Streams.Stream_Element_Array;
505		- Out_Last : out Ada.Streams.Stream_Element_Offset;
506		- Flush : in Flush_Mode)
507		- is
508		- use type Thin.Int;
509		- Code : Thin.Int;
510		-
511		- begin
512		- if not Is_Open (Filter) then
513		- raise Status_Error;
514		- end if;
515		-
516		- if Out_Data'Length = 0 and then In_Data'Length = 0 then
517		- raise Constraint_Error;
518		- end if;
519		-
520		- Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
521		- Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
522		-
523		- Code := Flate (Filter.Compression).Step
524		- (To_Thin_Access (Filter.Strm),
525		- Thin.Int (Flush));
526		-
527		- if Code = Thin.Z_STREAM_END then
528		- Filter.Stream_End := True;
529		- else
530		- Check_Error (Filter.Strm.all, Code);
531		- end if;
532		-
533		- In_Last := In_Data'Last
534		- - Stream_Element_Offset (Avail_In (Filter.Strm.all));
535		- Out_Last := Out_Data'Last
536		- - Stream_Element_Offset (Avail_Out (Filter.Strm.all));
537		- end Translate_Auto;
538		-
539		- --------------------
540		- -- Translate_GZip --
541		- --------------------
542		-
543		- procedure Translate_GZip
544		- (Filter : in out Filter_Type;
545		- In_Data : in Ada.Streams.Stream_Element_Array;
546		- In_Last : out Ada.Streams.Stream_Element_Offset;
547		- Out_Data : out Ada.Streams.Stream_Element_Array;
548		- Out_Last : out Ada.Streams.Stream_Element_Offset;
549		- Flush : in Flush_Mode)
550		- is
551		- Out_First : Stream_Element_Offset;
552		-
553		- procedure Add_Data (Data : in Stream_Element_Array);
554		- -- Add data to stream from the Filter.Offset till necessary,
555		- -- used for add gzip headr/footer.
556		-
557		- procedure Put_32
558		- (Item : in out Stream_Element_Array;
559		- Data : in Unsigned_32);
560		- pragma Inline (Put_32);
561		-
562		- --------------
563		- -- Add_Data --
564		- --------------
565		-
566		- procedure Add_Data (Data : in Stream_Element_Array) is
567		- Data_First : Stream_Element_Offset renames Filter.Offset;
568		- Data_Last : Stream_Element_Offset;
569		- Data_Len : Stream_Element_Offset; -- -1
570		- Out_Len : Stream_Element_Offset; -- -1
571		- begin
572		- Out_First := Out_Last + 1;
573		-
574		- if Data_First > Data'Last then
575		- return;
576		- end if;
577		-
578		- Data_Len := Data'Last - Data_First;
579		- Out_Len := Out_Data'Last - Out_First;
580		-
581		- if Data_Len <= Out_Len then
582		- Out_Last := Out_First + Data_Len;
583		- Data_Last := Data'Last;
584		- else
585		- Out_Last := Out_Data'Last;
586		- Data_Last := Data_First + Out_Len;
587		- end if;
588		-
589		- Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
590		-
591		- Data_First := Data_Last + 1;
592		- Out_First := Out_Last + 1;
593		- end Add_Data;
594		-
595		- ------------
596		- -- Put_32 --
597		- ------------
598		-
599		- procedure Put_32
600		- (Item : in out Stream_Element_Array;
601		- Data : in Unsigned_32)
602		- is
603		- D : Unsigned_32 := Data;
604		- begin
605		- for J in Item'First .. Item'First + 3 loop
606		- Item (J) := Stream_Element (D and 16#FF#);
607		- D := Shift_Right (D, 8);
608		- end loop;
609		- end Put_32;
610		-
611		- begin
612		- Out_Last := Out_Data'First - 1;
613		-
614		- if not Filter.Stream_End then
615		- Add_Data (Simple_GZip_Header);
616		-
617		- Translate_Auto
618		- (Filter => Filter,
619		- In_Data => In_Data,
620		- In_Last => In_Last,
621		- Out_Data => Out_Data (Out_First .. Out_Data'Last),
622		- Out_Last => Out_Last,
623		- Flush => Flush);
624		-
625		- CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
626		- end if;
627		-
628		- if Filter.Stream_End and then Out_Last <= Out_Data'Last then
629		- -- This detection method would work only when
630		- -- Simple_GZip_Header'Last > Footer_Array'Last
631		-
632		- if Filter.Offset = Simple_GZip_Header'Last + 1 then
633		- Filter.Offset := Footer_Array'First;
634		- end if;
635		-
636		- declare
637		- Footer : Footer_Array;
638		- begin
639		- Put_32 (Footer, Filter.CRC);
640		- Put_32 (Footer (Footer'First + 4 .. Footer'Last),
641		- Unsigned_32 (Total_In (Filter)));
642		- Add_Data (Footer);
643		- end;
644		- end if;
645		- end Translate_GZip;
646		-
647		- -------------
648		- -- Version --
649		- -------------
650		-
651		- function Version return String is
652		- begin
653		- return Interfaces.C.Strings.Value (Thin.zlibVersion);
654		- end Version;
655		-
656		- -----------
657		- -- Write --
658		- -----------
659		-
660		- procedure Write
661		- (Filter : in out Filter_Type;
662		- Item : in Ada.Streams.Stream_Element_Array;
663		- Flush : in Flush_Mode := No_Flush)
664		- is
665		- Buffer : Stream_Element_Array (1 .. Buffer_Size);
666		- In_Last : Stream_Element_Offset;
667		- Out_Last : Stream_Element_Offset;
668		- In_First : Stream_Element_Offset := Item'First;
669		- begin
670		- if Item'Length = 0 and Flush = No_Flush then
671		- return;
672		- end if;
673		-
674		- loop
675		- Translate
676		- (Filter => Filter,
677		- In_Data => Item (In_First .. Item'Last),
678		- In_Last => In_Last,
679		- Out_Data => Buffer,
680		- Out_Last => Out_Last,
681		- Flush => Flush);
682		-
683		- if Out_Last >= Buffer'First then
684		- Write (Buffer (1 .. Out_Last));
685		- end if;
686		-
687		- exit when In_Last = Item'Last or Stream_End (Filter);
688		-
689		- In_First := In_Last + 1;
690		- end loop;
691		- end Write;
692		-
693		-end ZLib;

	--- a/compat/zlib/contrib/ada/zlib.adb
	+++ b/compat/zlib/contrib/ada/zlib.adb
	@@ -1,701 +0,0 @@
	-----------------------------------------------------------------
	--- ZLib for Ada thick binding. --
	--- --
	--- Copyright (C) 2002-2004 Dmitriy Anisimkov --
	--- --
	--- Open source license information is in the zlib.ads file. --
	-----------------------------------------------------------------
1
	--- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
2
3	with Ada.Exceptions;
4	with Ada.Unchecked_Conversion;
5	with Ada.Unchecked_Deallocation;
6
7	with Interfaces.C.Strings;
8
9	with ZLib.Thin;
10
11	package body ZLib is
12
13	use type Thin.Int;
14
15	type Z_Stream is new Thin.Z_Stream;
16
17	type Return_Code_Enum is
18	(OK,
19	STREAM_END,
20	NEED_DICT,
21	ERRNO,
22	STREAM_ERROR,
23	DATA_ERROR,
24	MEM_ERROR,
25	BUF_ERROR,
26	VERSION_ERROR);
27
28	type Flate_Step_Function is access
29	function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
30	pragma Convention (C, Flate_Step_Function);
31
32	type Flate_End_Function is access
33	function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
34	pragma Convention (C, Flate_End_Function);
35
36	type Flate_Type is record
37	Step : Flate_Step_Function;
38	Done : Flate_End_Function;
39	end record;
40
41	subtype Footer_Array is Stream_Element_Array (1 .. 8);
42
43	Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
44	:= (16#1f#, 16#8b#, -- Magic header
45	16#08#, -- Z_DEFLATED
46	16#00#, -- Flags
47	16#00#, 16#00#, 16#00#, 16#00#, -- Time
48	16#00#, -- XFlags
49	16#03# -- OS code
50	);
51	-- The simplest gzip header is not for informational, but just for
52	-- gzip format compatibility.
53	-- Note that some code below is using assumption
54	-- Simple_GZip_Header'Last > Footer_Array'Last, so do not make
55	-- Simple_GZip_Header'Last <= Footer_Array'Last.
56
57	Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
58	:= (0 => OK,
59	1 => STREAM_END,
60	2 => NEED_DICT,
61	-1 => ERRNO,
62	-2 => STREAM_ERROR,
63	-3 => DATA_ERROR,
64	-4 => MEM_ERROR,
65	-5 => BUF_ERROR,
66	-6 => VERSION_ERROR);
67
68	Flate : constant array (Boolean) of Flate_Type
69	:= (True => (Step => Thin.Deflate'Access,
70	Done => Thin.DeflateEnd'Access),
71	False => (Step => Thin.Inflate'Access,
72	Done => Thin.InflateEnd'Access));
73
74	Flush_Finish : constant array (Boolean) of Flush_Mode
75	:= (True => Finish, False => No_Flush);
76
77	procedure Raise_Error (Stream : in Z_Stream);
78	pragma Inline (Raise_Error);
79
80	procedure Raise_Error (Message : in String);
81	pragma Inline (Raise_Error);
82
83	procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
84
85	procedure Free is new Ada.Unchecked_Deallocation
86	(Z_Stream, Z_Stream_Access);
87
88	function To_Thin_Access is new Ada.Unchecked_Conversion
89	(Z_Stream_Access, Thin.Z_Streamp);
90
91	procedure Translate_GZip
92	(Filter : in out Filter_Type;
93	In_Data : in Ada.Streams.Stream_Element_Array;
94	In_Last : out Ada.Streams.Stream_Element_Offset;
95	Out_Data : out Ada.Streams.Stream_Element_Array;
96	Out_Last : out Ada.Streams.Stream_Element_Offset;
97	Flush : in Flush_Mode);
98	-- Separate translate routine for make gzip header.
99
100	procedure Translate_Auto
101	(Filter : in out Filter_Type;
102	In_Data : in Ada.Streams.Stream_Element_Array;
103	In_Last : out Ada.Streams.Stream_Element_Offset;
104	Out_Data : out Ada.Streams.Stream_Element_Array;
105	Out_Last : out Ada.Streams.Stream_Element_Offset;
106	Flush : in Flush_Mode);
107	-- translate routine without additional headers.
108
109	-----------------
110	-- Check_Error --
111	-----------------
112
113	procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
114	use type Thin.Int;
115	begin
116	if Code /= Thin.Z_OK then
117	Raise_Error
118	(Return_Code_Enum'Image (Return_Code (Code))
119	& ": " & Last_Error_Message (Stream));
120	end if;
121	end Check_Error;
122
123	-----------
124	-- Close --
125	-----------
126
127	procedure Close
128	(Filter : in out Filter_Type;
129	Ignore_Error : in Boolean := False)
130	is
131	Code : Thin.Int;
132	begin
133	if not Ignore_Error and then not Is_Open (Filter) then
134	raise Status_Error;
135	end if;
136
137	Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
138
139	if Ignore_Error or else Code = Thin.Z_OK then
140	Free (Filter.Strm);
141	else
142	declare
143	Error_Message : constant String
144	:= Last_Error_Message (Filter.Strm.all);
145	begin
146	Free (Filter.Strm);
147	Ada.Exceptions.Raise_Exception
148	(ZLib_Error'Identity,
149	Return_Code_Enum'Image (Return_Code (Code))
150	& ": " & Error_Message);
151	end;
152	end if;
153	end Close;
154
155	-----------
156	-- CRC32 --
157	-----------
158
159	function CRC32
160	(CRC : in Unsigned_32;
161	Data : in Ada.Streams.Stream_Element_Array)
162	return Unsigned_32
163	is
164	use Thin;
165	begin
166	return Unsigned_32 (crc32 (ULong (CRC),
167	Data'Address,
168	Data'Length));
169	end CRC32;
170
171	procedure CRC32
172	(CRC : in out Unsigned_32;
173	Data : in Ada.Streams.Stream_Element_Array) is
174	begin
175	CRC := CRC32 (CRC, Data);
176	end CRC32;
177
178	------------------
179	-- Deflate_Init --
180	------------------
181
182	procedure Deflate_Init
183	(Filter : in out Filter_Type;
184	Level : in Compression_Level := Default_Compression;
185	Strategy : in Strategy_Type := Default_Strategy;
186	Method : in Compression_Method := Deflated;
187	Window_Bits : in Window_Bits_Type := Default_Window_Bits;
188	Memory_Level : in Memory_Level_Type := Default_Memory_Level;
189	Header : in Header_Type := Default)
190	is
191	use type Thin.Int;
192	Win_Bits : Thin.Int := Thin.Int (Window_Bits);
193	begin
194	if Is_Open (Filter) then
195	raise Status_Error;
196	end if;
197
198	-- We allow ZLib to make header only in case of default header type.
199	-- Otherwise we would either do header by ourselfs, or do not do
200	-- header at all.
201
202	if Header = None or else Header = GZip then
203	Win_Bits := -Win_Bits;
204	end if;
205
206	-- For the GZip CRC calculation and make headers.
207
208	if Header = GZip then
209	Filter.CRC := 0;
210	Filter.Offset := Simple_GZip_Header'First;
211	else
212	Filter.Offset := Simple_GZip_Header'Last + 1;
213	end if;
214
215	Filter.Strm := new Z_Stream;
216	Filter.Compression := True;
217	Filter.Stream_End := False;
218	Filter.Header := Header;
219
220	if Thin.Deflate_Init
221	(To_Thin_Access (Filter.Strm),
222	Level => Thin.Int (Level),
223	method => Thin.Int (Method),
224	windowBits => Win_Bits,
225	memLevel => Thin.Int (Memory_Level),
226	strategy => Thin.Int (Strategy)) /= Thin.Z_OK
227	then
228	Raise_Error (Filter.Strm.all);
229	end if;
230	end Deflate_Init;
231
232	-----------
233	-- Flush --
234	-----------
235
236	procedure Flush
237	(Filter : in out Filter_Type;
238	Out_Data : out Ada.Streams.Stream_Element_Array;
239	Out_Last : out Ada.Streams.Stream_Element_Offset;
240	Flush : in Flush_Mode)
241	is
242	No_Data : Stream_Element_Array := (1 .. 0 => 0);
243	Last : Stream_Element_Offset;
244	begin
245	Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
246	end Flush;
247
248	-----------------------
249	-- Generic_Translate --
250	-----------------------
251
252	procedure Generic_Translate
253	(Filter : in out ZLib.Filter_Type;
254	In_Buffer_Size : in Integer := Default_Buffer_Size;
255	Out_Buffer_Size : in Integer := Default_Buffer_Size)
256	is
257	In_Buffer : Stream_Element_Array
258	(1 .. Stream_Element_Offset (In_Buffer_Size));
259	Out_Buffer : Stream_Element_Array
260	(1 .. Stream_Element_Offset (Out_Buffer_Size));
261	Last : Stream_Element_Offset;
262	In_Last : Stream_Element_Offset;
263	In_First : Stream_Element_Offset;
264	Out_Last : Stream_Element_Offset;
265	begin
266	Main : loop
267	Data_In (In_Buffer, Last);
268
269	In_First := In_Buffer'First;
270
271	loop
272	Translate
273	(Filter => Filter,
274	In_Data => In_Buffer (In_First .. Last),
275	In_Last => In_Last,
276	Out_Data => Out_Buffer,
277	Out_Last => Out_Last,
278	Flush => Flush_Finish (Last < In_Buffer'First));
279
280	if Out_Buffer'First <= Out_Last then
281	Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
282	end if;
283
284	exit Main when Stream_End (Filter);
285
286	-- The end of in buffer.
287
288	exit when In_Last = Last;
289
290	In_First := In_Last + 1;
291	end loop;
292	end loop Main;
293
294	end Generic_Translate;
295
296	------------------
297	-- Inflate_Init --
298	------------------
299
300	procedure Inflate_Init
301	(Filter : in out Filter_Type;
302	Window_Bits : in Window_Bits_Type := Default_Window_Bits;
303	Header : in Header_Type := Default)
304	is
305	use type Thin.Int;
306	Win_Bits : Thin.Int := Thin.Int (Window_Bits);
307
308	procedure Check_Version;
309	-- Check the latest header types compatibility.
310
311	procedure Check_Version is
312	begin
313	if Version <= "1.1.4" then
314	Raise_Error
315	("Inflate header type " & Header_Type'Image (Header)
316	& " incompatible with ZLib version " & Version);
317	end if;
318	end Check_Version;
319
320	begin
321	if Is_Open (Filter) then
322	raise Status_Error;
323	end if;
324
325	case Header is
326	when None =>
327	Check_Version;
328
329	-- Inflate data without headers determined
330	-- by negative Win_Bits.
331
332	Win_Bits := -Win_Bits;
333	when GZip =>
334	Check_Version;
335
336	-- Inflate gzip data defined by flag 16.
337
338	Win_Bits := Win_Bits + 16;
339	when Auto =>
340	Check_Version;
341
342	-- Inflate with automatic detection
343	-- of gzip or native header defined by flag 32.
344
345	Win_Bits := Win_Bits + 32;
346	when Default => null;
347	end case;
348
349	Filter.Strm := new Z_Stream;
350	Filter.Compression := False;
351	Filter.Stream_End := False;
352	Filter.Header := Header;
353
354	if Thin.Inflate_Init
355	(To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
356	then
357	Raise_Error (Filter.Strm.all);
358	end if;
359	end Inflate_Init;
360
361	-------------
362	-- Is_Open --
363	-------------
364
365	function Is_Open (Filter : in Filter_Type) return Boolean is
366	begin
367	return Filter.Strm /= null;
368	end Is_Open;
369
370	-----------------
371	-- Raise_Error --
372	-----------------
373
374	procedure Raise_Error (Message : in String) is
375	begin
376	Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
377	end Raise_Error;
378
379	procedure Raise_Error (Stream : in Z_Stream) is
380	begin
381	Raise_Error (Last_Error_Message (Stream));
382	end Raise_Error;
383
384	----------
385	-- Read --
386	----------
387
388	procedure Read
389	(Filter : in out Filter_Type;
390	Item : out Ada.Streams.Stream_Element_Array;
391	Last : out Ada.Streams.Stream_Element_Offset;
392	Flush : in Flush_Mode := No_Flush)
393	is
394	In_Last : Stream_Element_Offset;
395	Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
396	V_Flush : Flush_Mode := Flush;
397
398	begin
399	pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
400	pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
401
402	loop
403	if Rest_Last = Buffer'First - 1 then
404	V_Flush := Finish;
405
406	elsif Rest_First > Rest_Last then
407	Read (Buffer, Rest_Last);
408	Rest_First := Buffer'First;
409
410	if Rest_Last < Buffer'First then
411	V_Flush := Finish;
412	end if;
413	end if;
414
415	Translate
416	(Filter => Filter,
417	In_Data => Buffer (Rest_First .. Rest_Last),
418	In_Last => In_Last,
419	Out_Data => Item (Item_First .. Item'Last),
420	Out_Last => Last,
421	Flush => V_Flush);
422
423	Rest_First := In_Last + 1;
424
425	exit when Stream_End (Filter)
426	or else Last = Item'Last
427	or else (Last >= Item'First and then Allow_Read_Some);
428
429	Item_First := Last + 1;
430	end loop;
431	end Read;
432
433	----------------
434	-- Stream_End --
435	----------------
436
437	function Stream_End (Filter : in Filter_Type) return Boolean is
438	begin
439	if Filter.Header = GZip and Filter.Compression then
440	return Filter.Stream_End
441	and then Filter.Offset = Footer_Array'Last + 1;
442	else
443	return Filter.Stream_End;
444	end if;
445	end Stream_End;
446
447	--------------
448	-- Total_In --
449	--------------
450
451	function Total_In (Filter : in Filter_Type) return Count is
452	begin
453	return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
454	end Total_In;
455
456	---------------
457	-- Total_Out --
458	---------------
459
460	function Total_Out (Filter : in Filter_Type) return Count is
461	begin
462	return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
463	end Total_Out;
464
465	---------------
466	-- Translate --
467	---------------
468
469	procedure Translate
470	(Filter : in out Filter_Type;
471	In_Data : in Ada.Streams.Stream_Element_Array;
472	In_Last : out Ada.Streams.Stream_Element_Offset;
473	Out_Data : out Ada.Streams.Stream_Element_Array;
474	Out_Last : out Ada.Streams.Stream_Element_Offset;
475	Flush : in Flush_Mode) is
476	begin
477	if Filter.Header = GZip and then Filter.Compression then
478	Translate_GZip
479	(Filter => Filter,
480	In_Data => In_Data,
481	In_Last => In_Last,
482	Out_Data => Out_Data,
483	Out_Last => Out_Last,
484	Flush => Flush);
485	else
486	Translate_Auto
487	(Filter => Filter,
488	In_Data => In_Data,
489	In_Last => In_Last,
490	Out_Data => Out_Data,
491	Out_Last => Out_Last,
492	Flush => Flush);
493	end if;
494	end Translate;
495
496	--------------------
497	-- Translate_Auto --
498	--------------------
499
500	procedure Translate_Auto
501	(Filter : in out Filter_Type;
502	In_Data : in Ada.Streams.Stream_Element_Array;
503	In_Last : out Ada.Streams.Stream_Element_Offset;
504	Out_Data : out Ada.Streams.Stream_Element_Array;
505	Out_Last : out Ada.Streams.Stream_Element_Offset;
506	Flush : in Flush_Mode)
507	is
508	use type Thin.Int;
509	Code : Thin.Int;
510
511	begin
512	if not Is_Open (Filter) then
513	raise Status_Error;
514	end if;
515
516	if Out_Data'Length = 0 and then In_Data'Length = 0 then
517	raise Constraint_Error;
518	end if;
519
520	Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
521	Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
522
523	Code := Flate (Filter.Compression).Step
524	(To_Thin_Access (Filter.Strm),
525	Thin.Int (Flush));
526
527	if Code = Thin.Z_STREAM_END then
528	Filter.Stream_End := True;
529	else
530	Check_Error (Filter.Strm.all, Code);
531	end if;
532
533	In_Last := In_Data'Last
534	- Stream_Element_Offset (Avail_In (Filter.Strm.all));
535	Out_Last := Out_Data'Last
536	- Stream_Element_Offset (Avail_Out (Filter.Strm.all));
537	end Translate_Auto;
538
539	--------------------
540	-- Translate_GZip --
541	--------------------
542
543	procedure Translate_GZip
544	(Filter : in out Filter_Type;
545	In_Data : in Ada.Streams.Stream_Element_Array;
546	In_Last : out Ada.Streams.Stream_Element_Offset;
547	Out_Data : out Ada.Streams.Stream_Element_Array;
548	Out_Last : out Ada.Streams.Stream_Element_Offset;
549	Flush : in Flush_Mode)
550	is
551	Out_First : Stream_Element_Offset;
552
553	procedure Add_Data (Data : in Stream_Element_Array);
554	-- Add data to stream from the Filter.Offset till necessary,
555	-- used for add gzip headr/footer.
556
557	procedure Put_32
558	(Item : in out Stream_Element_Array;
559	Data : in Unsigned_32);
560	pragma Inline (Put_32);
561
562	--------------
563	-- Add_Data --
564	--------------
565
566	procedure Add_Data (Data : in Stream_Element_Array) is
567	Data_First : Stream_Element_Offset renames Filter.Offset;
568	Data_Last : Stream_Element_Offset;
569	Data_Len : Stream_Element_Offset; -- -1
570	Out_Len : Stream_Element_Offset; -- -1
571	begin
572	Out_First := Out_Last + 1;
573
574	if Data_First > Data'Last then
575	return;
576	end if;
577
578	Data_Len := Data'Last - Data_First;
579	Out_Len := Out_Data'Last - Out_First;
580
581	if Data_Len <= Out_Len then
582	Out_Last := Out_First + Data_Len;
583	Data_Last := Data'Last;
584	else
585	Out_Last := Out_Data'Last;
586	Data_Last := Data_First + Out_Len;
587	end if;
588
589	Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
590
591	Data_First := Data_Last + 1;
592	Out_First := Out_Last + 1;
593	end Add_Data;
594
595	------------
596	-- Put_32 --
597	------------
598
599	procedure Put_32
600	(Item : in out Stream_Element_Array;
601	Data : in Unsigned_32)
602	is
603	D : Unsigned_32 := Data;
604	begin
605	for J in Item'First .. Item'First + 3 loop
606	Item (J) := Stream_Element (D and 16#FF#);
607	D := Shift_Right (D, 8);
608	end loop;
609	end Put_32;
610
611	begin
612	Out_Last := Out_Data'First - 1;
613
614	if not Filter.Stream_End then
615	Add_Data (Simple_GZip_Header);
616
617	Translate_Auto
618	(Filter => Filter,
619	In_Data => In_Data,
620	In_Last => In_Last,
621	Out_Data => Out_Data (Out_First .. Out_Data'Last),
622	Out_Last => Out_Last,
623	Flush => Flush);
624
625	CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
626	end if;
627
628	if Filter.Stream_End and then Out_Last <= Out_Data'Last then
629	-- This detection method would work only when
630	-- Simple_GZip_Header'Last > Footer_Array'Last
631
632	if Filter.Offset = Simple_GZip_Header'Last + 1 then
633	Filter.Offset := Footer_Array'First;
634	end if;
635
636	declare
637	Footer : Footer_Array;
638	begin
639	Put_32 (Footer, Filter.CRC);
640	Put_32 (Footer (Footer'First + 4 .. Footer'Last),
641	Unsigned_32 (Total_In (Filter)));
642	Add_Data (Footer);
643	end;
644	end if;
645	end Translate_GZip;
646
647	-------------
648	-- Version --
649	-------------
650
651	function Version return String is
652	begin
653	return Interfaces.C.Strings.Value (Thin.zlibVersion);
654	end Version;
655
656	-----------
657	-- Write --
658	-----------
659
660	procedure Write
661	(Filter : in out Filter_Type;
662	Item : in Ada.Streams.Stream_Element_Array;
663	Flush : in Flush_Mode := No_Flush)
664	is
665	Buffer : Stream_Element_Array (1 .. Buffer_Size);
666	In_Last : Stream_Element_Offset;
667	Out_Last : Stream_Element_Offset;
668	In_First : Stream_Element_Offset := Item'First;
669	begin
670	if Item'Length = 0 and Flush = No_Flush then
671	return;
672	end if;
673
674	loop
675	Translate
676	(Filter => Filter,
677	In_Data => Item (In_First .. Item'Last),
678	In_Last => In_Last,
679	Out_Data => Buffer,
680	Out_Last => Out_Last,
681	Flush => Flush);
682
683	if Out_Last >= Buffer'First then
684	Write (Buffer (1 .. Out_Last));
685	end if;
686
687	exit when In_Last = Item'Last or Stream_End (Filter);
688
689	In_First := In_Last + 1;
690	end loop;
691	end Write;
692
693	end ZLib;

	--- a/compat/zlib/contrib/ada/zlib.adb
	+++ b/compat/zlib/contrib/ada/zlib.adb
	@@ -1,701 +0,0 @@
	-----------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/zlib.ads

-301

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

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

	--- a/compat/zlib/contrib/ada/zlib.ads
	+++ b/compat/zlib/contrib/ada/zlib.ads
	@@ -1,328 +0,0 @@
	-------------------------------------------------------------------------------
	--- 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 $

D compat/zlib/contrib/ada/zlib.gpr

-20

		--- a/compat/zlib/contrib/ada/zlib.gpr
		+++ b/compat/zlib/contrib/ada/zlib.gpr
		@@ -1,20 +0,0 @@
1		-project Zlib is
2		-
3		- for Languages use ("Ada");
4		- for Source_Dirs use (".");
5		- for Object_Dir use ".";
6		- for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");
7		-
8		- package Compiler is
9		- for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
10		- end Compiler;
11		-
12		- package Linker is
13		- for Default_Switches ("ada") use ("-lz");
14		- end Linker;
15		-
16		- package Builder is
17		- for Default_Switches ("ada") use ("-s", "-gnatQ");
18		- end Builder;
19		-
20		-end Zlib;

	--- a/compat/zlib/contrib/ada/zlib.gpr
	+++ b/compat/zlib/contrib/ada/zlib.gpr
	@@ -1,20 +0,0 @@
1	project Zlib is
2
3	for Languages use ("Ada");
4	for Source_Dirs use (".");
5	for Object_Dir use ".";
6	for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");
7
8	package Compiler is
9	for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
10	end Compiler;
11
12	package Linker is
13	for Default_Switches ("ada") use ("-lz");
14	end Linker;
15
16	package Builder is
17	for Default_Switches ("ada") use ("-s", "-gnatQ");
18	end Builder;
19
20	end Zlib;

	--- a/compat/zlib/contrib/ada/zlib.gpr
	+++ b/compat/zlib/contrib/ada/zlib.gpr
	@@ -1,20 +0,0 @@

Fossil SCM

Keyboard Shortcuts