1. with Zip.CRC, UnZip.Decompress.Huffman, BZip2; 
  2. with Ada.Text_IO, Interfaces; 
  3. with Ada.Streams.Stream_IO; 
  4.  
  5. package body UnZip.Decompress is 
  6.  
  7.    procedure Decompress_data ( 
  8.                               zip_file             : Zip_Streams.Zipstream_Class; 
  9.                               format               : PKZip_method; 
  10.                               mode                 : Write_mode; 
  11.                               output_file_name     : String; 
  12.                               output_memory_access : out p_Stream_Element_Array; 
  13.                               feedback             : Zip.Feedback_proc; 
  14.                               explode_literal_tree : Boolean; 
  15.                               explode_slide_8KB    : Boolean; 
  16.                               end_data_descriptor  : Boolean; 
  17.                               encrypted            : Boolean; 
  18.                               password             : in out Unbounded_String; 
  19.                               get_new_password     : Get_password_proc; 
  20.                               hint                 : in out Zip.Headers.Data_descriptor 
  21.                              ) 
  22.    is 
  23.       -- Disable AdaControl rule for detecting global variables, 
  24.       -- they have become local here. 
  25.       --## RULE OFF Directly_Accessed_Globals 
  26.       -- 
  27.       -- I/O Buffers sizes 
  28.       --  Size of input buffer 
  29.       inbuf_size : constant := 16#8000#;  -- (orig : 16#1000# B =  4 KB) 
  30.       --  Size of sliding dictionary and output buffer 
  31.       wsize      : constant := 16#10000#; -- (orig : 16#8000# B = 32 KB) 
  32.  
  33.       -------------------------------------- 
  34.       -- Specifications of UnZ_* packages -- 
  35.       -------------------------------------- 
  36.       use Interfaces; 
  37.  
  38.       package UnZ_Glob is 
  39.          -- I/O Buffers 
  40.          -- > Sliding dictionary for unzipping, and output buffer as well 
  41.          slide : Zip.Byte_Buffer (0 .. wsize); 
  42.          slide_index : Integer := 0; -- Current Position in slide 
  43.          -- > Input buffer 
  44.          inbuf : Zip.Byte_Buffer (0 .. inbuf_size - 1); 
  45.          inpos, readpos : Integer;  -- pos. in input buffer, pos. read from file 
  46.          compsize,            -- compressed size of file 
  47.          reachedsize,         -- number of bytes read from zipfile 
  48.          uncompsize,          -- uncompressed size of file 
  49.          effective_writes  :   -- count of effective bytes written (for feedback) 
  50.          UnZip.File_size_type; 
  51.          crc32val  : Unsigned_32;  -- crc calculated from data 
  52.          Zip_EOF   : Boolean;      -- read over end of zip section for this file 
  53.          uncompressed_index   : Ada.Streams.Stream_Element_Offset; 
  54.       end UnZ_Glob; 
  55.  
  56.       package UnZ_IO is 
  57.          out_bin_file : Ada.Streams.Stream_IO.File_Type; 
  58.          out_txt_file : Ada.Text_IO.File_Type; 
  59.          last_char    : Character := ' '; 
  60.  
  61.          procedure Init_Buffers; 
  62.  
  63.          package Decryption is 
  64.             procedure Set_mode (crypted : Boolean); 
  65.             function Get_mode return Boolean; 
  66.             procedure Init (passwrd : String; crc_check : Unsigned_32); 
  67.             procedure Decode (b : in out Unsigned_8); 
  68.             pragma Inline (Decode); 
  69.          end Decryption; 
  70.  
  71.          procedure Read_raw_byte (bt  : out Unsigned_8); 
  72.          pragma Inline (Read_raw_byte); 
  73.  
  74.          package Bit_buffer is 
  75.             procedure Init; 
  76.             -- Read at least n bits into the bit buffer, returns the n first bits 
  77.             function Read (n : Natural) return Integer; 
  78.             pragma Inline (Read); 
  79.             function Read_U32 (n : Natural) return Unsigned_32; 
  80.             pragma Inline (Read_U32); 
  81.             -- Inverts (NOT operator) the result before masking by n bits 
  82.             function Read_inverted (n : Natural) return Integer; 
  83.             pragma Inline (Read_inverted); 
  84.             -- Dump n bits no longer needed from the bit buffer 
  85.             procedure Dump (n : Natural); 
  86.             pragma Inline (Dump); 
  87.             procedure Dump_to_byte_boundary; 
  88.             function Read_and_dump (n : Natural) return Integer; 
  89.             pragma Inline (Read_and_dump); 
  90.             function Read_and_dump_U32 (n : Natural) return Unsigned_32; 
  91.             pragma Inline (Read_and_dump_U32); 
  92.          end Bit_buffer; 
  93.  
  94.          procedure Flush (x : Natural); -- directly from slide to output stream 
  95.  
  96.          procedure Flush_if_full (W : in out Integer; unflushed : in out Boolean); 
  97.          pragma Inline (Flush_if_full); 
  98.  
  99.          procedure Flush_if_full (W : in out Integer); 
  100.          pragma Inline (Flush_if_full); 
  101.  
  102.          procedure Copy (distance, copy_length :        Natural; 
  103.                          index                 : in out Natural); 
  104.          pragma Inline (Copy); 
  105.  
  106.          procedure Copy_or_zero (distance, copy_length :        Natural; 
  107.                                  index                 : in out Natural; 
  108.                                  unflushed             : in out Boolean); 
  109.          pragma Inline (Copy_or_zero); 
  110.  
  111.          procedure Delete_output; -- an error has occured (bad compressed data) 
  112.  
  113.       end UnZ_IO; 
  114.  
  115.       package UnZ_Meth is 
  116.          procedure Copy_stored; 
  117.          procedure Unshrink; 
  118.          subtype Reduction_factor is Integer range 1 .. 4; 
  119.          procedure Unreduce (factor : Reduction_factor); 
  120.          procedure Explode (literal_tree, slide_8_KB : Boolean); 
  121.          deflate_e_mode : Boolean := False; 
  122.          procedure Inflate; 
  123.          procedure Bunzip2; -- Nov - 2009 
  124.       end UnZ_Meth; 
  125.  
  126.       ------------------------------ 
  127.       -- Bodies of UnZ_* packages -- 
  128.       ------------------------------ 
  129.       package body UnZ_IO is 
  130.  
  131.          -- Centralize buffer initialisations - 29 - Jun - 2001 
  132.  
  133.          procedure Init_Buffers is 
  134.          begin 
  135.             UnZ_Glob.inpos   :=  0;  -- Input buffer position 
  136.             UnZ_Glob.readpos := -1;  -- Nothing read 
  137.             UnZ_Glob.slide_index := 0; 
  138.             UnZ_Glob.reachedsize      := 0; 
  139.             UnZ_Glob.effective_writes := 0; 
  140.             UnZ_Glob.Zip_EOF := False; 
  141.             Zip.CRC.Init (UnZ_Glob.crc32val); 
  142.             Bit_buffer.Init; 
  143.          end Init_Buffers; 
  144.  
  145.          procedure Read_buffer is 
  146.          begin 
  147.             if full_trace then 
  148.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  149.                Ada.Text_IO.Put ("[Read_buffer .. ."); 
  150.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  151.             end if; 
  152.             if UnZ_Glob.reachedsize > UnZ_Glob.compsize + 2 then 
  153.                -- + 2 : last code is smaller than requested! 
  154.                UnZ_Glob.readpos := UnZ_Glob.inbuf'Length; 
  155.                -- Simulates reading - > no blocking 
  156.                UnZ_Glob.Zip_EOF := True; 
  157.             else 
  158.                begin 
  159.                   Zip.BlockRead ( 
  160.                                  stream        => zip_file, 
  161.                                  buffer        => UnZ_Glob.inbuf, 
  162.                                  actually_read => UnZ_Glob.readpos 
  163.                                 ); 
  164.                exception 
  165.                   when others => -- I/O error 
  166.                      UnZ_Glob.readpos := UnZ_Glob.inbuf'Length; 
  167.                      -- Simulates reading - > CRC error 
  168.                      UnZ_Glob.Zip_EOF := True; 
  169.                end; 
  170.                if UnZ_Glob.readpos = 0 then 
  171.                   UnZ_Glob.readpos := UnZ_Glob.inbuf'Length; 
  172.                   -- Simulates reading - > CRC error 
  173.                   UnZ_Glob.Zip_EOF := True; 
  174.                end if; 
  175.  
  176.                UnZ_Glob.reachedsize := 
  177.                  UnZ_Glob.reachedsize + UnZip.File_size_type (UnZ_Glob.readpos); 
  178.                UnZ_Glob.readpos := UnZ_Glob.readpos - 1; 
  179.                -- Reason : index of inbuf starts at 0 
  180.             end if; 
  181.             UnZ_Glob.inpos := 0; 
  182.             if full_trace then 
  183.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  184.                Ada.Text_IO.Put_Line ("finished]"); 
  185.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  186.             end if; 
  187.          end Read_buffer; 
  188.  
  189.          procedure Read_byte_no_decrypt (bt  : out Zip.Byte) is 
  190.             pragma Inline (Read_byte_no_decrypt); 
  191.          begin 
  192.             if UnZ_Glob.inpos > UnZ_Glob.readpos then 
  193.                Read_buffer; 
  194.             end if; 
  195.             bt := UnZ_Glob.inbuf (UnZ_Glob.inpos); 
  196.             UnZ_Glob.inpos := UnZ_Glob.inpos + 1; 
  197.          end Read_byte_no_decrypt; 
  198.  
  199.          -- 27 - Jun - 2001 : Decryption - algorithm in Appnote.txt 
  200.  
  201.          package body Decryption is 
  202.  
  203.             type Decrypt_keys is array (0 .. 2) of Unsigned_32; 
  204.             the_keys      : Decrypt_keys; 
  205.             decrypt_mode  : Boolean; 
  206.  
  207.             procedure Set_mode (crypted : Boolean) is 
  208.             begin 
  209.                decrypt_mode := crypted; 
  210.             end Set_mode; 
  211.  
  212.             function Get_mode return Boolean is 
  213.             begin 
  214.                return decrypt_mode; 
  215.             end Get_mode; 
  216.  
  217.             procedure Update_keys (by : Zip.Byte; keys : in out Decrypt_keys) is 
  218.             begin 
  219.                Zip.CRC.Update (keys (0), (0 => by)); 
  220.                keys (1) := keys (1) + (keys (0) and 16#000000ff#); 
  221.                keys (1) := keys (1) * 134775813 + 1; 
  222.                Zip.CRC.Update ( 
  223.                                keys (2), 
  224.                                (0 => Zip.Byte (Shift_Right (keys (1), 24))) 
  225.                               ); 
  226.             end Update_keys; 
  227.  
  228.             function Decrypt_byte (Key_2 : Unsigned_32) return Zip.Byte is 
  229.                temp : Unsigned_32; 
  230.             begin 
  231.                temp := (Key_2 and 16#ffff#) or 2; 
  232.                temp := temp * (16#ffff# and (temp xor 1)); 
  233.                return Zip.Byte (Shift_Right (temp, 8) and 16#ff#); 
  234.             end Decrypt_byte; 
  235.  
  236.             procedure Init (passwrd : String; crc_check : Unsigned_32) is 
  237.                buffer : array (0 .. 11) of Zip.Byte; 
  238.                c : Zip.Byte; 
  239.             begin 
  240.                -- Step 1 - Initializing the encryption keys 
  241.  
  242.                the_keys := ( 
  243.                             0 => 305419896, 
  244.                             1 => 591751049, 
  245.                             2 => 878082192 
  246.                            ); 
  247.  
  248.                for i in passwrd'Range loop 
  249.                   Update_keys (Zip.Byte (Character'Pos (passwrd (i))), the_keys); 
  250.                end loop; 
  251.  
  252.                -- Step 2 - Decrypting the encryption header 
  253.  
  254.                for i in buffer'Range loop 
  255.                   Read_byte_no_decrypt (c); 
  256.                   c := c xor Decrypt_byte (the_keys (2)); 
  257.                   Update_keys (c, the_keys); 
  258.                   buffer (i) := c; 
  259.                end loop; 
  260.  
  261.                if buffer (buffer'Last) /= 
  262.                  Zip.Byte (Shift_Right (crc_check, 24)) 
  263.                then 
  264.                   raise UnZip.Wrong_password; 
  265.                end if; 
  266.  
  267.             end Init; 
  268.  
  269.             procedure Decode (b : in out Zip.Byte) is 
  270.             begin 
  271.                if decrypt_mode then 
  272.                   b := b xor Decrypt_byte (the_keys (2)); 
  273.                   Update_keys (b, the_keys); 
  274.                end if; 
  275.             end Decode; 
  276.  
  277.          end Decryption; 
  278.  
  279.          procedure Read_raw_byte (bt  : out Zip.Byte) is 
  280.          begin 
  281.             Read_byte_no_decrypt (bt); 
  282.             Decryption.Decode (bt); 
  283.          end Read_raw_byte; 
  284.  
  285.          package body Bit_buffer is 
  286.             B  : Unsigned_32; 
  287.             K  : Integer; 
  288.  
  289.             procedure Init is 
  290.             begin 
  291.                B := 0; 
  292.                K := 0; 
  293.             end Init; 
  294.  
  295.             procedure Need (n  : Natural) is 
  296.                pragma Inline (Need); 
  297.                bt : Zip.Byte; 
  298.             begin 
  299.                while K < n loop 
  300.                   Read_raw_byte (bt); 
  301.                   B := B or Shift_Left (Unsigned_32 (bt), K); 
  302.                   K := K + 8; 
  303.                end loop; 
  304.             end Need; 
  305.  
  306.             procedure Dump (n  : Natural) is 
  307.             begin 
  308.                B := Shift_Right (B, n); 
  309.                K := K - n; 
  310.             end Dump; 
  311.  
  312.             procedure Dump_to_byte_boundary is 
  313.             begin 
  314.                Dump (K mod 8); 
  315.             end Dump_to_byte_boundary; 
  316.  
  317.             function Read_U32 (n : Natural) return Unsigned_32 is 
  318.             begin 
  319.                Need (n); 
  320.                return B and (Shift_Left (1, n) - 1); 
  321.             end Read_U32; 
  322.  
  323.             function Read_inverted (n : Natural) return Integer is 
  324.             begin 
  325.                Need (n); 
  326.                return Integer ((not B) and (Shift_Left (1, n) - 1)); 
  327.             end Read_inverted; 
  328.  
  329.             function Read (n : Natural) return Integer is 
  330.             begin 
  331.                return Integer (Read_U32 (n)); 
  332.             end Read; 
  333.  
  334.             function Read_and_dump (n : Natural) return Integer is 
  335.                res : Integer; 
  336.             begin 
  337.                res := Read (n); 
  338.                Dump (n); 
  339.                return res; 
  340.             end Read_and_dump; 
  341.  
  342.             function Read_and_dump_U32 (n : Natural) return Unsigned_32 is 
  343.                res : Unsigned_32; 
  344.             begin 
  345.                res := Read_U32 (n); 
  346.                Dump (n); 
  347.                return res; 
  348.             end Read_and_dump_U32; 
  349.  
  350.          end Bit_buffer; 
  351.  
  352.          procedure Flush (x : Natural) is 
  353.             use Zip, UnZip, Ada.Streams; 
  354.             user_aborting : Boolean; 
  355.          begin 
  356.             if full_trace then 
  357.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  358.                Ada.Text_IO.Put ("[Flush .. ."); 
  359.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  360.             end if; 
  361.             begin 
  362.                case mode is 
  363.                when write_to_binary_file => 
  364.                   BlockWrite (Ada.Streams.Stream_IO.Stream (out_bin_file).all, UnZ_Glob.slide (0 .. x - 1)); 
  365.                when write_to_text_file => 
  366.                   Zip.Write_as_text ( 
  367.                                      UnZ_IO.out_txt_file, UnZ_Glob.slide (0 .. x - 1), UnZ_IO.last_char 
  368.                                     ); 
  369.                when write_to_memory => 
  370.                   for i in 0 .. x - 1 loop 
  371.                      output_memory_access.all (UnZ_Glob.uncompressed_index) := 
  372.                        Ada.Streams.Stream_Element (UnZ_Glob.slide (i)); 
  373.                      UnZ_Glob.uncompressed_index := UnZ_Glob.uncompressed_index + 1; 
  374.                   end loop; 
  375.                when just_test => 
  376.                   null; 
  377.                end case; 
  378.             exception 
  379.                when others => 
  380.                   raise UnZip.Write_Error; 
  381.             end; 
  382.             Zip.CRC.Update (UnZ_Glob.crc32val, UnZ_Glob.slide (0 .. x - 1)); 
  383.             if feedback /= null then -- inform user 
  384.                UnZ_Glob.effective_writes := 
  385.                  UnZ_Glob.effective_writes + File_size_type (x); 
  386.                if UnZ_Glob.uncompsize > 0 then 
  387.                   feedback.all ( 
  388.                                 percents_done => Natural ( 
  389.                                                           (100.0 * Float (UnZ_Glob.effective_writes)) / 
  390.                                                             Float (UnZ_Glob.uncompsize)), 
  391.                                 entry_skipped => False, 
  392.                                 user_abort    => user_aborting); 
  393.                   if user_aborting then 
  394.                      raise User_abort; 
  395.                   end if; 
  396.                end if; 
  397.             end if; 
  398.             if full_trace then 
  399.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  400.                Ada.Text_IO.Put_Line ("finished]"); 
  401.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  402.             end if; 
  403.          end Flush; 
  404.  
  405.          procedure Flush_if_full (W : in out Integer; unflushed : in out Boolean) is 
  406.          begin 
  407.             if W = wsize then 
  408.                Flush (wsize); 
  409.                W := 0; 
  410.                unflushed := False; 
  411.             end if; 
  412.          end Flush_if_full; 
  413.  
  414.          procedure Flush_if_full (W : in out Integer) is 
  415.          begin 
  416.             if W = wsize then 
  417.                Flush (wsize); 
  418.                W := 0; 
  419.             end if; 
  420.          end Flush_if_full; 
  421.  
  422.          ---------------------------------------------------- 
  423.          -- Reproduction of sequences in the output slide. -- 
  424.          ---------------------------------------------------- 
  425.  
  426.          -- Internal: 
  427.  
  428.          procedure Adjust_to_Slide ( 
  429.                                     source          : in out Integer; 
  430.                                     remain          : in out Natural; 
  431.                                     part            :    out Integer; 
  432.                                     index :                  Integer) 
  433.          is 
  434.             pragma Inline (Adjust_to_Slide); 
  435.          begin 
  436.             source := source mod wsize; 
  437.             -- source and index are now in 0 .. WSize - 1 
  438.             if  source > index then 
  439.                part := wsize - source; 
  440.             else 
  441.                part := wsize - index; 
  442.             end if; 
  443.             -- NB : part is in 1 .. WSize (part cannot be 0) 
  444.             if part > remain then 
  445.                part := remain; 
  446.             end if; 
  447.             -- Now part <= remain 
  448.             remain := remain - part; 
  449.             -- NB : remain cannot be < 0 
  450.          end Adjust_to_Slide; 
  451.  
  452.          procedure Copy_range (source, index : in out Natural; amount : Positive) is 
  453.             pragma Inline (Copy_range); 
  454.          begin 
  455.             if full_trace then 
  456.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  457.                Ada.Text_IO.Put ( 
  458.                                 " (Copy_range : source=" & Integer'Image (source) & 
  459.                                   " index=" & Integer'Image (index) & 
  460.                                   " amount=" & Integer'Image (amount)); 
  461.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  462.             end if; 
  463.             if abs (index - source) < amount then 
  464.                if full_trace and then source < index then 
  465.                   pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  466.                   Ada.Text_IO.Put ( 
  467.                                    "; replicates" & 
  468.                                      Integer'Image (amount) & " /" & Integer'Image (index - source) & 
  469.                                      ")" 
  470.                                   ); 
  471.                   -- . .. times the range source .. index - 1 
  472.                   pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  473.                end if; 
  474.                -- if source >= index, the effect of copy is 
  475.                -- just like the non - overlapping case 
  476.                for count in reverse 1 .. amount loop 
  477.                   UnZ_Glob.slide (index) := UnZ_Glob.slide (source); 
  478.                   index := index  + 1; 
  479.                   source := source + 1; 
  480.                end loop; 
  481.             else -- non - overlapping - > copy slice 
  482.                UnZ_Glob.slide (index .. index + amount - 1) := 
  483.                  UnZ_Glob.slide (source .. source + amount - 1); 
  484.                index := index  + amount; 
  485.                source := source + amount; 
  486.             end if; 
  487.             if full_trace then 
  488.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  489.                Ada.Text_IO.Put (')'); 
  490.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  491.             end if; 
  492.          end Copy_range; 
  493.  
  494.          -- The copying routines: 
  495.  
  496.          procedure Copy ( 
  497.                          distance, copy_length :        Natural; 
  498.                          index            : in out Natural) 
  499.          is 
  500.             source, part, remain : Integer; 
  501.          begin 
  502.             if full_trace or else (some_trace and then distance > 32768 + 3) then 
  503.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  504.                Ada.Text_IO.Put ( 
  505.                                 "DLE (distance=" & Integer'Image (distance) & 
  506.                                   " length=" & Integer'Image (copy_length) & ")" 
  507.                                ); 
  508.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  509.             end if; 
  510.             source := index - distance; 
  511.             remain := copy_length; 
  512.             loop 
  513.                Adjust_to_Slide (source, remain, part, index); 
  514.                Copy_range (source, index, part); 
  515.                Flush_if_full (index); 
  516.                exit when remain = 0; 
  517.             end loop; 
  518.          end Copy; 
  519.  
  520.          procedure Copy_or_zero ( 
  521.                                  distance, copy_length :        Natural; 
  522.                                  index            : in out Natural; 
  523.                                  unflushed        : in out Boolean) 
  524.          is 
  525.             source, part, remain : Integer; 
  526.          begin 
  527.             source := index - distance; 
  528.             remain := copy_length; 
  529.             loop 
  530.                Adjust_to_Slide (source, remain, part, index); 
  531.                if unflushed and then index <= source then 
  532.                   UnZ_Glob.slide (index .. index + part - 1) := (others => 0); 
  533.                   index := index  + part; 
  534.                   source := source + part; 
  535.                else 
  536.                   Copy_range (source, index, part); 
  537.                end if; 
  538.                Flush_if_full (index, unflushed); 
  539.                exit when remain = 0; 
  540.             end loop; 
  541.          end Copy_or_zero; 
  542.  
  543.          procedure Delete_output is -- an error has occured (bad compressed data) 
  544.          begin 
  545.             if no_trace then -- if there is a trace, we are debugging 
  546.                case mode is   --  and want to keep the malformed file 
  547.                when write_to_binary_file => 
  548.                   Ada.Streams.Stream_IO.Delete (UnZ_IO.out_bin_file); 
  549.                when write_to_text_file => 
  550.                   Ada.Text_IO.Delete (UnZ_IO.out_txt_file); 
  551.                when others => 
  552.                   null; 
  553.                end case; 
  554.             end if; 
  555.          end Delete_output; 
  556.  
  557.       end UnZ_IO; 
  558.  
  559.       package body UnZ_Meth is 
  560.  
  561.          --------[ Method : Unshrink ] -------- 
  562.  
  563.          -- Original in Pascal written by Christian Ghisler. 
  564.  
  565.          Max_Code   : constant := 8192; 
  566.          Max_Stack  : constant := 8192; 
  567.          Initial_Code_Size  : constant := 9; 
  568.          Maximum_Code_Size  : constant := 13; 
  569.          First_Entry        : constant := 257; 
  570.  
  571.          -- Rest of slide=write buffer =766 bytes 
  572.  
  573.          Write_Max  : constant := wsize - 3 * (Max_Code - 256) - Max_Stack - 2; 
  574.  
  575.          Previous_Code : array (First_Entry .. Max_Code) of Integer; 
  576.          Actual_Code   : array (First_Entry .. Max_Code) of Zip.Byte; 
  577.  
  578.          Next_Free  : Integer;      -- Next free code in trie 
  579.          Write_Ptr  : Integer;      -- Pointer to output buffer 
  580.  
  581.          Writebuf  : Zip.Byte_Buffer (0 .. Write_Max);  -- Write buffer 
  582.  
  583.          procedure Unshrink_Flush is 
  584.             use Zip, UnZip, Ada.Streams, Ada.Streams.Stream_IO; 
  585.             user_aborting : Boolean; 
  586.          begin 
  587.             if full_trace then 
  588.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  589.                Ada.Text_IO.Put ("[Unshrink_Flush]"); 
  590.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  591.             end if; 
  592.             begin 
  593.                case mode is 
  594.                when write_to_binary_file => 
  595.                   BlockWrite (Stream (UnZ_IO.out_bin_file).all, Writebuf (0 .. Write_Ptr - 1)); 
  596.                when write_to_text_file => 
  597.                   Zip.Write_as_text (UnZ_IO.out_txt_file, Writebuf (0 .. Write_Ptr - 1), UnZ_IO.last_char); 
  598.                when write_to_memory => 
  599.                   for I in 0 .. Write_Ptr - 1 loop 
  600.                      output_memory_access.all (UnZ_Glob.uncompressed_index) := 
  601.                        Stream_Element (Writebuf (I)); 
  602.                      UnZ_Glob.uncompressed_index :=  UnZ_Glob.uncompressed_index + 1; 
  603.                   end loop; 
  604.                when just_test => 
  605.                   null; 
  606.                end case; 
  607.             exception 
  608.                when others => 
  609.                   raise UnZip.Write_Error; 
  610.             end; 
  611.             Zip.CRC.Update (UnZ_Glob.crc32val, Writebuf (0 .. Write_Ptr - 1)); 
  612.             if feedback /= null then -- inform user 
  613.                UnZ_Glob.effective_writes := 
  614.                  UnZ_Glob.effective_writes + File_size_type (Write_Ptr); 
  615.                feedback.all ( 
  616.                              percents_done => Natural ( 
  617.                                                        (100.0 * Float (UnZ_Glob.effective_writes)) / 
  618.                                                          Float (UnZ_Glob.uncompsize) 
  619.                                                       ), 
  620.                              entry_skipped => False, 
  621.                              user_abort    => user_aborting); 
  622.                if user_aborting then 
  623.                   raise User_abort; 
  624.                end if; 
  625.             end if; 
  626.          end Unshrink_Flush; 
  627.  
  628.          procedure Write_Byte (B : Zip.Byte) is 
  629.          begin 
  630.             Writebuf (Write_Ptr) := B; 
  631.             Write_Ptr := Write_Ptr + 1; 
  632.             if Write_Ptr > Write_Max then 
  633.                Unshrink_Flush; 
  634.                Write_Ptr := 0; 
  635.             end if; 
  636.          end Write_Byte; 
  637.  
  638.          procedure Clear_Leaf_Nodes is 
  639.             Pc            : Integer;  -- previous code 
  640.             Act_Max_Code  : Integer;  -- max code to be searched for leaf nodes 
  641.  
  642.          begin 
  643.             Act_Max_Code := Next_Free - 1; 
  644.             for I in First_Entry .. Act_Max_Code loop 
  645.                Previous_Code (I) := 
  646.                  Integer (Unsigned_32 (Previous_Code (I)) or 16#8000#); 
  647.             end loop; 
  648.  
  649.             for I in First_Entry .. Act_Max_Code loop 
  650.                Pc := Previous_Code (I) mod 16#8000#; 
  651.                if  Pc > 256 then 
  652.                   Previous_Code (Pc) := Previous_Code (Pc) mod 16#8000#; 
  653.                end if; 
  654.             end loop; 
  655.  
  656.             -- Build new free list 
  657.             Pc := -1; 
  658.             Next_Free := -1; 
  659.             for I in First_Entry .. Act_Max_Code loop 
  660.                -- Either free before or marked now 
  661.                if (Unsigned_32 (Previous_Code (I)) and 16#C000#)  /= 0 then 
  662.                   -- Link last item to this item 
  663.                   if Pc = -1 then 
  664.                      Next_Free := I; 
  665.                   else 
  666.                      Previous_Code (Pc) := -I; 
  667.                   end if; 
  668.                   Pc := I; 
  669.                end if; 
  670.             end loop; 
  671.  
  672.             if Pc /= -1 then 
  673.                Previous_Code (Pc) := -Act_Max_Code - 1; 
  674.             end if; 
  675.  
  676.          end Clear_Leaf_Nodes; 
  677.  
  678.          procedure Unshrink is 
  679.             Incode       : Integer;  -- Code read in 
  680.             Last_Incode  : Integer; 
  681.             Last_Outcode : Zip.Byte; 
  682.             Code_Size    : Integer := Initial_Code_Size; -- Actual code size (9 .. 13) 
  683.             Stack        : Zip.Byte_Buffer (0 .. Max_Stack);  -- Stack for output 
  684.             Stack_Ptr    : Integer := Max_Stack; 
  685.             New_Code     : Integer;  -- Save new normal code read 
  686.  
  687.             Code_for_Special   : constant := 256; 
  688.             Code_Increase_size : constant := 1; 
  689.             Code_Clear_table   : constant := 2; 
  690.  
  691.             S : UnZip.File_size_type := UnZ_Glob.uncompsize; 
  692.             -- Fix Jan - 2009 : replaces a remaining bits counter as Unsigned_*32* .. . 
  693.  
  694.             procedure Read_Code is 
  695.                pragma Inline (Read_Code); 
  696.             begin 
  697.                Incode := UnZ_IO.Bit_buffer.Read_and_dump (Code_Size); 
  698.             end Read_Code; 
  699.  
  700.          begin 
  701.             Previous_Code := (others => 0); 
  702.             Actual_Code  := (others => 0); 
  703.             Stack        := (others => 0); 
  704.             Writebuf     := (others => 0); 
  705.  
  706.             if UnZ_Glob.compsize = Unsigned_32'Last then 
  707.                -- Compressed Size was not in header! 
  708.                raise UnZip.Not_supported; 
  709.             elsif UnZ_Glob.uncompsize = 0 then 
  710.                return; -- compression of a 0 - file with Shrink.pas 
  711.             end if; 
  712.  
  713.             -- initialize free codes list 
  714.  
  715.             for I in Previous_Code'Range loop 
  716.                Previous_Code (I) := -(I + 1); 
  717.             end loop; 
  718.  
  719.             Next_Free := First_Entry; 
  720.             Write_Ptr := 0; 
  721.  
  722.             Read_Code; 
  723.             Last_Incode  := Incode; 
  724.             Last_Outcode := Zip.Byte (Incode); 
  725.             Write_Byte (Last_Outcode); 
  726.             S := S - 1; 
  727.  
  728.             while S > 0 and then not UnZ_Glob.Zip_EOF loop 
  729.                Read_Code; 
  730.                if Incode = Code_for_Special then 
  731.                   Read_Code; 
  732.                   case Incode is 
  733.                   when Code_Increase_size => 
  734.                      Code_Size := Code_Size + 1; 
  735.                      if some_trace then 
  736.                         pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  737.                         Ada.Text_IO.Put ( 
  738.                                          "[LZW code size - >" & Integer'Image (Code_Size) & ']' 
  739.                                         ); 
  740.                         pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  741.                      end if; 
  742.                      if  Code_Size > Maximum_Code_Size then 
  743.                         raise Zip.Zip_file_Error; 
  744.                      end if; 
  745.                   when Code_Clear_table => 
  746.                      Clear_Leaf_Nodes; 
  747.                   when others => 
  748.                      raise Zip.Zip_file_Error; 
  749.                   end case; 
  750.  
  751.                else -- Normal code 
  752.                   New_Code := Incode; 
  753.                   if Incode < 256 then          -- Simple char 
  754.                      Last_Outcode :=  Zip.Byte (Incode); 
  755.                      Write_Byte (Last_Outcode); 
  756.                      S := S - 1; 
  757.                   else 
  758.                      if Previous_Code (Incode) < 0 then 
  759.                         Stack (Stack_Ptr) := Last_Outcode; 
  760.                         Stack_Ptr := Stack_Ptr - 1; 
  761.                         Incode := Last_Incode; 
  762.                      end if; 
  763.                      while Incode > 256 loop 
  764.                         -- Test added 11 - Dec - 2007 for situations 
  765.                         --     happening on corrupt files: 
  766.                         if Stack_Ptr < Stack'First or else 
  767.                           Incode > Actual_Code'Last 
  768.                         then 
  769.                            raise Zip.Zip_file_Error; 
  770.                         end if; 
  771.                         Stack (Stack_Ptr) := Actual_Code (Incode); 
  772.                         Stack_Ptr := Stack_Ptr - 1; 
  773.                         Incode := Previous_Code (Incode); 
  774.                      end loop; 
  775.  
  776.                      Last_Outcode := Zip.Byte (Incode mod 256); 
  777.                      Write_Byte (Last_Outcode); 
  778.  
  779.                      for I in Stack_Ptr + 1 .. Max_Stack  loop 
  780.                         Write_Byte (Stack (I)); 
  781.                      end loop; 
  782.                      S := S - UnZip.File_size_type (Max_Stack - Stack_Ptr + 1); 
  783.  
  784.                      Stack_Ptr := Max_Stack; 
  785.                   end if; 
  786.                   Incode := Next_Free; 
  787.                   if Incode <= Max_Code then 
  788.                      Next_Free := -Previous_Code (Incode); 
  789.                      -- Next node in free list 
  790.                      Previous_Code (Incode) := Last_Incode; 
  791.                      Actual_Code  (Incode) := Last_Outcode; 
  792.                   end if; 
  793.                   Last_Incode := New_Code; 
  794.                end if; 
  795.             end loop; 
  796.             if some_trace then 
  797.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  798.                Ada.Text_IO.Put ("[ Unshrink main loop finished ]"); 
  799.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  800.             end if; 
  801.             Unshrink_Flush; 
  802.          end Unshrink; 
  803.  
  804.          --------[ Method : Unreduce ] -------- 
  805.  
  806.          procedure Unreduce (factor : Reduction_factor) is 
  807.  
  808.             -- Original slide limit : 16#4000# 
  809.             DLE_code : constant := 144; 
  810.             subtype Symbol_range is Integer range 0 .. 255; 
  811.             subtype Follower_range is Integer range 0 .. 63; -- Appnote : <= 32 ! 
  812.             Followers : array (Symbol_range, Follower_range) of Symbol_range := 
  813.               (others => (others => 0)); 
  814.             Slen : array (Symbol_range) of Follower_range; 
  815.  
  816.             -- Bits taken by (x - 1) mod 256: 
  817.             B_Table : constant array (Symbol_range) of Integer := 
  818.               (0      => 8, 
  819.                1 .. 2   => 1, 
  820.                3 .. 4   => 2, 
  821.                5 .. 8   => 3, 
  822.                9 .. 16  => 4, 
  823.                17 .. 32  => 5, 
  824.                33 .. 64  => 6, 
  825.                65 .. 128 => 7, 
  826.                129 .. 255 => 8); 
  827.  
  828.             procedure LoadFollowers is 
  829.                list_followers : constant Boolean := some_trace; 
  830.                procedure Show_symbol (S : Symbol_range) is 
  831.                begin 
  832.                   if S in 32 .. 254 then 
  833.                      Ada.Text_IO.Put (Character'Val (S)); 
  834.                   else 
  835.                      Ada.Text_IO.Put ('{' & Symbol_range'Image (S) & '}'); 
  836.                   end if; 
  837.                end Show_symbol; 
  838.             begin 
  839.                for X in reverse Symbol_range loop 
  840.                   Slen (X) := UnZ_IO.Bit_buffer.Read_and_dump (6); 
  841.                   if list_followers then 
  842.                      pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  843.                      Show_symbol (X); 
  844.                      Ada.Text_IO.Put (" - > (" & Integer'Image (Slen (X)) & ") "); 
  845.                      pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  846.                   end if; 
  847.                   for I in 0 .. Slen (X) - 1  loop 
  848.                      Followers (X, I) := UnZ_IO.Bit_buffer.Read_and_dump (8); 
  849.                      if list_followers then 
  850.                         pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  851.                         Show_symbol (Followers (X, I)); 
  852.                         pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  853.                      end if; 
  854.                   end loop; 
  855.                   if list_followers then 
  856.                      pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  857.                      Ada.Text_IO.New_Line; 
  858.                      pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  859.                   end if; 
  860.                end loop; 
  861.             end LoadFollowers; 
  862.  
  863.             unreduce_length, 
  864.             char_read, 
  865.             last_char : Integer := 0; 
  866.             -- ^ some := 0 are useless, just to calm down ObjectAda 7.2.2 
  867.             S : UnZip.File_size_type := UnZ_Glob.uncompsize; 
  868.             -- number of bytes left to decompress 
  869.             unflushed : Boolean := True; 
  870.             maximum_AND_mask : constant Unsigned_32 := Shift_Left (1, 8 - factor) - 1; 
  871.  
  872.             procedure Out_byte (b : Zip.Byte) is 
  873.             begin 
  874.                S := S - 1; 
  875.                UnZ_Glob.slide (UnZ_Glob.slide_index) := b; 
  876.                UnZ_Glob.slide_index := UnZ_Glob.slide_index + 1; 
  877.                UnZ_IO.Flush_if_full (UnZ_Glob.slide_index, unflushed); 
  878.             end Out_byte; 
  879.  
  880.             V : Unsigned_32 := 0; 
  881.             type State_type is (normal, length_a, length_b, distance); 
  882.             state : State_type := normal; 
  883.  
  884.          begin 
  885.             LoadFollowers; 
  886.  
  887.             while S > 0 and then not UnZ_Glob.Zip_EOF loop 
  888.  
  889.                -- 1/ Probabilistic expansion 
  890.                if Slen (last_char) = 0 then 
  891.                   -- follower set is empty for this character 
  892.                   char_read := UnZ_IO.Bit_buffer.Read_and_dump (8); 
  893.                elsif UnZ_IO.Bit_buffer.Read_and_dump (1) = 0  then 
  894.                   char_read := Followers ( 
  895.                                           last_char, 
  896.                                           UnZ_IO.Bit_buffer.Read_and_dump (B_Table (Slen (last_char))) 
  897.                                          ); 
  898.                else 
  899.                   char_read := UnZ_IO.Bit_buffer.Read_and_dump (8); 
  900.                end if; 
  901.  
  902.                -- 2/ Expand the resulting Zip.Byte into repeated sequences 
  903.                case state is 
  904.  
  905.                when normal => 
  906.                   if char_read = DLE_code then 
  907.                      -- >> Next will be a DLE 
  908.                      state := length_a; 
  909.                   else 
  910.                      -- >> A single char 
  911.                      Out_byte (Zip.Byte (char_read)); 
  912.                   end if; 
  913.  
  914.                when length_a => 
  915.                   if char_read = 0 then 
  916.                      -- >> DLE_code & 0 - > was just the Zip.Byte coded DLE_code 
  917.                      Out_byte (DLE_code); 
  918.                      state := normal; 
  919.                   else 
  920.                      V := Unsigned_32 (char_read); 
  921.                      unreduce_length := Integer (V and maximum_AND_mask); 
  922.                      -- The remaining bits of V will be used for the distance 
  923.                      if unreduce_length = Integer (maximum_AND_mask) then 
  924.                         state := length_b; 
  925.                         -- >> length must be completed before reading distance 
  926.                      else 
  927.                         state := distance; 
  928.                      end if; 
  929.                   end if; 
  930.  
  931.                when length_b => 
  932.                   unreduce_length := unreduce_length + char_read; 
  933.                   state := distance; 
  934.  
  935.                when distance => 
  936.                   unreduce_length := unreduce_length + 3; 
  937.                   S := S - UnZip.File_size_type (unreduce_length); 
  938.  
  939.                   UnZ_IO.Copy_or_zero ( 
  940.                                        distance   => char_read + 1 + Integer (Shift_Right (V, 8 - factor) * 2**8), 
  941.                                        copy_length     => unreduce_length, 
  942.                                        index      => UnZ_Glob.slide_index, 
  943.                                        unflushed  => unflushed 
  944.                                       ); 
  945.                   state := normal; 
  946.  
  947.                end case; 
  948.  
  949.                last_char := char_read;  -- store character for next iteration 
  950.             end loop; 
  951.  
  952.             UnZ_IO.Flush (UnZ_Glob.slide_index); 
  953.          end Unreduce; 
  954.  
  955.          --------[ Method : Explode ] -------- 
  956.  
  957.          -- C code by info - zip group, translated to Pascal by Christian Ghisler 
  958.          -- based on unz51g.zip 
  959.  
  960.          use UnZip.Decompress.Huffman; 
  961.  
  962.          procedure Get_Tree (L : out Length_array) is 
  963.             I, K, J, B  : Unsigned_32; 
  964.             N           : constant Unsigned_32 := L'Length; 
  965.             L_Idx       : Integer    := L'First; 
  966.             Bytebuf     : Zip.Byte; 
  967.  
  968.          begin 
  969.             if full_trace then 
  970.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  971.                Ada.Text_IO.Put_Line ("Begin UnZ_Expl.Get_tree"); 
  972.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  973.             end if; 
  974.  
  975.             UnZ_IO.Read_raw_byte (Bytebuf); 
  976.             I := Unsigned_32 (Bytebuf) + 1; 
  977.             K := 0; 
  978.  
  979.             loop 
  980.                UnZ_IO.Read_raw_byte (Bytebuf); 
  981.                J := Unsigned_32 (Bytebuf); 
  982.                B := (J  and  16#0F#) + 1; 
  983.                J := (J  and  16#F0#) / 16 + 1; 
  984.                if  K + J > N then 
  985.                   raise Zip.Zip_file_Error; 
  986.                end if; 
  987.  
  988.                loop 
  989.                   L (L_Idx) := Natural (B); 
  990.                   L_Idx := L_Idx + 1; 
  991.                   K := K + 1; 
  992.                   J := J - 1; 
  993.                   exit when  J = 0; 
  994.                end loop; 
  995.  
  996.                I := I - 1; 
  997.                exit when  I = 0; 
  998.             end loop; 
  999.  
  1000.             if  K /= N then 
  1001.                raise Zip.Zip_file_Error; 
  1002.             end if; 
  1003.  
  1004.             if full_trace then 
  1005.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1006.                Ada.Text_IO.Put_Line ("End   UnZ_Expl.Get_tree"); 
  1007.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1008.             end if; 
  1009.          end Get_Tree; 
  1010.  
  1011.          procedure Explode_Lit ( -- method with 3 trees 
  1012.                                 Needed : Integer; 
  1013.                                 Tb, Tl, Td  : p_Table_list; 
  1014.                                 Bb, Bl, Bd  : Integer 
  1015.                                ) 
  1016.          is 
  1017.             S        : Unsigned_32; 
  1018.             E, N, D  : Integer; 
  1019.  
  1020.             W  : Integer := 0; 
  1021.             Ct  : p_HufT_table; -- current table 
  1022.             Ci  : Natural;                               -- current index 
  1023.             unflushed : Boolean := True; -- true while slide not yet unflushed 
  1024.  
  1025.          begin 
  1026.             if full_trace then 
  1027.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1028.                Ada.Text_IO.Put_Line ("Begin Explode_lit"); 
  1029.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1030.             end if; 
  1031.  
  1032.             UnZ_IO.Bit_buffer.Init; 
  1033.  
  1034.             S := UnZ_Glob.uncompsize; 
  1035.             while  S > 0 and then not UnZ_Glob.Zip_EOF  loop 
  1036.                if UnZ_IO.Bit_buffer.Read_and_dump (1) /= 0 then  -- 1 : Litteral 
  1037.                   S := S - 1; 
  1038.                   Ct := Tb.all.table; 
  1039.                   Ci := UnZ_IO.Bit_buffer.Read_inverted (Bb); 
  1040.  
  1041.                   loop 
  1042.                      E :=  Ct.all (Ci).extra_bits; 
  1043.                      exit when E <= 16; 
  1044.  
  1045.                      if E = invalid then 
  1046.                         raise Zip.Zip_file_Error; 
  1047.                      end if; 
  1048.  
  1049.                      UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1050.                      E := E - 16; 
  1051.                      Ct := Ct.all (Ci).next_table; 
  1052.                      Ci := UnZ_IO.Bit_buffer.Read_inverted (E); 
  1053.                   end loop; 
  1054.  
  1055.                   UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1056.                   UnZ_Glob.slide (W) :=  Zip.Byte (Ct.all (Ci).n); 
  1057.                   W := W + 1; 
  1058.                   UnZ_IO.Flush_if_full (W, unflushed); 
  1059.  
  1060.                else                                       -- 0 : Copy 
  1061.                   D := UnZ_IO.Bit_buffer.Read_and_dump (Needed); 
  1062.                   Ct := Td.all.table; 
  1063.                   Ci := UnZ_IO.Bit_buffer.Read_inverted (Bd); 
  1064.  
  1065.                   loop 
  1066.                      E := Ct.all (Ci).extra_bits; 
  1067.                      exit when  E <= 16; 
  1068.  
  1069.                      if E = invalid then 
  1070.                         raise Zip.Zip_file_Error; 
  1071.                      end if; 
  1072.  
  1073.                      UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1074.                      E := E - 16; 
  1075.                      Ct := Ct.all (Ci).next_table; 
  1076.                      Ci := UnZ_IO.Bit_buffer.Read_inverted (E); 
  1077.                   end loop; 
  1078.  
  1079.                   UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1080.                   D := D + Ct.all (Ci).n; 
  1081.  
  1082.                   Ct := Tl.all.table; 
  1083.                   Ci := UnZ_IO.Bit_buffer.Read_inverted (Bl); 
  1084.  
  1085.                   loop 
  1086.                      E := Ct.all (Ci).extra_bits; 
  1087.                      exit when  E <= 16; 
  1088.  
  1089.                      if E = invalid then 
  1090.                         raise Zip.Zip_file_Error; 
  1091.                      end if; 
  1092.  
  1093.                      UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1094.                      E := E - 16; 
  1095.                      Ct := Ct.all (Ci).next_table; 
  1096.                      Ci := UnZ_IO.Bit_buffer.Read_inverted (E); 
  1097.                   end loop; 
  1098.  
  1099.                   UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1100.  
  1101.                   N :=  Ct.all (Ci).n; 
  1102.                   if  E /= 0 then 
  1103.                      N := N + UnZ_IO.Bit_buffer.Read_and_dump (8); 
  1104.                   end if; 
  1105.                   S := S - Unsigned_32 (N); 
  1106.  
  1107.                   UnZ_IO.Copy_or_zero ( 
  1108.                                        distance   => D, 
  1109.                                        copy_length     => N, 
  1110.                                        index      => W, 
  1111.                                        unflushed  => unflushed 
  1112.                                       ); 
  1113.  
  1114.                end if; 
  1115.             end loop; 
  1116.  
  1117.             UnZ_IO.Flush (W); 
  1118.             if UnZ_Glob.Zip_EOF then 
  1119.                raise UnZip.Read_Error; 
  1120.             end if; 
  1121.  
  1122.             if full_trace then 
  1123.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1124.                Ada.Text_IO.Put_Line ("End   Explode_lit"); 
  1125.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1126.             end if; 
  1127.          end Explode_Lit; 
  1128.  
  1129.          procedure Explode_Nolit ( -- method with 2 trees 
  1130.                                   Needed : Integer; 
  1131.                                   Tl, Td  : p_Table_list; 
  1132.                                   Bl, Bd  : Integer 
  1133.                                  ) 
  1134.          is 
  1135.             S        : Unsigned_32; 
  1136.             E, N, D  : Integer; 
  1137.             W  : Integer := 0; 
  1138.             Ct  : p_HufT_table; -- current table 
  1139.             Ci  : Natural;                               -- current index 
  1140.             unflushed : Boolean := True; -- true while slide not yet unflushed 
  1141.  
  1142.          begin 
  1143.             if full_trace then 
  1144.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1145.                Ada.Text_IO.Put_Line ("Begin Explode_nolit"); 
  1146.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1147.             end if; 
  1148.  
  1149.             UnZ_IO.Bit_buffer.Init; 
  1150.             S := UnZ_Glob.uncompsize; 
  1151.             while  S > 0 and then not UnZ_Glob.Zip_EOF  loop 
  1152.                if UnZ_IO.Bit_buffer.Read_and_dump (1) /= 0 then  -- 1 : Litteral 
  1153.                   S := S - 1; 
  1154.                   UnZ_Glob.slide (W) := 
  1155.                     Zip.Byte (UnZ_IO.Bit_buffer.Read_and_dump (8)); 
  1156.                   W := W + 1; 
  1157.                   UnZ_IO.Flush_if_full (W, unflushed); 
  1158.                else                                       -- 0 : Copy 
  1159.                   D := UnZ_IO.Bit_buffer.Read_and_dump (Needed); 
  1160.                   Ct := Td.all.table; 
  1161.                   Ci := UnZ_IO.Bit_buffer.Read_inverted (Bd); 
  1162.  
  1163.                   loop 
  1164.                      E := Ct.all (Ci).extra_bits; 
  1165.                      exit when  E <= 16; 
  1166.  
  1167.                      if E = invalid then 
  1168.                         raise Zip.Zip_file_Error; 
  1169.                      end if; 
  1170.  
  1171.                      UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1172.                      E := E - 16; 
  1173.                      Ct := Ct.all (Ci).next_table; 
  1174.                      Ci := UnZ_IO.Bit_buffer.Read_inverted (E); 
  1175.                   end loop; 
  1176.  
  1177.                   UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1178.  
  1179.                   D :=  D + Ct.all (Ci).n; 
  1180.                   Ct := Tl.all.table; 
  1181.                   Ci := UnZ_IO.Bit_buffer.Read_inverted (Bl); 
  1182.  
  1183.                   loop 
  1184.                      E := Ct.all (Ci).extra_bits; 
  1185.                      exit when  E <= 16; 
  1186.  
  1187.                      if E = invalid then 
  1188.                         raise Zip.Zip_file_Error; 
  1189.                      end if; 
  1190.  
  1191.                      UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1192.                      E := E - 16; 
  1193.                      Ct := Ct.all (Ci).next_table; 
  1194.                      Ci := UnZ_IO.Bit_buffer.Read_inverted (E); 
  1195.                   end loop; 
  1196.  
  1197.                   UnZ_IO.Bit_buffer.Dump (Ct.all (Ci).bits); 
  1198.  
  1199.                   N := Ct.all (Ci).n; 
  1200.                   if  E /= 0 then 
  1201.                      N := N + UnZ_IO.Bit_buffer.Read_and_dump (8); 
  1202.                   end if; 
  1203.                   S := S - Unsigned_32 (N); 
  1204.  
  1205.                   UnZ_IO.Copy_or_zero ( 
  1206.                                        distance   => D, 
  1207.                                        copy_length     => N, 
  1208.                                        index      => W, 
  1209.                                        unflushed  => unflushed 
  1210.                                       ); 
  1211.  
  1212.                end if; 
  1213.             end loop; 
  1214.  
  1215.             UnZ_IO.Flush (W); 
  1216.             if UnZ_Glob.Zip_EOF then 
  1217.                raise UnZip.Read_Error; 
  1218.             end if; 
  1219.  
  1220.             if full_trace then 
  1221.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1222.                Ada.Text_IO.Put_Line ("End   Explode_nolit"); 
  1223.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1224.             end if; 
  1225.  
  1226.          end Explode_Nolit; 
  1227.  
  1228.          procedure Explode (literal_tree, slide_8_KB : Boolean) is 
  1229.  
  1230.             Tb, Tl, Td  : p_Table_list; 
  1231.             Bb, Bl, Bd  : Integer; 
  1232.             L :  Length_array (0 .. 255); 
  1233.             huft_incomplete  : Boolean; 
  1234.  
  1235.             cp_length_2_trees : 
  1236.             constant Length_array (0 .. 63) := 
  1237.               (2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15, 16, 17, 
  1238.                18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 
  1239.                35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 
  1240.                52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65); 
  1241.  
  1242.             cp_length_3_trees : 
  1243.             constant Length_array (0 .. 63) := 
  1244.               (3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 
  1245.                19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 
  1246.                36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 
  1247.                53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66); 
  1248.  
  1249.             cp_dist_4KB : 
  1250.             constant Length_array (0 .. 63) := 
  1251.               (1, 65, 129, 193, 257, 321, 385, 449, 513, 577, 641, 705, 
  1252.                769, 833, 897, 961, 1025, 1089, 1153, 1217, 1281, 1345, 1409, 1473, 
  1253.                1537, 1601, 1665, 1729, 1793, 1857, 1921, 1985, 2049, 2113, 2177, 
  1254.                2241, 2305, 2369, 2433, 2497, 2561, 2625, 2689, 2753, 2817, 2881, 
  1255.                2945, 3009, 3073, 3137, 3201, 3265, 3329, 3393, 3457, 3521, 3585, 
  1256.                3649, 3713, 3777, 3841, 3905, 3969, 4033); 
  1257.  
  1258.             cp_dist_8KB : 
  1259.             constant Length_array (0 .. 63) := 
  1260.               (1,  129,  257,  385,  513,  641,  769,  897, 1025, 1153, 1281, 
  1261.                1409, 1537, 1665, 1793, 1921, 2049, 2177, 2305, 2433, 2561, 2689, 
  1262.                2817, 2945, 3073, 3201, 3329, 3457, 3585, 3713, 3841, 3969, 4097, 
  1263.                4225, 4353, 4481, 4609, 4737, 4865, 4993, 5121, 5249, 5377, 5505, 
  1264.                5633, 5761, 5889, 6017, 6145, 6273, 6401, 6529, 6657, 6785, 6913, 
  1265.                7041, 7169, 7297, 7425, 7553, 7681, 7809, 7937, 8065); 
  1266.  
  1267.             extra : 
  1268.             constant Length_array (0 .. 63) := (0 .. 62 => 0, 63 => 8); 
  1269.  
  1270.          begin 
  1271.             Bl := 7; 
  1272.             if UnZ_Glob.compsize > 200000 then 
  1273.                Bd := 8; 
  1274.             else 
  1275.                Bd := 7; 
  1276.             end if; 
  1277.  
  1278.             if literal_tree then 
  1279.                Bb := 9; 
  1280.                Get_Tree (L); 
  1281.                begin 
  1282.                   HufT_build (L, 256, empty, empty, Tb, Bb, huft_incomplete); 
  1283.                   if huft_incomplete then 
  1284.                      HufT_free (Tb); 
  1285.                      raise Zip.Zip_file_Error; 
  1286.                   end if; 
  1287.                exception 
  1288.                   when others => 
  1289.                      raise Zip.Zip_file_Error; 
  1290.                end; 
  1291.  
  1292.                begin 
  1293.                   Get_Tree (L (0 .. 63)); 
  1294.                exception 
  1295.                   when others => 
  1296.                      HufT_free (Tb); 
  1297.                      raise Zip.Zip_file_Error; 
  1298.                end; 
  1299.  
  1300.                begin 
  1301.                   HufT_build ( 
  1302.                               L (0 .. 63), 0, cp_length_3_trees, extra, Tl, Bl, huft_incomplete 
  1303.                              ); 
  1304.                   if huft_incomplete then 
  1305.                      HufT_free (Tl); 
  1306.                      HufT_free (Tb); 
  1307.                      raise Zip.Zip_file_Error; 
  1308.                   end if; 
  1309.                exception 
  1310.                   when others => 
  1311.                      HufT_free (Tb); 
  1312.                      raise Zip.Zip_file_Error; 
  1313.                end; 
  1314.  
  1315.                begin 
  1316.                   Get_Tree (L (0 .. 63)); 
  1317.                exception 
  1318.                   when others => 
  1319.                      HufT_free (Tb); 
  1320.                      HufT_free (Tl); 
  1321.                      raise Zip.Zip_file_Error; 
  1322.                end; 
  1323.  
  1324.                begin 
  1325.                   if slide_8_KB then 
  1326.                      HufT_build ( 
  1327.                                  L (0 .. 63), 0, cp_dist_8KB, extra, Td, Bd, huft_incomplete 
  1328.                                 ); 
  1329.                      if huft_incomplete then 
  1330.                         HufT_free (Td); 
  1331.                         HufT_free (Tl); 
  1332.                         HufT_free (Tb); 
  1333.                         raise Zip.Zip_file_Error; 
  1334.                      end if; 
  1335.                      -- Exploding, method : 8k slide, 3 trees 
  1336.                      Explode_Lit (7, Tb, Tl, Td, Bb, Bl, Bd); 
  1337.                   else 
  1338.                      HufT_build ( 
  1339.                                  L (0 .. 63), 0, cp_dist_4KB, extra, Td, Bd, huft_incomplete 
  1340.                                 ); 
  1341.                      if huft_incomplete then 
  1342.                         HufT_free (Td); 
  1343.                         HufT_free (Tl); 
  1344.                         HufT_free (Tb); 
  1345.                         raise Zip.Zip_file_Error; 
  1346.                      end if; 
  1347.                      -- Exploding, method : 4k slide, 3 trees 
  1348.                      Explode_Lit (6, Tb, Tl, Td, Bb, Bl, Bd); 
  1349.                   end if; 
  1350.                exception 
  1351.                   when  others => 
  1352.                      HufT_free (Tl); 
  1353.                      HufT_free (Tb); 
  1354.                      raise Zip.Zip_file_Error; 
  1355.                end; 
  1356.                HufT_free (Td); 
  1357.                HufT_free (Tl); 
  1358.                HufT_free (Tb); 
  1359.  
  1360.             else         -- No literal tree 
  1361.  
  1362.                begin 
  1363.                   Get_Tree (L (0 .. 63)); 
  1364.                exception 
  1365.                   when others => 
  1366.                      raise Zip.Zip_file_Error; 
  1367.                end; 
  1368.  
  1369.                begin 
  1370.                   HufT_build ( 
  1371.                               L (0 .. 63), 0, cp_length_2_trees, extra, Tl, Bl, huft_incomplete 
  1372.                              ); 
  1373.                   if huft_incomplete then 
  1374.                      HufT_free (Tl); 
  1375.                      raise Zip.Zip_file_Error; 
  1376.                   end if; 
  1377.                exception 
  1378.                   when others => 
  1379.                      raise Zip.Zip_file_Error; 
  1380.                end; 
  1381.  
  1382.                begin 
  1383.                   Get_Tree (L (0 .. 63)); 
  1384.                exception 
  1385.                   when others => 
  1386.                      HufT_free (Tl); 
  1387.                      raise Zip.Zip_file_Error; 
  1388.                end; 
  1389.  
  1390.                begin 
  1391.                   if slide_8_KB then 
  1392.                      HufT_build ( 
  1393.                                  L (0 .. 63), 0, cp_dist_8KB, extra, Td, Bd, huft_incomplete 
  1394.                                 ); 
  1395.                      if huft_incomplete then 
  1396.                         HufT_free (Td); 
  1397.                         HufT_free (Tl); 
  1398.                         raise Zip.Zip_file_Error; 
  1399.                      end if; 
  1400.                      -- Exploding, method : 8k slide, 2 trees 
  1401.                      Explode_Nolit (7, Tl, Td, Bl, Bd); 
  1402.                   else 
  1403.                      HufT_build ( 
  1404.                                  L (0 .. 63), 0, cp_dist_4KB, extra, Td, Bd, huft_incomplete 
  1405.                                 ); 
  1406.                      if huft_incomplete then 
  1407.                         HufT_free (Td); 
  1408.                         HufT_free (Tl); 
  1409.                         raise Zip.Zip_file_Error; 
  1410.                      end if; 
  1411.                      -- Exploding, method : 4k slide, 2 trees 
  1412.                      Explode_Nolit (6, Tl, Td, Bl, Bd); 
  1413.                   end if; 
  1414.                exception 
  1415.                   when others => 
  1416.                      HufT_free (Tl); 
  1417.                      raise Zip.Zip_file_Error; 
  1418.                end; 
  1419.                HufT_free (Td); 
  1420.                HufT_free (Tl); 
  1421.             end if; 
  1422.  
  1423.          end Explode; 
  1424.  
  1425.          --------[ Method : Copy stored ] -------- 
  1426.  
  1427.          procedure Copy_stored is 
  1428.             size : constant UnZip.File_size_type := UnZ_Glob.compsize; 
  1429.             read_in, absorbed  : UnZip.File_size_type; 
  1430.          begin 
  1431.             absorbed := 0; 
  1432.             if UnZ_IO.Decryption.Get_mode then 
  1433.                absorbed := 12; 
  1434.             end if; 
  1435.             while absorbed < size loop 
  1436.                read_in := size - absorbed; 
  1437.                if read_in > wsize then 
  1438.                   read_in := wsize; 
  1439.                end if; 
  1440.                begin 
  1441.                   for I in 0 .. read_in - 1 loop 
  1442.                      UnZ_IO.Read_raw_byte (UnZ_Glob.slide (Natural (I))); 
  1443.                   end loop; 
  1444.                exception 
  1445.                   when others => 
  1446.                      raise UnZip.Read_Error; 
  1447.                end; 
  1448.                begin 
  1449.                   UnZ_IO.Flush (Natural (read_in));  -- Takes care of CRC too 
  1450.                exception 
  1451.                   when others => 
  1452.                      raise UnZip.Write_Error; 
  1453.                end; 
  1454.                absorbed := absorbed + read_in; 
  1455.             end loop; 
  1456.          end Copy_stored; 
  1457.  
  1458.          --------[ Method : Inflate ] -------- 
  1459.  
  1460.          procedure Inflate_Codes (Tl, Td : p_Table_list; Bl, Bd : Integer) is 
  1461.             CTE              : p_HufT;       -- current table element 
  1462.             inflate_length   : Natural; 
  1463.             E                : Integer;      -- table entry flag/number of extra bits 
  1464.             W                : Integer := UnZ_Glob.slide_index; 
  1465.             -- more local variable for slide index 
  1466.          begin 
  1467.             if full_trace then 
  1468.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1469.                Ada.Text_IO.Put_Line ("Begin Inflate_codes"); 
  1470.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1471.             end if; 
  1472.  
  1473.             -- inflate the coded data 
  1474. --              pragma Warnings (Off, "variable ""Zip_EOF"" is not modified in loop body"); 
  1475.             -- The loop is left through an "exit main_loop" statement. 
  1476.             -- Should be restructured. 
  1477.             main_loop : 
  1478.             loop 
  1479. --              while not UnZ_Glob.Zip_EOF loop 
  1480. --                 pragma Warnings (On, "variable ""Zip_EOF"" is not modified in loop body"); 
  1481.                CTE := Tl.all.table.all (UnZ_IO.Bit_buffer.Read (Bl))'Access; 
  1482.  
  1483.                loop 
  1484.                   E := CTE.all.extra_bits; 
  1485.                   exit when E <= 16; 
  1486.                   if E = invalid then 
  1487.                      raise Zip.Zip_file_Error; 
  1488.                   end if; 
  1489.  
  1490.                   -- then it's a literal 
  1491.                   UnZ_IO.Bit_buffer.Dump (CTE.all.bits); 
  1492.                   E := E - 16; 
  1493.                   CTE := CTE.all.next_table.all (UnZ_IO.Bit_buffer.Read (E))'Access; 
  1494.                end loop; 
  1495.  
  1496.                UnZ_IO.Bit_buffer.Dump (CTE.all.bits); 
  1497.  
  1498.                case E is 
  1499.                when 16 =>     -- CTE.N is a Litteral 
  1500.                   UnZ_Glob.slide (W) :=  Zip.Byte (CTE.all.n); 
  1501.                   W := W + 1; 
  1502.                   UnZ_IO.Flush_if_full (W); 
  1503.  
  1504.                when 15 =>     -- End of block (EOB, code 256) 
  1505.                   if full_trace then 
  1506.                      pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1507.                      Ada.Text_IO.Put_Line ("Exit  Inflate_codes, e=15 - > EOB"); 
  1508.                      pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1509.                   end if; 
  1510.                   exit main_loop; 
  1511.  
  1512.                   when others => -- We have a length/distance 
  1513.  
  1514.                   -- Get length of block to copy: 
  1515.                   inflate_length := CTE.all.n + UnZ_IO.Bit_buffer.Read_and_dump (E); 
  1516.  
  1517.                   -- Decode distance of block to copy: 
  1518.                   CTE := Td.all.table.all (UnZ_IO.Bit_buffer.Read (Bd))'Access; 
  1519.                   loop 
  1520.                      E := CTE.all.extra_bits; 
  1521.                      exit when E <= 16; 
  1522.                      if E = invalid then 
  1523.                         raise Zip.Zip_file_Error; 
  1524.                      end if; 
  1525.                      UnZ_IO.Bit_buffer.Dump (CTE.all.bits); 
  1526.                      E := E - 16; 
  1527.                      CTE := CTE.all.next_table.all (UnZ_IO.Bit_buffer.Read (E))'Access; 
  1528.                   end loop; 
  1529.                   UnZ_IO.Bit_buffer.Dump (CTE.all.bits); 
  1530.                   UnZ_IO.Copy ( 
  1531.                                distance => CTE.all.n + UnZ_IO.Bit_buffer.Read_and_dump (E), 
  1532.                                copy_length   => inflate_length, 
  1533.                                index    => W 
  1534.                               ); 
  1535.                end case; 
  1536.             end loop main_loop; 
  1537.  
  1538.             UnZ_Glob.slide_index := W; 
  1539.  
  1540.             if full_trace then 
  1541.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1542.                Ada.Text_IO.Put_Line ("End   Inflate_codes"); 
  1543.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1544.             end if; 
  1545.          end Inflate_Codes; 
  1546.  
  1547.          procedure Inflate_stored_block is -- Actually, nothing to inflate 
  1548.             N  : Integer; 
  1549.          begin 
  1550.             if full_trace then 
  1551.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1552.                Ada.Text_IO.Put_Line ("Begin Inflate_stored_block"); 
  1553.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1554.             end if; 
  1555.             UnZ_IO.Bit_buffer.Dump_to_byte_boundary; 
  1556.  
  1557.             -- Get the block length and its complement 
  1558.             N := UnZ_IO.Bit_buffer.Read_and_dump (16); 
  1559.             if  N /= Integer ( 
  1560.                               (not UnZ_IO.Bit_buffer.Read_and_dump_U32 (16)) 
  1561.                               and 16#ffff#) 
  1562.             then 
  1563.                raise Zip.Zip_file_Error; 
  1564.             end if; 
  1565.             while N > 0  and then not UnZ_Glob.Zip_EOF loop 
  1566.                -- Read and output the non - compressed data 
  1567.                N := N - 1; 
  1568.                UnZ_Glob.slide (UnZ_Glob.slide_index) := 
  1569.                  Zip.Byte (UnZ_IO.Bit_buffer.Read_and_dump (8)); 
  1570.                UnZ_Glob.slide_index := UnZ_Glob.slide_index + 1; 
  1571.                UnZ_IO.Flush_if_full (UnZ_Glob.slide_index); 
  1572.             end loop; 
  1573.             if full_trace then 
  1574.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1575.                Ada.Text_IO.Put_Line ("End   Inflate_stored_block"); 
  1576.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1577.             end if; 
  1578.          end Inflate_stored_block; 
  1579.  
  1580.          -- Copy lengths for literal codes 257 .. 285 
  1581.  
  1582.          copy_lengths_literal  : Length_array (0 .. 30) := 
  1583.            (3,  4,  5,  6,  7,  8,  9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 
  1584.             35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0); 
  1585.  
  1586.          -- Extra bits for literal codes 257 .. 285 
  1587.  
  1588.          extra_bits_literal  : Length_array (0 .. 30) := 
  1589.            (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 
  1590.             3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, invalid, invalid); 
  1591.  
  1592.          -- Copy offsets for distance codes 0 .. 29 (30 .. 31 : deflate_e) 
  1593.  
  1594.          copy_offset_distance  : constant Length_array (0 .. 31) := 
  1595.            (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 
  1596.             257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 
  1597.             8193, 12289, 16385, 24577, 32769, 49153); 
  1598.  
  1599.          -- Extra bits for distance codes 
  1600.  
  1601.          extra_bits_distance  : constant Length_array (0 .. 31) := 
  1602.            (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 
  1603.             7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14); 
  1604.  
  1605.          max_dist : Integer := 29; -- changed to 31 for deflate_e 
  1606.  
  1607.          procedure Inflate_fixed_block is 
  1608.             Tl,                        -- literal/length code table 
  1609.             Td  : p_Table_list;            -- distance code table 
  1610.             Bl, Bd  : Integer;          -- lookup bits for tl/bd 
  1611.             huft_incomplete  : Boolean; 
  1612.  
  1613.             -- length list for HufT_build (literal table) 
  1614.             L : constant Length_array (0 .. 287) := 
  1615.               (0 .. 143 => 8, 144 .. 255 => 9, 256 .. 279 => 7, 280 .. 287 => 8); 
  1616.  
  1617.          begin 
  1618.             if some_trace then 
  1619.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1620.                Ada.Text_IO.Put_Line ("Begin Inflate_fixed_block"); 
  1621.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1622.             end if; 
  1623.  
  1624.             -- make a complete, but wrong code set 
  1625.             Bl := 7; 
  1626.             HufT_build ( 
  1627.                         L, 257, copy_lengths_literal, extra_bits_literal, 
  1628.                         Tl, Bl, huft_incomplete 
  1629.                        ); 
  1630.  
  1631.             -- Make an incomplete code set 
  1632.             Bd := 5; 
  1633.             begin 
  1634.                HufT_build ( 
  1635.                            (0 .. max_dist => 5), 0, 
  1636.                            copy_offset_distance, extra_bits_distance, 
  1637.                            Td, Bd, huft_incomplete 
  1638.                           ); 
  1639.                if huft_incomplete then 
  1640.                   if full_trace then 
  1641.                      pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1642.                      Ada.Text_IO.Put_Line ( 
  1643.                                            "td is incomplete, pointer=null : " & 
  1644.                                              Boolean'Image (Td = null) 
  1645.                                           ); 
  1646.                      pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1647.                   end if; 
  1648.                end if; 
  1649.             exception 
  1650.                when huft_out_of_memory | huft_error => 
  1651.                   HufT_free (Tl); 
  1652.                   raise Zip.Zip_file_Error; 
  1653.             end; 
  1654.  
  1655.             Inflate_Codes (Tl, Td, Bl, Bd); 
  1656.  
  1657.             HufT_free (Tl); pragma Unreferenced (Tl); 
  1658.             HufT_free (Td); pragma Unreferenced (Td); 
  1659.  
  1660.             if some_trace then 
  1661.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1662.                Ada.Text_IO.Put_Line ("End   Inflate_fixed_block"); 
  1663.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1664.             end if; 
  1665.          end Inflate_fixed_block; 
  1666.  
  1667.          procedure Inflate_dynamic_block is 
  1668.             bit_order  : constant array (0 .. 18) of Natural := 
  1669.               (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15); 
  1670.  
  1671.             Lbits  : constant := 9; 
  1672.             Dbits  : constant := 6; 
  1673.  
  1674.             current_length : Natural; 
  1675.             defined, number_of_lengths : Natural; 
  1676.  
  1677.             Tl,                             -- literal/length code tables 
  1678.             Td  : p_Table_list;            -- distance code tables 
  1679.  
  1680.             CTE  : p_HufT;  -- current table element 
  1681.  
  1682.             Bl, Bd  : Integer;                  -- lookup bits for tl/bd 
  1683.             Nb  : Natural;  -- number of bit length codes 
  1684.             Nl  : Natural;  -- number of literal length codes 
  1685.             Nd  : Natural;  -- number of distance codes 
  1686.  
  1687.             -- literal/length and distance code lengths 
  1688.             Ll : Length_array (0 .. 288 + 32 - 1) := (others => 0); 
  1689.  
  1690.             huft_incomplete  : Boolean; 
  1691.  
  1692.             procedure Repeat_length_code (amount : Natural) is 
  1693.             begin 
  1694.                if defined + amount > number_of_lengths then 
  1695.                   raise Zip.Zip_file_Error; 
  1696.                end if; 
  1697.                for c in reverse 1 .. amount loop 
  1698.                   Ll (defined) := current_length; 
  1699.                   defined := defined + 1; 
  1700.                end loop; 
  1701.             end Repeat_length_code; 
  1702.  
  1703.          begin 
  1704.             if some_trace then 
  1705.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1706.                Ada.Text_IO.Put_Line ("Begin Inflate_dynamic_block"); 
  1707.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1708.             end if; 
  1709.  
  1710.             -- Read in table lengths 
  1711.             Nl := 257 + UnZ_IO.Bit_buffer.Read_and_dump (5); 
  1712.             Nd :=   1 + UnZ_IO.Bit_buffer.Read_and_dump (5); 
  1713.             Nb :=   4 + UnZ_IO.Bit_buffer.Read_and_dump (4); 
  1714.  
  1715.             if Nl > 288 or else Nd > 32 then 
  1716.                raise Zip.Zip_file_Error; 
  1717.             end if; 
  1718.  
  1719.             -- Read in bit - length - code lengths. 
  1720.             -- The rest, Ll (Bit_Order (Nb .. 18)), is already = 0 
  1721.             for J in  0 .. Nb - 1  loop 
  1722.                Ll (bit_order (J)) := UnZ_IO.Bit_buffer.Read_and_dump (3); 
  1723.             end loop; 
  1724.  
  1725.             -- Build decoding table for trees --single level, 7 bit lookup 
  1726.             Bl := 7; 
  1727.             begin 
  1728.                HufT_build ( 
  1729.                            Ll (0 .. 18), 19, empty, empty, Tl, Bl, huft_incomplete 
  1730.                           ); 
  1731.                if huft_incomplete then 
  1732.                   HufT_free (Tl); 
  1733.                   raise Zip.Zip_file_Error; 
  1734.                end if; 
  1735.             exception 
  1736.                when others => 
  1737.                   raise Zip.Zip_file_Error; 
  1738.             end; 
  1739.  
  1740.             -- Read in literal and distance code lengths 
  1741.             number_of_lengths := Nl + Nd; 
  1742.             defined := 0; 
  1743.             current_length := 0; 
  1744.  
  1745.             while  defined < number_of_lengths  loop 
  1746.                CTE := Tl.all.table.all (UnZ_IO.Bit_buffer.Read (Bl))'Access; 
  1747.                UnZ_IO.Bit_buffer.Dump (CTE.all.bits); 
  1748.  
  1749.                case CTE.all.n is 
  1750.                when 0 .. 15 =>       -- length of code in bits (0 .. 15) 
  1751.                   current_length := CTE.all.n; 
  1752.                   Ll (defined) := current_length; 
  1753.                   defined := defined + 1; 
  1754.  
  1755.                when 16 =>          -- repeat last length 3 to 6 times 
  1756.                   Repeat_length_code (3 + UnZ_IO.Bit_buffer.Read_and_dump (2)); 
  1757.  
  1758.                when 17 =>          -- 3 to 10 zero length codes 
  1759.                   current_length := 0; 
  1760.                   Repeat_length_code (3 + UnZ_IO.Bit_buffer.Read_and_dump (3)); 
  1761.  
  1762.                when 18 =>          -- 11 to 138 zero length codes 
  1763.                   current_length := 0; 
  1764.                   Repeat_length_code (11 + UnZ_IO.Bit_buffer.Read_and_dump (7)); 
  1765.  
  1766.                when others => 
  1767.                   if full_trace then 
  1768.                      pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1769.                      Ada.Text_IO.Put_Line ( 
  1770.                                            "Illegal length code : " & 
  1771.                                              Integer'Image (CTE.n) 
  1772.                                           ); 
  1773.                      pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1774.                   end if; 
  1775.  
  1776.                end case; 
  1777.             end loop; 
  1778.  
  1779.             pragma Warnings (Off, """Tl"" modified by call, but value overwritten at line 1789"); 
  1780.             HufT_free (Tl);      -- free decoding table for trees 
  1781.             pragma Warnings (On,  """Tl"" modified by call, but value overwritten at line 1789"); 
  1782.  
  1783.             -- Build the decoding tables for literal/length codes 
  1784.             Bl := Lbits; 
  1785.             begin 
  1786.                HufT_build ( 
  1787.                            Ll (0 .. Nl - 1), 257, 
  1788.                            copy_lengths_literal, extra_bits_literal, 
  1789.                            Tl, Bl, huft_incomplete 
  1790.                           ); 
  1791.                if huft_incomplete then 
  1792.                   HufT_free (Tl); 
  1793.                   raise Zip.Zip_file_Error; 
  1794.                end if; 
  1795.             exception 
  1796.                when others => 
  1797.                   raise Zip.Zip_file_Error; 
  1798.             end; 
  1799.  
  1800.             -- Build the decoding tables for distance codes 
  1801.             Bd := Dbits; 
  1802.             begin 
  1803.                HufT_build ( 
  1804.                            Ll (Nl .. Nl + Nd - 1), 0, 
  1805.                            copy_offset_distance, extra_bits_distance, 
  1806.                            Td, Bd, huft_incomplete 
  1807.                           ); 
  1808.                if huft_incomplete then -- do nothing! 
  1809.                   if some_trace then 
  1810.                      pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1811.                      Ada.Text_IO.Put_Line ("PKZIP 1.93a bug workaround"); 
  1812.                      pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1813.                   end if; 
  1814.                end if; 
  1815.             exception 
  1816.                when huft_out_of_memory | huft_error => 
  1817.                   HufT_free (Tl); 
  1818.                   raise Zip.Zip_file_Error; 
  1819.             end; 
  1820.  
  1821.             -- Decompress until an end - of - block code 
  1822.  
  1823.             Inflate_Codes (Tl, Td, Bl, Bd); 
  1824.             HufT_free (Tl); pragma Unreferenced (Tl); 
  1825.             HufT_free (Td); pragma Unreferenced (Td); 
  1826.  
  1827.             if some_trace then 
  1828.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1829.                Ada.Text_IO.Put_Line ("End   Inflate_dynamic_block"); 
  1830.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1831.             end if; 
  1832.          end Inflate_dynamic_block; 
  1833.  
  1834.          procedure Inflate_Block (last_block : out Boolean) is 
  1835.          begin 
  1836.             last_block := Boolean'Val (UnZ_IO.Bit_buffer.Read_and_dump (1)); 
  1837.             case UnZ_IO.Bit_buffer.Read_and_dump (2) is -- Block type = 0, 1, 2, 3 
  1838.             when 0 =>      Inflate_stored_block; 
  1839.             when 1 =>      Inflate_fixed_block; 
  1840.             when 2 =>      Inflate_dynamic_block; 
  1841.             when others => raise Zip.Zip_file_Error; -- Bad block type (3) 
  1842.             end case; 
  1843.          end Inflate_Block; 
  1844.  
  1845.          procedure Inflate is 
  1846.             is_last_block : Boolean; 
  1847.             blocks : Positive := 1; 
  1848.          begin 
  1849.             if deflate_e_mode then 
  1850.                copy_lengths_literal (28) := 3; -- instead of 258 
  1851.                extra_bits_literal (28) := 16;  -- instead of 0 
  1852.                max_dist := 31; 
  1853.             end if; 
  1854.             loop 
  1855.                Inflate_Block (is_last_block); 
  1856.                exit when is_last_block; 
  1857.                blocks := blocks + 1; 
  1858.             end loop; 
  1859.             UnZ_IO.Flush (UnZ_Glob.slide_index); 
  1860.             UnZ_Glob.slide_index := 0; 
  1861.             if some_trace then 
  1862.                pragma Warnings (Off, "this code can never be executed and has been deleted"); 
  1863.                Ada.Text_IO.Put ("# blocks:" & Integer'Image (blocks)); 
  1864.                pragma Warnings (On,  "this code can never be executed and has been deleted"); 
  1865.             end if; 
  1866.          end Inflate; 
  1867.  
  1868.          --------[ Method : BZip2 ] -------- 
  1869.  
  1870.          procedure Bunzip2 is 
  1871.             type BZ_Buffer is array (Natural range <>) of Interfaces.Unsigned_8; 
  1872.             procedure Read (b : out BZ_Buffer) is 
  1873.             begin 
  1874.                for i in b'Range loop 
  1875.                   exit when UnZ_Glob.Zip_EOF; 
  1876.                   UnZ_IO.Read_raw_byte (b (i)); 
  1877.                end loop; 
  1878.             end Read; 
  1879.             procedure Write (b : BZ_Buffer) is 
  1880.             begin 
  1881.                for i in b'Range loop 
  1882.                   UnZ_Glob.slide (UnZ_Glob.slide_index) := b (i); 
  1883.                   UnZ_Glob.slide_index := UnZ_Glob.slide_index + 1; 
  1884.                   UnZ_IO.Flush_if_full (UnZ_Glob.slide_index); 
  1885.                end loop; 
  1886.             end Write; 
  1887.             package My_BZip2 is new BZip2 
  1888.               (Buffer    => BZ_Buffer, 
  1889.                check_CRC => False, -- Already done by UnZ_IO 
  1890.                Read      => Read, 
  1891.                Write     => Write 
  1892.               ); 
  1893.          begin 
  1894.             My_BZip2.Decompress; 
  1895.             UnZ_IO.Flush (UnZ_Glob.slide_index); 
  1896.          end Bunzip2; 
  1897.  
  1898.       end UnZ_Meth; 
  1899.  
  1900.       procedure Process (descriptor : out Zip.Headers.Data_descriptor) 
  1901.       is 
  1902.          start : Integer; 
  1903.          b : Unsigned_8; 
  1904.          dd_buffer : Zip.Byte_Buffer (1 .. 30); 
  1905.       begin 
  1906.          UnZ_IO.Bit_buffer.Dump_to_byte_boundary; 
  1907.          UnZ_IO.Read_raw_byte (b); 
  1908.          if b = 75 then -- 'K' ('P' is before, Java/JAR bug!) 
  1909.             dd_buffer (1) := 80; 
  1910.             dd_buffer (2) := 75; 
  1911.             start := 3; 
  1912.          else 
  1913.             dd_buffer (1) := b; -- hopefully = 80 
  1914.             start := 2; 
  1915.          end if; 
  1916.          for i in start .. 16 loop 
  1917.             UnZ_IO.Read_raw_byte (dd_buffer (i)); 
  1918.          end loop; 
  1919.          Zip.Headers.Copy_and_check (dd_buffer, descriptor); 
  1920.       end Process; 
  1921.  
  1922.       tolerance_wrong_password : constant := 4; -- after that, error ! 
  1923.       work_index : Ada.Streams.Stream_IO.Positive_Count; 
  1924.       use Zip, UnZ_Meth; 
  1925.  
  1926.    begin -- Decompress_Data 
  1927.       output_memory_access := null; 
  1928.       -- ^ this is an 'out' parameter, we have to set it anyway 
  1929.       case mode is 
  1930.       when write_to_binary_file => 
  1931.          Ada.Streams.Stream_IO.Create (UnZ_IO.out_bin_file, Ada.Streams.Stream_IO.Out_File, output_file_name, 
  1932.                                        Form => To_String (Zip.Form_For_IO_Open_N_Create)); 
  1933.       when write_to_text_file => 
  1934.          Ada.Text_IO.Create (UnZ_IO.out_txt_file, Ada.Text_IO.Out_File, output_file_name, 
  1935.                              Form => To_String (Zip.Form_For_IO_Open_N_Create)); 
  1936.       when write_to_memory => 
  1937.          output_memory_access := new 
  1938.            Ada.Streams.Stream_Element_Array ( 
  1939.                                              1 .. Ada.Streams.Stream_Element_Offset (hint.uncompressed_size) 
  1940.                                             ); 
  1941.          UnZ_Glob.uncompressed_index := output_memory_access'First; 
  1942.       when just_test => 
  1943.          null; 
  1944.       end case; 
  1945.  
  1946.       UnZ_Glob.compsize  := hint.compressed_size; 
  1947.       -- 2008 : from TT's version: 
  1948.       -- Avoid wraparound in read_buffer, when File_size_type'Last is given 
  1949.       -- as hint.compressed_size (unknown size) 
  1950.       if UnZ_Glob.compsize > File_size_type'Last - 2 then 
  1951.          UnZ_Glob.compsize := File_size_type'Last - 2; 
  1952.       end if; 
  1953.       UnZ_Glob.uncompsize := hint.uncompressed_size; 
  1954.       UnZ_IO.Init_Buffers; 
  1955.       UnZ_IO.Decryption.Set_mode (encrypted); 
  1956.       if encrypted then 
  1957.          work_index := Ada.Streams.Stream_IO.Positive_Count (Zip_Streams.Index (zip_file)); 
  1958.          password_passes : for p in 1 .. tolerance_wrong_password loop 
  1959.             begin 
  1960.                UnZ_IO.Decryption.Init (To_String (password), hint.crc_32); 
  1961.                exit password_passes; -- the current password fits, then go on! 
  1962.             exception 
  1963.                when Wrong_password => 
  1964.                   if p = tolerance_wrong_password then 
  1965.                      raise; 
  1966.                   end if; -- alarm! 
  1967.                   if get_new_password /= null then 
  1968.                      get_new_password (password); -- ask for a new one 
  1969.                   end if; 
  1970.             end; 
  1971.             -- Go back to data beginning: 
  1972.             begin 
  1973.                Zip_Streams.Set_Index (zip_file, Positive (work_index)); 
  1974.             exception 
  1975.                when others => 
  1976.                   raise Read_Error; 
  1977.             end; 
  1978.             UnZ_IO.Init_Buffers; 
  1979.          end loop password_passes; 
  1980.       end if; 
  1981.  
  1982.       -- Unzip correct type 
  1983.       begin 
  1984.          case format is 
  1985.          when store    => Copy_stored; 
  1986.          when shrink   => Unshrink; 
  1987.          when reduce_1 => Unreduce (1); 
  1988.          when reduce_2 => Unreduce (2); 
  1989.          when reduce_3 => Unreduce (3); 
  1990.          when reduce_4 => Unreduce (4); 
  1991.          when implode  => 
  1992.             UnZ_Meth.Explode (explode_literal_tree, explode_slide_8KB); 
  1993.          when deflate | deflate_e => 
  1994.             UnZ_Meth.deflate_e_mode := format = deflate_e; 
  1995.             UnZ_Meth.Inflate; 
  1996.          when Zip.bzip2 => UnZ_Meth.Bunzip2; 
  1997.          when others => 
  1998.             raise Unsupported_method; 
  1999.          end case; 
  2000.       exception 
  2001.          when others => 
  2002.             UnZ_IO.Delete_output; 
  2003.             raise; 
  2004.       end; 
  2005.       UnZ_Glob.crc32val := Zip.CRC.Final (UnZ_Glob.crc32val); 
  2006.       -- Decompression done ! 
  2007.  
  2008.       if end_data_descriptor then -- Sizes and CRC at the end 
  2009.          declare 
  2010.             memo_uncomp_size : constant Unsigned_32 := 
  2011.               hint.uncompressed_size; 
  2012.          begin 
  2013.             Process (hint); -- CRC for checking and sizes for informing user 
  2014.             if memo_uncomp_size < Unsigned_32'Last and then -- 
  2015.               memo_uncomp_size /= hint.uncompressed_size 
  2016.             then 
  2017.                UnZ_IO.Delete_output; 
  2018.                raise Uncompressed_size_Error; 
  2019.             end if; 
  2020.          end; 
  2021.       end if; 
  2022.  
  2023.       if hint.crc_32 /= UnZ_Glob.crc32val then 
  2024.          UnZ_IO.Delete_output; 
  2025.          raise CRC_Error; 
  2026.       end if; 
  2027.  
  2028.       case mode is 
  2029.       when write_to_binary_file => 
  2030.          Ada.Streams.Stream_IO.Close (UnZ_IO.out_bin_file); 
  2031.       when write_to_text_file => 
  2032.          Ada.Text_IO.Close (UnZ_IO.out_txt_file); 
  2033.       when others => 
  2034.          null; 
  2035.       end case; 
  2036.  
  2037.    exception 
  2038.  
  2039.       when others => -- close the file in case of an error, if not yet closed 
  2040.          case mode is -- or deleted 
  2041.          when write_to_binary_file => 
  2042.             if Ada.Streams.Stream_IO.Is_Open (UnZ_IO.out_bin_file) then 
  2043.                Ada.Streams.Stream_IO.Close (UnZ_IO.out_bin_file); 
  2044.             end if; 
  2045.          when write_to_text_file => 
  2046.             if Ada.Text_IO.Is_Open (UnZ_IO.out_txt_file) then 
  2047.                Ada.Text_IO.Close (UnZ_IO.out_txt_file); 
  2048.             end if; 
  2049.          when others => 
  2050.             null; 
  2051.          end case; 
  2052.          raise; 
  2053.  
  2054.    end Decompress_data; 
  2055.  
  2056. end UnZip.Decompress;