summaryrefslogtreecommitdiff
path: root/contrib/ada
diff options
context:
space:
mode:
authorMark Adler <madler@alumni.caltech.edu>2011-09-09 23:23:45 -0700
committerMark Adler <madler@alumni.caltech.edu>2011-09-09 23:23:45 -0700
commit7a6955760ba950eb82f57929f8f6c9847c65f0af (patch)
treee2cd657aca6d606e0b28bf57fe45e914717a334c /contrib/ada
parentf0e76a6634eb26e3ddc6dfc6f2489553eff8c8f4 (diff)
downloadzlib-1.2.1.2.tar.gz
zlib-1.2.1.2.tar.bz2
zlib-1.2.1.2.zip
zlib 1.2.1.2v1.2.1.2
Diffstat (limited to '')
-rw-r--r--contrib/ada/buffer_demo.adb106
-rw-r--r--contrib/ada/mtest.adb11
-rw-r--r--contrib/ada/read.adb9
-rw-r--r--contrib/ada/readme.txt27
-rw-r--r--contrib/ada/zlib-streams.adb14
-rw-r--r--contrib/ada/zlib-streams.ads6
-rw-r--r--contrib/ada/zlib-thin.adb70
-rw-r--r--contrib/ada/zlib-thin.ads57
-rw-r--r--contrib/ada/zlib.adb143
-rw-r--r--contrib/ada/zlib.ads105
-rw-r--r--contrib/ada/zlib.gpr42
11 files changed, 347 insertions, 243 deletions
diff --git a/contrib/ada/buffer_demo.adb b/contrib/ada/buffer_demo.adb
new file mode 100644
index 0000000..46b8638
--- /dev/null
+++ b/contrib/ada/buffer_demo.adb
@@ -0,0 +1,106 @@
1----------------------------------------------------------------
2-- ZLib for Ada thick binding. --
3-- --
4-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
5-- --
6-- Open source license information is in the zlib.ads file. --
7----------------------------------------------------------------
8--
9-- $Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp $
10
11-- This demo program provided by Dr Steve Sangwine <sjs@essex.ac.uk>
12--
13-- Demonstration of a problem with Zlib-Ada (already fixed) when a buffer
14-- of exactly the correct size is used for decompressed data, and the last
15-- few bytes passed in to Zlib are checksum bytes.
16
17-- This program compresses a string of text, and then decompresses the
18-- compressed text into a buffer of the same size as the original text.
19
20with Ada.Streams; use Ada.Streams;
21with Ada.Text_IO;
22
23with ZLib; use ZLib;
24
25procedure Buffer_Demo is
26 EOL : Character renames ASCII.LF;
27 Text : constant String
28 := "Four score and seven years ago our fathers brought forth," & EOL &
29 "upon this continent, a new nation, conceived in liberty," & EOL &
30 "and dedicated to the proposition that `all men are created equal'.";
31
32 Source : Stream_Element_Array (1 .. Text'Length);
33 for Source'Address use Text'Address;
34
35begin
36 Ada.Text_IO.Put (Text);
37 Ada.Text_IO.New_Line;
38 Ada.Text_IO.Put_Line
39 ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
40
41 declare
42 Compressed_Data : Stream_Element_Array (1 .. Text'Length);
43 L : Stream_Element_Offset;
44 begin
45 Compress : declare
46 Compressor : Filter_Type;
47 I : Stream_Element_Offset;
48 begin
49 Deflate_Init (Compressor);
50
51 -- Compress the whole of T at once.
52
53 Translate (Compressor, Source, I, Compressed_Data, L, Finish);
54 pragma Assert (I = Source'Last);
55
56 Close (Compressor);
57
58 Ada.Text_IO.Put_Line
59 ("Compressed size : "
60 & Stream_Element_Offset'Image (L) & " bytes");
61 end Compress;
62
63 -- Now we decompress the data, passing short blocks of data to Zlib
64 -- (because this demonstrates the problem - the last block passed will
65 -- contain checksum information and there will be no output, only a
66 -- check inside Zlib that the checksum is correct).
67
68 Decompress : declare
69 Decompressor : Filter_Type;
70
71 Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
72
73 Block_Size : constant := 4;
74 -- This makes sure that the last block contains
75 -- only Adler checksum data.
76
77 P : Stream_Element_Offset := Compressed_Data'First - 1;
78 O : Stream_Element_Offset;
79 begin
80 Inflate_Init (Decompressor);
81
82 loop
83 Translate
84 (Decompressor,
85 Compressed_Data
86 (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
87 P,
88 Uncompressed_Data
89 (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
90 O,
91 No_Flush);
92
93 Ada.Text_IO.Put_Line
94 ("Total in : " & Count'Image (Total_In (Decompressor)) &
95 ", out : " & Count'Image (Total_Out (Decompressor)));
96
97 exit when P = L;
98 end loop;
99
100 Ada.Text_IO.New_Line;
101 Ada.Text_IO.Put_Line
102 ("Decompressed text matches original text : "
103 & Boolean'Image (Uncompressed_Data = Source));
104 end Decompress;
105 end;
106end Buffer_Demo;
diff --git a/contrib/ada/mtest.adb b/contrib/ada/mtest.adb
index 91a96cd..c4dfd08 100644
--- a/contrib/ada/mtest.adb
+++ b/contrib/ada/mtest.adb
@@ -5,10 +5,10 @@
5-- -- 5-- --
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8-- Continuous test for ZLib multithreading. If the test is fail 8-- Continuous test for ZLib multithreading. If the test would fail
9-- Wou should provide thread safe allocation routines for the Z_Stream. 9-- we should provide thread safe allocation routines for the Z_Stream.
10-- 10--
11-- $Id: mtest.adb,v 1.2 2003/08/12 12:11:05 vagul Exp $ 11-- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $
12 12
13with ZLib; 13with ZLib;
14with Ada.Streams; 14with Ada.Streams;
@@ -148,6 +148,9 @@ procedure MTest is
148 148
149 pragma Unreferenced (Test); 149 pragma Unreferenced (Test);
150 150
151 Dummy : Character;
152
151begin 153begin
152 null; 154 Ada.Text_IO.Get_Immediate (Dummy);
155 Stop := True;
153end MTest; 156end MTest;
diff --git a/contrib/ada/read.adb b/contrib/ada/read.adb
index 184ea00..1f2efbf 100644
--- a/contrib/ada/read.adb
+++ b/contrib/ada/read.adb
@@ -6,7 +6,7 @@
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8 8
9-- $Id: read.adb,v 1.7 2003/08/12 12:12:35 vagul Exp $ 9-- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
10 10
11-- Test/demo program for the generic read interface. 11-- Test/demo program for the generic read interface.
12 12
@@ -68,7 +68,11 @@ procedure Read is
68 -- ZLib.Read 68 -- ZLib.Read
69 -- reading data from the File_In. 69 -- reading data from the File_In.
70 70
71 procedure Read is new ZLib.Read (Read, Read_Buffer, Read_First, Read_Last); 71 procedure Read is new ZLib.Read
72 (Read,
73 Read_Buffer,
74 Rest_First => Read_First,
75 Rest_Last => Read_Last);
72 76
73 ---------- 77 ----------
74 -- Read -- 78 -- Read --
@@ -103,6 +107,7 @@ procedure Read is
103 Pack_Size := 0; 107 Pack_Size := 0;
104 Offset := 1; 108 Offset := 1;
105 Read_First := Read_Buffer'Last + 1; 109 Read_First := Read_Buffer'Last + 1;
110 Read_Last := Read_Buffer'Last;
106 end Reset; 111 end Reset;
107 112
108begin 113begin
diff --git a/contrib/ada/readme.txt b/contrib/ada/readme.txt
index ad02c22..dec7ef3 100644
--- a/contrib/ada/readme.txt
+++ b/contrib/ada/readme.txt
@@ -1,20 +1,31 @@
1
2 ZLib for Ada thick binding (ZLib.Ada) 1 ZLib for Ada thick binding (ZLib.Ada)
3 Release 1.2 2 Release 1.3
4 3
5ZLib.Ada is a thick binding interface to the popular ZLib data 4ZLib.Ada is a thick binding interface to the popular ZLib data
6compression library, available at http://www.gzip.org/zlib/. 5compression library, available at http://www.gzip.org/zlib/.
7It provides Ada-style access to the ZLib C library. 6It provides Ada-style access to the ZLib C library.
8 7
9 8
10 Here are the main changes since ZLib.Ada 1.1: 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.
11 17
12- The default header type has a name "Default" now. Auto is used only for 18- Add pragma Assert to check Stream_Element is 8 bit.
13 automatic GZip/ZLib header detection.
14 19
15- Added test for multitasking mtest.adb. 20- Fix extraction to buffer with exact known decompressed size. Error reported by
21 Steve Sangwine.
16 22
17- Added GNAT project file zlib.gpr. 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.
18 29
19 30
20 How to build ZLib.Ada under GNAT 31 How to build ZLib.Ada under GNAT
@@ -50,3 +61,5 @@ The routines from the package specifications are commented.
50 61
51Homepage: http://zlib-ada.sourceforge.net/ 62Homepage: http://zlib-ada.sourceforge.net/
52Author: Dmitriy Anisimkov <anisimkov@yahoo.com> 63Author: Dmitriy Anisimkov <anisimkov@yahoo.com>
64
65Contributors: Pascal Obry <pascal@obry.org>, Steve Sangwine <sjs@essex.ac.uk>
diff --git a/contrib/ada/zlib-streams.adb b/contrib/ada/zlib-streams.adb
index d213b5c..398664a 100644
--- a/contrib/ada/zlib-streams.adb
+++ b/contrib/ada/zlib-streams.adb
@@ -6,7 +6,7 @@
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8 8
9-- $Id: zlib-streams.adb,v 1.9 2003/08/12 13:15:31 vagul Exp $ 9-- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
10 10
11with Ada.Unchecked_Deallocation; 11with Ada.Unchecked_Deallocation;
12 12
@@ -90,6 +90,7 @@ package body ZLib.Streams is
90 90
91 Stream.Buffer := new Buffer_Subtype; 91 Stream.Buffer := new Buffer_Subtype;
92 Stream.Rest_First := Stream.Buffer'Last + 1; 92 Stream.Rest_First := Stream.Buffer'Last + 1;
93 Stream.Rest_Last := Stream.Buffer'Last;
93 end if; 94 end if;
94 end Create; 95 end Create;
95 96
@@ -113,6 +114,15 @@ package body ZLib.Streams is
113 end loop; 114 end loop;
114 end Flush; 115 end Flush;
115 116
117 -------------
118 -- Is_Open --
119 -------------
120
121 function Is_Open (Stream : Stream_Type) return Boolean is
122 begin
123 return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
124 end Is_Open;
125
116 ---------- 126 ----------
117 -- Read -- 127 -- Read --
118 ---------- 128 ----------
@@ -212,4 +222,4 @@ package body ZLib.Streams is
212 return Total_Out (Stream.Writer); 222 return Total_Out (Stream.Writer);
213 end Write_Total_Out; 223 end Write_Total_Out;
214 224
215end ZLib.Streams; 225end ZLib.Streams; \ No newline at end of file
diff --git a/contrib/ada/zlib-streams.ads b/contrib/ada/zlib-streams.ads
index 1d5e904..5c68667 100644
--- a/contrib/ada/zlib-streams.ads
+++ b/contrib/ada/zlib-streams.ads
@@ -6,7 +6,7 @@
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8 8
9-- $Id: zlib-streams.ads,v 1.11 2003/08/12 13:15:31 vagul Exp $ 9-- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
10 10
11package ZLib.Streams is 11package ZLib.Streams is
12 12
@@ -77,6 +77,8 @@ package ZLib.Streams is
77 -- !!! When the Need_Header is False ZLib-Ada is using undocumented 77 -- !!! When the Need_Header is False ZLib-Ada is using undocumented
78 -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers. 78 -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers.
79 79
80 function Is_Open (Stream : Stream_Type) return Boolean;
81
80 procedure Close (Stream : in out Stream_Type); 82 procedure Close (Stream : in out Stream_Type);
81 83
82private 84private
@@ -109,4 +111,4 @@ private
109 Writer : Filter_Type; 111 Writer : Filter_Type;
110 end record; 112 end record;
111 113
112end ZLib.Streams; 114end ZLib.Streams; \ No newline at end of file
diff --git a/contrib/ada/zlib-thin.adb b/contrib/ada/zlib-thin.adb
index 163bd5b..0ca4a71 100644
--- a/contrib/ada/zlib-thin.adb
+++ b/contrib/ada/zlib-thin.adb
@@ -6,12 +6,11 @@
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8 8
9-- $Id: zlib-thin.adb,v 1.6 2003/01/21 15:26:37 vagul Exp $ 9-- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
10 10
11package body ZLib.Thin is 11package body ZLib.Thin is
12 12
13 ZLIB_VERSION : constant Chars_Ptr := 13 ZLIB_VERSION : constant Chars_Ptr := zlibVersion;
14 Interfaces.C.Strings.New_String ("1.1.4");
15 14
16 Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit; 15 Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit;
17 16
@@ -38,14 +37,6 @@ package body ZLib.Thin is
38 ------------------ 37 ------------------
39 38
40 function Deflate_Init 39 function Deflate_Init
41 (strm : in Z_Streamp;
42 level : in Int := Z_DEFAULT_COMPRESSION)
43 return Int is
44 begin
45 return deflateInit (strm, level, ZLIB_VERSION, Z_Stream_Size);
46 end Deflate_Init;
47
48 function Deflate_Init
49 (strm : Z_Streamp; 40 (strm : Z_Streamp;
50 level : Int; 41 level : Int;
51 method : Int; 42 method : Int;
@@ -69,16 +60,15 @@ package body ZLib.Thin is
69 -- Inflate_Init -- 60 -- Inflate_Init --
70 ------------------ 61 ------------------
71 62
72 function Inflate_Init (strm : Z_Streamp) return Int is
73 begin
74 return inflateInit (strm, ZLIB_VERSION, Z_Stream_Size);
75 end Inflate_Init;
76
77 function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is 63 function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
78 begin 64 begin
79 return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size); 65 return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
80 end Inflate_Init; 66 end Inflate_Init;
81 67
68 ------------------------
69 -- Last_Error_Message --
70 ------------------------
71
82 function Last_Error_Message (Strm : in Z_Stream) return String is 72 function Last_Error_Message (Strm : in Z_Stream) return String is
83 use Interfaces.C.Strings; 73 use Interfaces.C.Strings;
84 begin 74 begin
@@ -89,54 +79,28 @@ package body ZLib.Thin is
89 end if; 79 end if;
90 end Last_Error_Message; 80 end Last_Error_Message;
91 81
92 -------------
93 -- Need_In --
94 -------------
95
96 function Need_In (strm : Z_Stream) return Boolean is
97 begin
98 return strm.Avail_In = 0;
99 end Need_In;
100
101 --------------
102 -- Need_Out --
103 --------------
104
105 function Need_Out (strm : Z_Stream) return Boolean is
106 begin
107 return strm.Avail_Out = 0;
108 end Need_Out;
109
110 ------------ 82 ------------
111 -- Set_In -- 83 -- Set_In --
112 ------------ 84 ------------
113 85
114 procedure Set_In 86 procedure Set_In
115 (Strm : in out Z_Stream; 87 (Strm : in out Z_Stream;
116 Buffer : in Byte_Access; 88 Buffer : in Voidp;
117 Size : in UInt) is 89 Size : in UInt) is
118 begin 90 begin
119 Strm.Next_In := Buffer; 91 Strm.Next_In := Buffer;
120 Strm.Avail_In := Size; 92 Strm.Avail_In := Size;
121 end Set_In; 93 end Set_In;
122 94
123 procedure Set_In
124 (Strm : in out Z_Stream;
125 Buffer : in Voidp;
126 Size : in UInt) is
127 begin
128 Set_In (Strm, Bytes.To_Pointer (Buffer), Size);
129 end Set_In;
130
131 ------------------ 95 ------------------
132 -- Set_Mem_Func -- 96 -- Set_Mem_Func --
133 ------------------ 97 ------------------
134 98
135 procedure Set_Mem_Func 99 procedure Set_Mem_Func
136 (Strm : in out Z_Stream; 100 (Strm : in out Z_Stream;
137 Opaque : in Voidp; 101 Opaque : in Voidp;
138 Alloc : in alloc_func; 102 Alloc : in alloc_func;
139 Free : in free_func) is 103 Free : in free_func) is
140 begin 104 begin
141 Strm.opaque := Opaque; 105 Strm.opaque := Opaque;
142 Strm.zalloc := Alloc; 106 Strm.zalloc := Alloc;
@@ -149,21 +113,13 @@ package body ZLib.Thin is
149 113
150 procedure Set_Out 114 procedure Set_Out
151 (Strm : in out Z_Stream; 115 (Strm : in out Z_Stream;
152 Buffer : in Byte_Access; 116 Buffer : in Voidp;
153 Size : in UInt) is 117 Size : in UInt) is
154 begin 118 begin
155 Strm.Next_Out := Buffer; 119 Strm.Next_Out := Buffer;
156 Strm.Avail_Out := Size; 120 Strm.Avail_Out := Size;
157 end Set_Out; 121 end Set_Out;
158 122
159 procedure Set_Out
160 (Strm : in out Z_Stream;
161 Buffer : in Voidp;
162 Size : in UInt) is
163 begin
164 Set_Out (Strm, Bytes.To_Pointer (Buffer), Size);
165 end Set_Out;
166
167 -------------- 123 --------------
168 -- Total_In -- 124 -- Total_In --
169 -------------- 125 --------------
diff --git a/contrib/ada/zlib-thin.ads b/contrib/ada/zlib-thin.ads
index c227374..d4407eb 100644
--- a/contrib/ada/zlib-thin.ads
+++ b/contrib/ada/zlib-thin.ads
@@ -6,10 +6,11 @@
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8 8
9-- $Id: zlib-thin.ads,v 1.8 2003/08/12 13:16:51 vagul Exp $ 9-- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
10 10
11with Interfaces.C.Strings; 11with Interfaces.C.Strings;
12with System.Address_To_Access_Conversions; 12
13with System;
13 14
14private package ZLib.Thin is 15private package ZLib.Thin is
15 16
@@ -36,18 +37,18 @@ private package ZLib.Thin is
36 -- zconf.h:216 37 -- zconf.h:216
37 type Int is new Interfaces.C.int; 38 type Int is new Interfaces.C.int;
38 39
39 type ULong is new Interfaces.C.unsigned; -- 32 bits or more 40 type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more
40 -- zconf.h:217 41 -- zconf.h:217
41 subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr; 42 subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;
42 43
43 type ULong_Access is access ULong; 44 type ULong_Access is access ULong;
44 type Int_Access is access Int; 45 type Int_Access is access Int;
45 subtype Voidp is System.Address; -- zconf.h:232
46 46
47 package Bytes is new System.Address_To_Access_Conversions (Byte); 47 subtype Voidp is System.Address; -- zconf.h:232
48 48
49 subtype Byte_Access is Bytes.Object_Pointer; 49 subtype Byte_Access is Voidp;
50 50
51 Nul : constant Voidp := System.Null_Address;
51 -- end from zconf 52 -- end from zconf
52 53
53 Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125 54 Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125
@@ -251,12 +252,6 @@ private package ZLib.Thin is
251 stream_size : Int) 252 stream_size : Int)
252 return Int; 253 return Int;
253 254
254 function Deflate_Init
255 (strm : in Z_Streamp;
256 level : in Int := Z_DEFAULT_COMPRESSION)
257 return Int;
258 pragma Inline (Deflate_Init);
259
260 function deflateInit2 255 function deflateInit2
261 (strm : Z_Streamp; 256 (strm : Z_Streamp;
262 level : Int; 257 level : Int;
@@ -284,9 +279,6 @@ private package ZLib.Thin is
284 stream_size : Int) 279 stream_size : Int)
285 return Int; 280 return Int;
286 281
287 function Inflate_Init (strm : Z_Streamp) return Int;
288 pragma Inline (Inflate_Init);
289
290 function inflateInit2 282 function inflateInit2
291 (strm : in Z_Streamp; 283 (strm : in Z_Streamp;
292 windowBits : in Int; 284 windowBits : in Int;
@@ -318,20 +310,6 @@ private package ZLib.Thin is
318 -- has dropped to zero. The application must initialize zalloc, zfree and 310 -- has dropped to zero. The application must initialize zalloc, zfree and
319 -- opaque before calling the init function. 311 -- opaque before calling the init function.
320 312
321 function Need_In (strm : in Z_Stream) return Boolean;
322 -- return true when we do not need to setup Next_In and Avail_In fields.
323 pragma Inline (Need_In);
324
325 function Need_Out (strm : in Z_Stream) return Boolean;
326 -- return true when we do not need to setup Next_Out and Avail_Out field.
327 pragma Inline (Need_Out);
328
329 procedure Set_In
330 (Strm : in out Z_Stream;
331 Buffer : in Byte_Access;
332 Size : in UInt);
333 pragma Inline (Set_In);
334
335 procedure Set_In 313 procedure Set_In
336 (Strm : in out Z_Stream; 314 (Strm : in out Z_Stream;
337 Buffer : in Voidp; 315 Buffer : in Voidp;
@@ -340,12 +318,6 @@ private package ZLib.Thin is
340 318
341 procedure Set_Out 319 procedure Set_Out
342 (Strm : in out Z_Stream; 320 (Strm : in out Z_Stream;
343 Buffer : in Byte_Access;
344 Size : in UInt);
345 pragma Inline (Set_Out);
346
347 procedure Set_Out
348 (Strm : in out Z_Stream;
349 Buffer : in Voidp; 321 Buffer : in Voidp;
350 Size : in UInt); 322 Size : in UInt);
351 pragma Inline (Set_Out); 323 pragma Inline (Set_Out);
@@ -388,19 +360,13 @@ private package ZLib.Thin is
388 360
389 function zlibCompileFlags return ULong; 361 function zlibCompileFlags return ULong;
390 362
391 function deflatePrime
392 (strm : Z_Streamp;
393 bits : Int;
394 value : Int)
395 return Int;
396
397private 363private
398 364
399 type Z_Stream is record -- zlib.h:68 365 type Z_Stream is record -- zlib.h:68
400 Next_In : Byte_Access; -- next input byte 366 Next_In : Voidp := Nul; -- next input byte
401 Avail_In : UInt := 0; -- number of bytes available at next_in 367 Avail_In : UInt := 0; -- number of bytes available at next_in
402 Total_In : ULong := 0; -- total nb of input bytes read so far 368 Total_In : ULong := 0; -- total nb of input bytes read so far
403 Next_Out : Byte_Access; -- next output byte should be put there 369 Next_Out : Voidp := Nul; -- next output byte should be put there
404 Avail_Out : UInt := 0; -- remaining free space at next_out 370 Avail_Out : UInt := 0; -- remaining free space at next_out
405 Total_Out : ULong := 0; -- total nb of bytes output so far 371 Total_Out : ULong := 0; -- total nb of bytes output so far
406 msg : Chars_Ptr; -- last error message, NULL if no error 372 msg : Chars_Ptr; -- last error message, NULL if no error
@@ -460,14 +426,13 @@ private
460 pragma Import (C, inflateSyncPoint, "inflateSyncPoint"); 426 pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
461 pragma Import (C, get_crc_table, "get_crc_table"); 427 pragma Import (C, get_crc_table, "get_crc_table");
462 428
463 -- added in zlib 1.2.1: 429 -- since zlib 1.2.0:
464 430
465 pragma Import (C, inflateCopy, "inflateCopy"); 431 pragma Import (C, inflateCopy, "inflateCopy");
466 pragma Import (C, compressBound, "compressBound"); 432 pragma Import (C, compressBound, "compressBound");
467 pragma Import (C, deflateBound, "deflateBound"); 433 pragma Import (C, deflateBound, "deflateBound");
468 pragma Import (C, gzungetc, "gzungetc"); 434 pragma Import (C, gzungetc, "gzungetc");
469 pragma Import (C, zlibCompileFlags, "zlibCompileFlags"); 435 pragma Import (C, zlibCompileFlags, "zlibCompileFlags");
470 pragma Import (C, deflatePrime, "deflatePrime");
471 436
472 pragma Import (C, inflateBackInit, "inflateBackInit_"); 437 pragma Import (C, inflateBackInit, "inflateBackInit_");
473 438
diff --git a/contrib/ada/zlib.adb b/contrib/ada/zlib.adb
index 93bf885..8b6fd68 100644
--- a/contrib/ada/zlib.adb
+++ b/contrib/ada/zlib.adb
@@ -1,12 +1,12 @@
1---------------------------------------------------------------- 1----------------------------------------------------------------
2-- ZLib for Ada thick binding. -- 2-- ZLib for Ada thick binding. --
3-- -- 3-- --
4-- Copyright (C) 2002-2003 Dmitriy Anisimkov -- 4-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
5-- -- 5-- --
6-- Open source license information is in the zlib.ads file. -- 6-- Open source license information is in the zlib.ads file. --
7---------------------------------------------------------------- 7----------------------------------------------------------------
8 8
9-- $Id: zlib.adb,v 1.19 2003/07/13 16:02:19 vagul Exp $ 9-- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
10 10
11with Ada.Exceptions; 11with Ada.Exceptions;
12with Ada.Unchecked_Conversion; 12with Ada.Unchecked_Conversion;
@@ -34,7 +34,7 @@ package body ZLib is
34 VERSION_ERROR); 34 VERSION_ERROR);
35 35
36 type Flate_Step_Function is access 36 type Flate_Step_Function is access
37 function (Strm : Thin.Z_Streamp; flush : Thin.Int) return Thin.Int; 37 function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
38 pragma Convention (C, Flate_Step_Function); 38 pragma Convention (C, Flate_Step_Function);
39 39
40 type Flate_End_Function is access 40 type Flate_End_Function is access
@@ -82,13 +82,13 @@ package body ZLib is
82 Flush_Finish : constant array (Boolean) of Flush_Mode 82 Flush_Finish : constant array (Boolean) of Flush_Mode
83 := (True => Finish, False => No_Flush); 83 := (True => Finish, False => No_Flush);
84 84
85 procedure Raise_Error (Stream : Z_Stream); 85 procedure Raise_Error (Stream : in Z_Stream);
86 pragma Inline (Raise_Error); 86 pragma Inline (Raise_Error);
87 87
88 procedure Raise_Error (Message : String); 88 procedure Raise_Error (Message : in String);
89 pragma Inline (Raise_Error); 89 pragma Inline (Raise_Error);
90 90
91 procedure Check_Error (Stream : Z_Stream; Code : Thin.Int); 91 procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
92 92
93 procedure Free is new Ada.Unchecked_Deallocation 93 procedure Free is new Ada.Unchecked_Deallocation
94 (Z_Stream, Z_Stream_Access); 94 (Z_Stream, Z_Stream_Access);
@@ -118,7 +118,7 @@ package body ZLib is
118 -- Check_Error -- 118 -- Check_Error --
119 ----------------- 119 -----------------
120 120
121 procedure Check_Error (Stream : Z_Stream; Code : Thin.Int) is 121 procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
122 use type Thin.Int; 122 use type Thin.Int;
123 begin 123 begin
124 if Code /= Thin.Z_OK then 124 if Code /= Thin.Z_OK then
@@ -138,10 +138,11 @@ package body ZLib is
138 is 138 is
139 Code : Thin.Int; 139 Code : Thin.Int;
140 begin 140 begin
141 Code := Flate (Filter.Compression).Done 141 if not Ignore_Error and then not Is_Open (Filter) then
142 (To_Thin_Access (Filter.Strm)); 142 raise Status_Error;
143 end if;
143 144
144 Filter.Opened := False; 145 Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
145 146
146 if Ignore_Error or else Code = Thin.Z_OK then 147 if Ignore_Error or else Code = Thin.Z_OK then
147 Free (Filter.Strm); 148 Free (Filter.Strm);
@@ -154,7 +155,7 @@ package body ZLib is
154 Ada.Exceptions.Raise_Exception 155 Ada.Exceptions.Raise_Exception
155 (ZLib_Error'Identity, 156 (ZLib_Error'Identity,
156 Return_Code_Enum'Image (Return_Code (Code)) 157 Return_Code_Enum'Image (Return_Code (Code))
157 & ": " & Error_Message); 158 & ": " & Error_Message);
158 end; 159 end;
159 end if; 160 end if;
160 end Close; 161 end Close;
@@ -170,10 +171,9 @@ package body ZLib is
170 is 171 is
171 use Thin; 172 use Thin;
172 begin 173 begin
173 return Unsigned_32 (crc32 174 return Unsigned_32 (crc32 (ULong (CRC),
174 (ULong (CRC), 175 Data'Address,
175 Bytes.To_Pointer (Data'Address), 176 Data'Length));
176 Data'Length));
177 end CRC32; 177 end CRC32;
178 178
179 procedure CRC32 179 procedure CRC32
@@ -192,13 +192,17 @@ package body ZLib is
192 Level : in Compression_Level := Default_Compression; 192 Level : in Compression_Level := Default_Compression;
193 Strategy : in Strategy_Type := Default_Strategy; 193 Strategy : in Strategy_Type := Default_Strategy;
194 Method : in Compression_Method := Deflated; 194 Method : in Compression_Method := Deflated;
195 Window_Bits : in Window_Bits_Type := 15; 195 Window_Bits : in Window_Bits_Type := Default_Window_Bits;
196 Memory_Level : in Memory_Level_Type := 8; 196 Memory_Level : in Memory_Level_Type := Default_Memory_Level;
197 Header : in Header_Type := Default) 197 Header : in Header_Type := Default)
198 is 198 is
199 use type Thin.Int; 199 use type Thin.Int;
200 Win_Bits : Thin.Int := Thin.Int (Window_Bits); 200 Win_Bits : Thin.Int := Thin.Int (Window_Bits);
201 begin 201 begin
202 if Is_Open (Filter) then
203 raise Status_Error;
204 end if;
205
202 -- We allow ZLib to make header only in case of default header type. 206 -- We allow ZLib to make header only in case of default header type.
203 -- Otherwise we would either do header by ourselfs, or do not do 207 -- Otherwise we would either do header by ourselfs, or do not do
204 -- header at all. 208 -- header at all.
@@ -216,10 +220,9 @@ package body ZLib is
216 Filter.Offset := Simple_GZip_Header'Last + 1; 220 Filter.Offset := Simple_GZip_Header'Last + 1;
217 end if; 221 end if;
218 222
219 Filter.Strm := new Z_Stream; 223 Filter.Strm := new Z_Stream;
220 Filter.Compression := True; 224 Filter.Compression := True;
221 Filter.Stream_End := False; 225 Filter.Stream_End := False;
222 Filter.Opened := True;
223 Filter.Header := Header; 226 Filter.Header := Header;
224 227
225 if Thin.Deflate_Init 228 if Thin.Deflate_Init
@@ -255,18 +258,18 @@ package body ZLib is
255 ----------------------- 258 -----------------------
256 259
257 procedure Generic_Translate 260 procedure Generic_Translate
258 (Filter : in out ZLib.Filter_Type; 261 (Filter : in out ZLib.Filter_Type;
259 In_Buffer_Size : Integer := Default_Buffer_Size; 262 In_Buffer_Size : in Integer := Default_Buffer_Size;
260 Out_Buffer_Size : Integer := Default_Buffer_Size) 263 Out_Buffer_Size : in Integer := Default_Buffer_Size)
261 is 264 is
262 In_Buffer : Stream_Element_Array 265 In_Buffer : Stream_Element_Array
263 (1 .. Stream_Element_Offset (In_Buffer_Size)); 266 (1 .. Stream_Element_Offset (In_Buffer_Size));
264 Out_Buffer : Stream_Element_Array 267 Out_Buffer : Stream_Element_Array
265 (1 .. Stream_Element_Offset (Out_Buffer_Size)); 268 (1 .. Stream_Element_Offset (Out_Buffer_Size));
266 Last : Stream_Element_Offset; 269 Last : Stream_Element_Offset;
267 In_Last : Stream_Element_Offset; 270 In_Last : Stream_Element_Offset;
268 In_First : Stream_Element_Offset; 271 In_First : Stream_Element_Offset;
269 Out_Last : Stream_Element_Offset; 272 Out_Last : Stream_Element_Offset;
270 begin 273 begin
271 Main : loop 274 Main : loop
272 Data_In (In_Buffer, Last); 275 Data_In (In_Buffer, Last);
@@ -275,18 +278,21 @@ package body ZLib is
275 278
276 loop 279 loop
277 Translate 280 Translate
278 (Filter, 281 (Filter => Filter,
279 In_Buffer (In_First .. Last), 282 In_Data => In_Buffer (In_First .. Last),
280 In_Last, 283 In_Last => In_Last,
281 Out_Buffer, 284 Out_Data => Out_Buffer,
282 Out_Last, 285 Out_Last => Out_Last,
283 Flush_Finish (Last < In_Buffer'First)); 286 Flush => Flush_Finish (Last < In_Buffer'First));
284 287
285 Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last)); 288 if Out_Buffer'First <= Out_Last then
289 Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
290 end if;
286 291
287 exit Main when Stream_End (Filter); 292 exit Main when Stream_End (Filter);
288 293
289 -- The end of in buffer. 294 -- The end of in buffer.
295
290 exit when In_Last = Last; 296 exit when In_Last = Last;
291 297
292 In_First := In_Last + 1; 298 In_First := In_Last + 1;
@@ -301,7 +307,7 @@ package body ZLib is
301 307
302 procedure Inflate_Init 308 procedure Inflate_Init
303 (Filter : in out Filter_Type; 309 (Filter : in out Filter_Type;
304 Window_Bits : in Window_Bits_Type := 15; 310 Window_Bits : in Window_Bits_Type := Default_Window_Bits;
305 Header : in Header_Type := Default) 311 Header : in Header_Type := Default)
306 is 312 is
307 use type Thin.Int; 313 use type Thin.Int;
@@ -320,6 +326,10 @@ package body ZLib is
320 end Check_Version; 326 end Check_Version;
321 327
322 begin 328 begin
329 if Is_Open (Filter) then
330 raise Status_Error;
331 end if;
332
323 case Header is 333 case Header is
324 when None => 334 when None =>
325 Check_Version; 335 Check_Version;
@@ -344,10 +354,9 @@ package body ZLib is
344 when Default => null; 354 when Default => null;
345 end case; 355 end case;
346 356
347 Filter.Strm := new Z_Stream; 357 Filter.Strm := new Z_Stream;
348 Filter.Compression := False; 358 Filter.Compression := False;
349 Filter.Stream_End := False; 359 Filter.Stream_End := False;
350 Filter.Opened := True;
351 Filter.Header := Header; 360 Filter.Header := Header;
352 361
353 if Thin.Inflate_Init 362 if Thin.Inflate_Init
@@ -357,16 +366,25 @@ package body ZLib is
357 end if; 366 end if;
358 end Inflate_Init; 367 end Inflate_Init;
359 368
369 -------------
370 -- Is_Open --
371 -------------
372
373 function Is_Open (Filter : in Filter_Type) return Boolean is
374 begin
375 return Filter.Strm /= null;
376 end Is_Open;
377
360 ----------------- 378 -----------------
361 -- Raise_Error -- 379 -- Raise_Error --
362 ----------------- 380 -----------------
363 381
364 procedure Raise_Error (Message : String) is 382 procedure Raise_Error (Message : in String) is
365 begin 383 begin
366 Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message); 384 Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
367 end Raise_Error; 385 end Raise_Error;
368 386
369 procedure Raise_Error (Stream : Z_Stream) is 387 procedure Raise_Error (Stream : in Z_Stream) is
370 begin 388 begin
371 Raise_Error (Last_Error_Message (Stream)); 389 Raise_Error (Last_Error_Message (Stream));
372 end Raise_Error; 390 end Raise_Error;
@@ -378,21 +396,29 @@ package body ZLib is
378 procedure Read 396 procedure Read
379 (Filter : in out Filter_Type; 397 (Filter : in out Filter_Type;
380 Item : out Ada.Streams.Stream_Element_Array; 398 Item : out Ada.Streams.Stream_Element_Array;
381 Last : out Ada.Streams.Stream_Element_Offset) 399 Last : out Ada.Streams.Stream_Element_Offset;
400 Flush : in Flush_Mode := No_Flush)
382 is 401 is
383 In_Last : Stream_Element_Offset; 402 In_Last : Stream_Element_Offset;
384 Item_First : Ada.Streams.Stream_Element_Offset := Item'First; 403 Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
404 V_Flush : Flush_Mode := Flush;
385 405
386 begin 406 begin
387 pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1); 407 pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
408 pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
388 409
389 loop 410 loop
390 if Rest_First > Buffer'Last then 411 if Rest_Last = Buffer'First - 1 then
412 V_Flush := Finish;
413
414 elsif Rest_First > Rest_Last then
391 Read (Buffer, Rest_Last); 415 Read (Buffer, Rest_Last);
392 Rest_First := Buffer'First; 416 Rest_First := Buffer'First;
393 end if;
394 417
395 pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last); 418 if Rest_Last < Buffer'First then
419 V_Flush := Finish;
420 end if;
421 end if;
396 422
397 Translate 423 Translate
398 (Filter => Filter, 424 (Filter => Filter,
@@ -400,11 +426,13 @@ package body ZLib is
400 In_Last => In_Last, 426 In_Last => In_Last,
401 Out_Data => Item (Item_First .. Item'Last), 427 Out_Data => Item (Item_First .. Item'Last),
402 Out_Last => Last, 428 Out_Last => Last,
403 Flush => Flush_Finish (Rest_Last < Rest_First)); 429 Flush => V_Flush);
404 430
405 Rest_First := In_Last + 1; 431 Rest_First := In_Last + 1;
406 432
407 exit when Last = Item'Last or else Stream_End (Filter); 433 exit when Stream_End (Filter)
434 or else Last = Item'Last
435 or else (Last >= Item'First and then Allow_Read_Some);
408 436
409 Item_First := Last + 1; 437 Item_First := Last + 1;
410 end loop; 438 end loop;
@@ -489,11 +517,11 @@ package body ZLib is
489 Code : Thin.Int; 517 Code : Thin.Int;
490 518
491 begin 519 begin
492 if Filter.Opened = False then 520 if not Is_Open (Filter) then
493 raise ZLib_Error; 521 raise Status_Error;
494 end if; 522 end if;
495 523
496 if Out_Data'Length = 0 then 524 if Out_Data'Length = 0 and then In_Data'Length = 0 then
497 raise Constraint_Error; 525 raise Constraint_Error;
498 end if; 526 end if;
499 527
@@ -514,7 +542,6 @@ package body ZLib is
514 - Stream_Element_Offset (Avail_In (Filter.Strm.all)); 542 - Stream_Element_Offset (Avail_In (Filter.Strm.all));
515 Out_Last := Out_Data'Last 543 Out_Last := Out_Data'Last
516 - Stream_Element_Offset (Avail_Out (Filter.Strm.all)); 544 - Stream_Element_Offset (Avail_Out (Filter.Strm.all));
517
518 end Translate_Auto; 545 end Translate_Auto;
519 546
520 -------------------- 547 --------------------
@@ -529,7 +556,7 @@ package body ZLib is
529 Out_Last : out Ada.Streams.Stream_Element_Offset; 556 Out_Last : out Ada.Streams.Stream_Element_Offset;
530 Flush : in Flush_Mode) 557 Flush : in Flush_Mode)
531 is 558 is
532 Out_First : Stream_Element_Offset; 559 Out_First : Stream_Element_Offset;
533 560
534 procedure Add_Data (Data : in Stream_Element_Array); 561 procedure Add_Data (Data : in Stream_Element_Array);
535 -- Add data to stream from the Filter.Offset till necessary, 562 -- Add data to stream from the Filter.Offset till necessary,
@@ -596,7 +623,7 @@ package body ZLib is
596 Add_Data (Simple_GZip_Header); 623 Add_Data (Simple_GZip_Header);
597 624
598 Translate_Auto 625 Translate_Auto
599 (Filter => Filter, 626 (Filter => Filter,
600 In_Data => In_Data, 627 In_Data => In_Data,
601 In_Last => In_Last, 628 In_Last => In_Last,
602 Out_Data => Out_Data (Out_First .. Out_Data'Last), 629 Out_Data => Out_Data (Out_First .. Out_Data'Last),
@@ -604,7 +631,6 @@ package body ZLib is
604 Flush => Flush); 631 Flush => Flush);
605 632
606 CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last)); 633 CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
607
608 end if; 634 end if;
609 635
610 if Filter.Stream_End and then Out_Last <= Out_Data'Last then 636 if Filter.Stream_End and then Out_Last <= Out_Data'Last then
@@ -642,10 +668,11 @@ package body ZLib is
642 procedure Write 668 procedure Write
643 (Filter : in out Filter_Type; 669 (Filter : in out Filter_Type;
644 Item : in Ada.Streams.Stream_Element_Array; 670 Item : in Ada.Streams.Stream_Element_Array;
645 Flush : in Flush_Mode) 671 Flush : in Flush_Mode := No_Flush)
646 is 672 is
647 Buffer : Stream_Element_Array (1 .. Buffer_Size); 673 Buffer : Stream_Element_Array (1 .. Buffer_Size);
648 In_Last, Out_Last : Stream_Element_Offset; 674 In_Last : Stream_Element_Offset;
675 Out_Last : Stream_Element_Offset;
649 In_First : Stream_Element_Offset := Item'First; 676 In_First : Stream_Element_Offset := Item'First;
650 begin 677 begin
651 if Item'Length = 0 and Flush = No_Flush then 678 if Item'Length = 0 and Flush = No_Flush then
@@ -654,7 +681,7 @@ package body ZLib is
654 681
655 loop 682 loop
656 Translate 683 Translate
657 (Filter => Filter, 684 (Filter => Filter,
658 In_Data => Item (In_First .. Item'Last), 685 In_Data => Item (In_First .. Item'Last),
659 In_Last => In_Last, 686 In_Last => In_Last,
660 Out_Data => Buffer, 687 Out_Data => Buffer,
diff --git a/contrib/ada/zlib.ads b/contrib/ada/zlib.ads
index b72e4d2..79ffc40 100644
--- a/contrib/ada/zlib.ads
+++ b/contrib/ada/zlib.ads
@@ -1,7 +1,7 @@
1------------------------------------------------------------------------------ 1------------------------------------------------------------------------------
2-- ZLib for Ada thick binding. -- 2-- ZLib for Ada thick binding. --
3-- -- 3-- --
4-- Copyright (C) 2002-2003 Dmitriy Anisimkov -- 4-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
5-- -- 5-- --
6-- This library is free software; you can redistribute it and/or modify -- 6-- This library is free software; you can redistribute it and/or modify --
7-- it under the terms of the GNU General Public License as published by -- 7-- it under the terms of the GNU General Public License as published by --
@@ -25,7 +25,7 @@
25-- covered by the GNU Public License. -- 25-- covered by the GNU Public License. --
26------------------------------------------------------------------------------ 26------------------------------------------------------------------------------
27 27
28-- $Id: zlib.ads,v 1.17 2003/08/12 13:19:07 vagul Exp $ 28-- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $
29 29
30with Ada.Streams; 30with Ada.Streams;
31 31
@@ -33,7 +33,8 @@ with Interfaces;
33 33
34package ZLib is 34package ZLib is
35 35
36 ZLib_Error : exception; 36 ZLib_Error : exception;
37 Status_Error : exception;
37 38
38 type Compression_Level is new Integer range -1 .. 9; 39 type Compression_Level is new Integer range -1 .. 9;
39 40
@@ -55,12 +56,15 @@ package ZLib is
55 56
56 subtype Count is Ada.Streams.Stream_Element_Count; 57 subtype Count is Ada.Streams.Stream_Element_Count;
57 58
59 Default_Memory_Level : constant Memory_Level_Type := 8;
60 Default_Window_Bits : constant Window_Bits_Type := 15;
61
58 ---------------------------------- 62 ----------------------------------
59 -- Compression method constants -- 63 -- Compression method constants --
60 ---------------------------------- 64 ----------------------------------
61 65
62 Deflated : constant Compression_Method; 66 Deflated : constant Compression_Method;
63 -- Only one method allowed in this ZLib version. 67 -- Only one method allowed in this ZLib version
64 68
65 --------------------------------- 69 ---------------------------------
66 -- Compression level constants -- 70 -- Compression level constants --
@@ -79,21 +83,29 @@ package ZLib is
79 -- Regular way for compression, no flush 83 -- Regular way for compression, no flush
80 84
81 Partial_Flush : constant Flush_Mode; 85 Partial_Flush : constant Flush_Mode;
82 -- will be removed, use Z_SYNC_FLUSH instead 86 -- Will be removed, use Z_SYNC_FLUSH instead
83 87
84 Sync_Flush : constant Flush_Mode; 88 Sync_Flush : constant Flush_Mode;
85 -- all pending output is flushed to the output buffer and the output 89 -- All pending output is flushed to the output buffer and the output
86 -- is aligned on a byte boundary, so that the decompressor can get all 90 -- is aligned on a byte boundary, so that the decompressor can get all
87 -- input data available so far. (In particular avail_in is zero after the 91 -- input data available so far. (In particular avail_in is zero after the
88 -- call if enough output space has been provided before the call.) 92 -- call if enough output space has been provided before the call.)
89 -- Flushing may degrade compression for some compression algorithms and so 93 -- Flushing may degrade compression for some compression algorithms and so
90 -- it should be used only when necessary. 94 -- it should be used only when necessary.
91 95
96 Block_Flush : constant Flush_Mode;
97 -- Z_BLOCK requests that inflate() stop
98 -- if and when it get to the next deflate block boundary. When decoding the
99 -- zlib or gzip format, this will cause inflate() to return immediately
100 -- after the header and before the first block. When doing a raw inflate,
101 -- inflate() will go ahead and process the first block, and will return
102 -- when it gets to the end of that block, or when it runs out of data.
103
92 Full_Flush : constant Flush_Mode; 104 Full_Flush : constant Flush_Mode;
93 -- all output is flushed as with SYNC_FLUSH, and the compression state 105 -- All output is flushed as with SYNC_FLUSH, and the compression state
94 -- is reset so that decompression can restart from this point if previous 106 -- is reset so that decompression can restart from this point if previous
95 -- compressed data has been damaged or if random access is desired. Using 107 -- compressed data has been damaged or if random access is desired. Using
96 -- FULL_FLUSH too often can seriously degrade the compression. 108 -- Full_Flush too often can seriously degrade the compression.
97 109
98 Finish : constant Flush_Mode; 110 Finish : constant Flush_Mode;
99 -- Just for tell the compressor that input data is complete. 111 -- Just for tell the compressor that input data is complete.
@@ -111,7 +123,7 @@ package ZLib is
111 123
112 Default_Buffer_Size : constant := 4096; 124 Default_Buffer_Size : constant := 4096;
113 125
114 type Filter_Type is limited private; 126 type Filter_Type is tagged limited private;
115 -- The filter is for compression and for decompression. 127 -- The filter is for compression and for decompression.
116 -- The usage of the type is depend of its initialization. 128 -- The usage of the type is depend of its initialization.
117 129
@@ -124,8 +136,8 @@ package ZLib is
124 Level : in Compression_Level := Default_Compression; 136 Level : in Compression_Level := Default_Compression;
125 Strategy : in Strategy_Type := Default_Strategy; 137 Strategy : in Strategy_Type := Default_Strategy;
126 Method : in Compression_Method := Deflated; 138 Method : in Compression_Method := Deflated;
127 Window_Bits : in Window_Bits_Type := 15; 139 Window_Bits : in Window_Bits_Type := Default_Window_Bits;
128 Memory_Level : in Memory_Level_Type := 8; 140 Memory_Level : in Memory_Level_Type := Default_Memory_Level;
129 Header : in Header_Type := Default); 141 Header : in Header_Type := Default);
130 -- Compressor initialization. 142 -- Compressor initialization.
131 -- When Header parameter is Auto or Default, then default zlib header 143 -- When Header parameter is Auto or Default, then default zlib header
@@ -136,7 +148,7 @@ package ZLib is
136 148
137 procedure Inflate_Init 149 procedure Inflate_Init
138 (Filter : in out Filter_Type; 150 (Filter : in out Filter_Type;
139 Window_Bits : in Window_Bits_Type := 15; 151 Window_Bits : in Window_Bits_Type := Default_Window_Bits;
140 Header : in Header_Type := Default); 152 Header : in Header_Type := Default);
141 -- Decompressor initialization. 153 -- Decompressor initialization.
142 -- Default header type mean that ZLib default header is expecting in the 154 -- Default header type mean that ZLib default header is expecting in the
@@ -146,10 +158,14 @@ package ZLib is
146 -- input compressed stream. 158 -- input compressed stream.
147 -- Auto header type mean that header type (GZip or Native) would be 159 -- Auto header type mean that header type (GZip or Native) would be
148 -- detected automatically in the input stream. 160 -- detected automatically in the input stream.
149 -- Note that header types parameter values None, GZip and Auto is 161 -- Note that header types parameter values None, GZip and Auto are
150 -- supporting for inflate routine only in ZLib versions 1.2.0.2 and later. 162 -- supported for inflate routine only in ZLib versions 1.2.0.2 and later.
151 -- Deflate_Init is supporting all header types. 163 -- Deflate_Init is supporting all header types.
152 164
165 function Is_Open (Filter : in Filter_Type) return Boolean;
166 pragma Inline (Is_Open);
167 -- Is the filter opened for compression or decompression.
168
153 procedure Close 169 procedure Close
154 (Filter : in out Filter_Type; 170 (Filter : in out Filter_Type;
155 Ignore_Error : in Boolean := False); 171 Ignore_Error : in Boolean := False);
@@ -167,31 +183,31 @@ package ZLib is
167 (Filter : in out Filter_Type; 183 (Filter : in out Filter_Type;
168 In_Buffer_Size : in Integer := Default_Buffer_Size; 184 In_Buffer_Size : in Integer := Default_Buffer_Size;
169 Out_Buffer_Size : in Integer := Default_Buffer_Size); 185 Out_Buffer_Size : in Integer := Default_Buffer_Size);
170 -- Compressing/decompressing data arrived from Data_In routine 186 -- Compress/decompress data fetch from Data_In routine and pass the result
171 -- to the Data_Out routine. User should provide Data_In and Data_Out 187 -- to the Data_Out routine. User should provide Data_In and Data_Out
172 -- for compression/decompression data flow. 188 -- for compression/decompression data flow.
173 -- Compression or decompression depend on initialization of Filter. 189 -- Compression or decompression depend on Filter initialization.
174 190
175 function Total_In (Filter : in Filter_Type) return Count; 191 function Total_In (Filter : in Filter_Type) return Count;
176 pragma Inline (Total_In); 192 pragma Inline (Total_In);
177 -- Return total number of input bytes read so far. 193 -- Returns total number of input bytes read so far
178 194
179 function Total_Out (Filter : in Filter_Type) return Count; 195 function Total_Out (Filter : in Filter_Type) return Count;
180 pragma Inline (Total_Out); 196 pragma Inline (Total_Out);
181 -- Return total number of bytes output so far. 197 -- Returns total number of bytes output so far
182 198
183 function CRC32 199 function CRC32
184 (CRC : in Unsigned_32; 200 (CRC : in Unsigned_32;
185 Data : in Ada.Streams.Stream_Element_Array) 201 Data : in Ada.Streams.Stream_Element_Array)
186 return Unsigned_32; 202 return Unsigned_32;
187 pragma Inline (CRC32); 203 pragma Inline (CRC32);
188 -- Calculate CRC32, it could be necessary for make gzip format. 204 -- Compute CRC32, it could be necessary for make gzip format
189 205
190 procedure CRC32 206 procedure CRC32
191 (CRC : in out Unsigned_32; 207 (CRC : in out Unsigned_32;
192 Data : in Ada.Streams.Stream_Element_Array); 208 Data : in Ada.Streams.Stream_Element_Array);
193 pragma Inline (CRC32); 209 pragma Inline (CRC32);
194 -- Calculate CRC32, it could be necessary for make gzip format. 210 -- Compute CRC32, it could be necessary for make gzip format
195 211
196 ------------------------------------------------- 212 -------------------------------------------------
197 -- Below is more complex low level routines. -- 213 -- Below is more complex low level routines. --
@@ -204,15 +220,11 @@ package ZLib is
204 Out_Data : out Ada.Streams.Stream_Element_Array; 220 Out_Data : out Ada.Streams.Stream_Element_Array;
205 Out_Last : out Ada.Streams.Stream_Element_Offset; 221 Out_Last : out Ada.Streams.Stream_Element_Offset;
206 Flush : in Flush_Mode); 222 Flush : in Flush_Mode);
207 -- Compressing/decompressing the datas from In_Data buffer to the 223 -- Compress/decompress the In_Data buffer and place the result into
208 -- Out_Data buffer. 224 -- Out_Data. In_Last is the index of last element from In_Data accepted by
209 -- In_Data is incoming data portion, 225 -- the Filter. Out_Last is the last element of the received data from
210 -- In_Last is the index of last element from In_Data accepted by the 226 -- Filter. To tell the filter that incoming data are complete put the
211 -- Filter. 227 -- Flush parameter to Finish.
212 -- Out_Data is the buffer for output data from the filter.
213 -- Out_Last is the last element of the received data from Filter.
214 -- To tell the filter that incoming data is complete put the
215 -- Flush parameter to FINISH.
216 228
217 function Stream_End (Filter : in Filter_Type) return Boolean; 229 function Stream_End (Filter : in Filter_Type) return Boolean;
218 pragma Inline (Stream_End); 230 pragma Inline (Stream_End);
@@ -239,10 +251,9 @@ package ZLib is
239 procedure Write 251 procedure Write
240 (Filter : in out Filter_Type; 252 (Filter : in out Filter_Type;
241 Item : in Ada.Streams.Stream_Element_Array; 253 Item : in Ada.Streams.Stream_Element_Array;
242 Flush : in Flush_Mode); 254 Flush : in Flush_Mode := No_Flush);
243 -- Compressing/Decompressing data from Item to the 255 -- Compress/Decompress data from Item to the generic parameter procedure
244 -- generic parameter procedure Write. 256 -- Write. Output buffer size could be set in Buffer_Size generic parameter.
245 -- Output buffer size could be set in Buffer_Size generic parameter.
246 257
247 generic 258 generic
248 with procedure Read 259 with procedure Read
@@ -257,33 +268,41 @@ package ZLib is
257 268
258 Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset; 269 Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset;
259 -- Rest_First have to be initialized to Buffer'Last + 1 270 -- Rest_First have to be initialized to Buffer'Last + 1
271 -- Rest_Last have to be initialized to Buffer'Last
260 -- before usage. 272 -- before usage.
261 273
274 Allow_Read_Some : in Boolean := False;
275 -- Is it allowed to return Last < Item'Last before end of data.
276
262 procedure Read 277 procedure Read
263 (Filter : in out Filter_Type; 278 (Filter : in out Filter_Type;
264 Item : out Ada.Streams.Stream_Element_Array; 279 Item : out Ada.Streams.Stream_Element_Array;
265 Last : out Ada.Streams.Stream_Element_Offset); 280 Last : out Ada.Streams.Stream_Element_Offset;
266 -- Compressing/Decompressing data from generic parameter 281 Flush : in Flush_Mode := No_Flush);
267 -- procedure Read to the Item. 282 -- Compress/Decompress data from generic parameter procedure Read to the
268 -- User should provide Buffer for the operation 283 -- Item. User should provide Buffer and initialized Rest_First, Rest_Last
269 -- and Rest_First variable first time initialized to the Buffer'Last + 1. 284 -- indicators. If Allow_Read_Some is True, Read routines could return
285 -- Last < Item'Last only at end of stream.
270 286
271private 287private
272 288
273 use Ada.Streams; 289 use Ada.Streams;
274 290
275 type Flush_Mode is new Integer range 0 .. 4; 291 pragma Assert (Ada.Streams.Stream_Element'Size = 8);
292 pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8);
293
294 type Flush_Mode is new Integer range 0 .. 5;
276 295
277 type Compression_Method is new Integer range 8 .. 8; 296 type Compression_Method is new Integer range 8 .. 8;
278 297
279 type Strategy_Type is new Integer range 0 .. 3; 298 type Strategy_Type is new Integer range 0 .. 3;
280 299
281 No_Flush : constant Flush_Mode := 0; 300 No_Flush : constant Flush_Mode := 0;
301 Partial_Flush : constant Flush_Mode := 1;
282 Sync_Flush : constant Flush_Mode := 2; 302 Sync_Flush : constant Flush_Mode := 2;
283 Full_Flush : constant Flush_Mode := 3; 303 Full_Flush : constant Flush_Mode := 3;
284 Finish : constant Flush_Mode := 4; 304 Finish : constant Flush_Mode := 4;
285 Partial_Flush : constant Flush_Mode := 1; 305 Block_Flush : constant Flush_Mode := 5;
286 -- will be removed, use Z_SYNC_FLUSH instead
287 306
288 Filtered : constant Strategy_Type := 1; 307 Filtered : constant Strategy_Type := 1;
289 Huffman_Only : constant Strategy_Type := 2; 308 Huffman_Only : constant Strategy_Type := 2;
@@ -296,7 +315,7 @@ private
296 315
297 type Z_Stream_Access is access all Z_Stream; 316 type Z_Stream_Access is access all Z_Stream;
298 317
299 type Filter_Type is record 318 type Filter_Type is tagged limited record
300 Strm : Z_Stream_Access; 319 Strm : Z_Stream_Access;
301 Compression : Boolean; 320 Compression : Boolean;
302 Stream_End : Boolean; 321 Stream_End : Boolean;
@@ -304,8 +323,6 @@ private
304 CRC : Unsigned_32; 323 CRC : Unsigned_32;
305 Offset : Stream_Element_Offset; 324 Offset : Stream_Element_Offset;
306 -- Offset for gzip header/footer output. 325 -- Offset for gzip header/footer output.
307
308 Opened : Boolean := False;
309 end record; 326 end record;
310 327
311end ZLib; 328end ZLib;
diff --git a/contrib/ada/zlib.gpr b/contrib/ada/zlib.gpr
index 0f58985..88f51cc 100644
--- a/contrib/ada/zlib.gpr
+++ b/contrib/ada/zlib.gpr
@@ -1,21 +1,21 @@
1project Zlib is 1project Zlib is
2 2
3 for Languages use ("Ada"); 3 for Languages use ("Ada");
4 for Source_Dirs use ("."); 4 for Source_Dirs use (".");
5 for Object_Dir use "."; 5 for Object_Dir use ".";
6 for Main use ("test.adb", "mtest.adb", "read.adb"); 6 for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");
7 7
8 package Compiler is 8 package Compiler is
9 for Default_Switches ("ada") use ("-gnatwbcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst"); 9 for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
10 end Compiler; 10 end Compiler;
11 11
12 package Linker is 12 package Linker is
13 for Default_Switches ("ada") use ("-lz"); 13 for Default_Switches ("ada") use ("-lz");
14 end Linker; 14 end Linker;
15 15
16 package Builder is 16 package Builder is
17 for Default_Switches ("ada") use ("-s", "-gnatQ"); 17 for Default_Switches ("ada") use ("-s", "-gnatQ");
18 end Builder; 18 end Builder;
19 19
20end Zlib; 20end Zlib;
21 21