← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to examples/zlibwrap/zlib/contrib/ada/zlib.adb

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

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