diff options
Diffstat (limited to 'contrib/ada/zlib.adb')
-rw-r--r-- | contrib/ada/zlib.adb | 143 |
1 files changed, 85 insertions, 58 deletions
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 | ||
11 | with Ada.Exceptions; | 11 | with Ada.Exceptions; |
12 | with Ada.Unchecked_Conversion; | 12 | with 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, |