Natools

Check-in [b13d7f70e3]
Login
Overview
Comment:smaz_implementations-base_256: component to instantiate standard Smaz
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b13d7f70e34f1a27a7242a670541cebe41ef56c8
User & Date: nat on 2016-11-14 20:19:05
Other Links: manifest | tags
Context
2016-11-15
22:42
smaz_256: standard Smaz algorithm built from Smaz_Generic check-in: 361f2b206c user: nat tags: trunk
2016-11-14
20:19
smaz_implementations-base_256: component to instantiate standard Smaz check-in: b13d7f70e3 user: nat tags: trunk
2016-11-13
21:42
smaz_generic: new package attempting generic Smaz-like compression check-in: 4b73acb2a8 user: nat tags: trunk
Changes

Added src/natools-smaz_implementations-base_256.adb version [aae2e3da04].



















































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Smaz_Implementations.Base_256 is

   use type Ada.Streams.Stream_Element;
   use type Ada.Streams.Stream_Element_Offset;


   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Ada.Streams.Stream_Element;
      Verbatim_Length : out Natural;
      Last_Code : in Ada.Streams.Stream_Element;
      Variable_Length_Verbatim : in Boolean)
   is
      Input_Byte : constant Ada.Streams.Stream_Element := Input (Offset);
   begin
      if Input_Byte <= Last_Code then
         Code := Input_Byte;
         Verbatim_Length := 0;
      else
         Code := 0;

         if not Variable_Length_Verbatim then
            Verbatim_Length
              := Positive (Ada.Streams.Stream_Element'Last - Input_Byte) + 1;
         elsif Input_Byte < Ada.Streams.Stream_Element'Last then
            Verbatim_Length
              := Positive (Ada.Streams.Stream_Element'Last - Input_Byte);
         else
            Offset := Offset + 1;
            Verbatim_Length
              := Positive (Input (Offset))
               + Natural (Ada.Streams.Stream_Element'Last - Last_Code)
               - 1;
         end if;
      end if;

      Offset := Offset + 1;
   end Read_Code;


   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String) is
   begin
      for I in Output'Range loop
         Output (I) := Character'Val (Input (Offset));
         Offset := Offset + 1;
      end loop;
   end Read_Verbatim;


   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive)
   is
      pragma Unreferenced (Input);
   begin
      Offset := Offset + Ada.Streams.Stream_Element_Offset (Verbatim_Length);
   end Skip_Verbatim;


   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Ada.Streams.Stream_Element;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count
   is
      Verbatim1_Max_Size : constant Ada.Streams.Stream_Element_Count
        := Ada.Streams.Stream_Element_Count
            (Ada.Streams.Stream_Element'Last - Last_Code)
         - Boolean'Pos (Variable_Length_Verbatim);
      Verbatim2_Max_Size : constant Ada.Streams.Stream_Element_Count
        := Ada.Streams.Stream_Element_Count (Ada.Streams.Stream_Element'Last)
         + Verbatim1_Max_Size;

      Remaining : Ada.Streams.Stream_Element_Count
        := Ada.Streams.Stream_Element_Count (Input_Length);
      Overhead : Ada.Streams.Stream_Element_Count := 0;
   begin
      if Variable_Length_Verbatim then
         if Remaining >= Verbatim2_Max_Size then
            declare
               Full_Blocks : constant Ada.Streams.Stream_Element_Count
                 := Remaining / Verbatim2_Max_Size;
            begin
               Overhead := Overhead + 2 * Full_Blocks;
               Remaining := Remaining - Verbatim2_Max_Size * Full_Blocks;
            end;
         end if;

         if Remaining > Verbatim1_Max_Size then
            Overhead := Overhead + 2;
            Remaining := 0;
         end if;
      end if;

      declare
         Full_Blocks : constant Ada.Streams.Stream_Element_Count
           := Remaining / Verbatim1_Max_Size;
      begin
         Overhead := Overhead + Full_Blocks;
      end;

      return Overhead + Ada.Streams.Stream_Element_Count (Input_Length);
   end Verbatim_Size;


   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Ada.Streams.Stream_Element) is
   begin
      Output (Offset) := Code;
      Offset := Offset + 1;
   end Write_Code;


   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Ada.Streams.Stream_Element;
      Variable_Length_Verbatim : in Boolean)
   is
      Verbatim1_Max_Size : constant Natural
        := Natural (Ada.Streams.Stream_Element'Last - Last_Code)
         - Boolean'Pos (Variable_Length_Verbatim);
      Verbatim2_Max_Size : constant Natural
        := Natural (Ada.Streams.Stream_Element'Last)
         + Verbatim1_Max_Size;

      Input_Index : Positive := Input'First;
      Remaining_Length, Block_Length : Positive;
   begin
      while Input_Index in Input'Range loop
         Remaining_Length := Input'Last - Input_Index + 1;

         if Variable_Length_Verbatim
           and then Remaining_Length > Verbatim1_Max_Size
         then
            Block_Length := Positive'Min
              (Remaining_Length, Verbatim2_Max_Size);
            Output (Offset) := Ada.Streams.Stream_Element'Last;
            Output (Offset + 1) := Ada.Streams.Stream_Element
              (Block_Length - Verbatim1_Max_Size);
            Offset := Offset + 2;
         else
            Block_Length := Positive'Min
              (Remaining_Length, Verbatim1_Max_Size);
            Output (Offset)
              := Ada.Streams.Stream_Element'Last
               - Ada.Streams.Stream_Element
                  (Block_Length - 1 + Boolean'Pos (Variable_Length_Verbatim));
            Offset := Offset + 1;
         end if;

         Verbatim_Copy :
         for I in 1 .. Block_Length loop
            Output (Offset) := Character'Pos (Input (Input_Index));
            Offset := Offset + 1;
            Input_Index := Input_Index + 1;
         end loop Verbatim_Copy;
      end loop;
   end Write_Verbatim;

end Natools.Smaz_Implementations.Base_256;

Added src/natools-smaz_implementations-base_256.ads version [570dddda8b].

































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Smaz_Implementations.Base_256 provides the subprograms needed to --
-- instantiate Natools.Smaz_Generic into the original Smaz compression      --
-- algorithm, with byte-based output stream.                                --
------------------------------------------------------------------------------

with Ada.Streams;

package Natools.Smaz_Implementations.Base_256 is
   pragma Pure;

   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Ada.Streams.Stream_Element;
      Verbatim_Length : out Natural;
      Last_Code : in Ada.Streams.Stream_Element;
      Variable_Length_Verbatim : in Boolean);

   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String);

   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive);

   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Ada.Streams.Stream_Element;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count;

   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Ada.Streams.Stream_Element);

   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Ada.Streams.Stream_Element;
      Variable_Length_Verbatim : in Boolean);

end Natools.Smaz_Implementations.Base_256;

Added src/natools-smaz_implementations.ads version [0f4929e497].





















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Smaz_Implementations is empty root packages for the various      --
-- implementation-specific elements used for instantiating                  --
-- Natools.Smaz_Generic.                                                    --
------------------------------------------------------------------------------

package Natools.Smaz_Implementations is
   pragma Pure;

end Natools.Smaz_Implementations;