Natools

Check-in [fd2ccb00b9]
Login
☰Home Timeline Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:smaz_implementations-base_64_tools: new package for paddingless base-64
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: fd2ccb00b9f52f48438eca5891d625acbf4fafee
User & Date: nat 2016-12-18 21:16:17
Context
2016-12-19
20:18
smaz_64: new instance of generic smaz, outputs directly base-64 symbols check-in: 091a96ec6c user: nat tags: trunk
2016-12-18
21:16
smaz_implementations-base_64_tools: new package for paddingless base-64 check-in: fd2ccb00b9 user: nat tags: trunk
2016-12-17
22:48
tools/smaz: add a roundtrip check option to help debug new code check-in: f44feb5e3e user: nat tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added src/natools-smaz_implementations-base_64_tools.adb. 















































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246

------------------------------------------------------------------------------
-- 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_64_Tools is

   use type Ada.Streams.Stream_Element_Offset;

   -----------------------
   -- Bit Manipulations --
   -----------------------

   function Low_6 (Byte : in Character) return Base_64_Digit
     is (Character'Pos (Byte) mod 64);
   function Low_4 (Byte : in Character) return Single_Byte_Padding
     is (Character'Pos (Byte) mod 16);
   function Low_2 (Byte : in Character) return Double_Byte_Padding
     is (Character'Pos (Byte) mod 4);
      --  Least significant bits of a byte

   function High_6 (Byte : in Character) return Base_64_Digit
     is (Character'Pos (Byte) / 4);
   function High_4 (Byte : in Character) return Single_Byte_Padding
     is (Character'Pos (Byte) / 16);
   function High_2 (Byte : in Character) return Double_Byte_Padding
     is (Character'Pos (Byte) / 64);
      --  Most significant bits of a byte

   function Image_2_4 (Low : Double_Byte_Padding; High : Single_Byte_Padding)
     return Base_64_Symbol
     is (Image (Low + High * 4));
   function Image_4_2 (Low : Single_Byte_Padding; High : Double_Byte_Padding)
     return Base_64_Symbol
     is (Image (Low + High * 16));
      --  Composition into a base-64 symbol

   function Low_4 (Digit : in Base_64_Digit) return Natural
     is (Natural (Digit mod 16));
   function Low_2 (Digit : in Base_64_Digit) return Natural
     is (Natural (Digit mod 4));
      --  Least significat bits of a digit

   function High_4 (Digit : in Base_64_Digit) return Natural
     is (Natural (Digit / 4));
   function High_2 (Digit : in Base_64_Digit) return Natural
     is (Natural (Digit / 16));
      --  Least significat bits of a digit

   function Value_2_6 (Low, High : in Natural) return Character
     is (Character'Val (Low + High * 4));
   function Value_4_4 (Low, High : in Natural) return Character
     is (Character'Val (Low + High * 16));
   function Value_6_2 (Low, High : in Natural) return Character
     is (Character'Val (Low + High * 64));
      --  Combine parts of digits into a Character



   ----------------------
   -- Public Interface --
   ----------------------

   procedure Decode
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String)
   is
      Index : Positive := Output'First;
      Padding_1 : Single_Byte_Padding;
      Padding_2 : Double_Byte_Padding;
   begin
      while Index in Output'Range loop
         case Output'Last - Index + 1 is
            when 1 =>
               Decode_Single (Input, Offset, Output (Index), Padding_1);
               Index := Index + 1;

            when 2 =>
               Decode_Double
                 (Input, Offset, Output (Index .. Index + 1), Padding_2);
               Index := Index + 2;

            when others =>
               Decode_Block (Input, Offset, Output (Index .. Index + 2));
               Index := Index + 3;
         end case;
      end loop;
   end Decode;


   procedure Decode_Block
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out Full_Block)
   is
      Data : array (1 .. 4) of Base_64_Digit;
   begin
      for I in Data'Range loop
         Next_Digit (Input, Offset, Data (I));
      end loop;

      Output (1) := Value_6_2 (Natural (Data (1)), Low_2   (Data (2)));
      Output (2) := Value_4_4 (High_4  (Data (2)), Low_4   (Data (3)));
      Output (3) := Value_2_6 (High_2  (Data (3)), Natural (Data (4)));
   end Decode_Block;


   procedure Decode_Double
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out Double_Byte;
      Padding : out Double_Byte_Padding)
   is
      Data : array (1 .. 3) of Base_64_Digit;
   begin
      for I in Data'Range loop
         Next_Digit (Input, Offset, Data (I));
      end loop;

      Output (1) := Value_6_2 (Natural (Data (1)), Low_2   (Data (2)));
      Output (2) := Value_4_4 (High_4  (Data (2)), Low_4   (Data (3)));
      Padding := Double_Byte_Padding (High_2 (Data (3)));
   end Decode_Double;


   procedure Decode_Single
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out Character;
      Padding : out Single_Byte_Padding)
   is
      Data : array (1 .. 2) of Base_64_Digit;
   begin
      for I in Data'Range loop
         Next_Digit (Input, Offset, Data (I));
      end loop;

      Output := Value_6_2 (Natural (Data (1)), Low_2   (Data (2)));
      Padding := Single_Byte_Padding (High_4 (Data (2)));
   end Decode_Single;


   procedure Encode
     (Input : in String;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset)
   is
      Index : Positive := Input'First;
   begin
      while Index in Input'Range loop
         case Input'Last - Index + 1 is
            when 1 =>
               Encode_Single (Input (Index), 0, Output, Offset);
               Index := Index + 1;

            when 2 =>
               Encode_Double (Input (Index .. Index + 1), 0, Output, Offset);
               Index := Index + 2;

            when others =>
               Encode_Block (Input (Index .. Index + 2), Output, Offset);
               Index := Index + 3;
         end case;
      end loop;
   end Encode;


   procedure Encode_Block
     (Input : in Full_Block;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset) is
   begin
      Output (Offset + 0) := Image (Low_6 (Input (1)));
      Output (Offset + 1) := Image_2_4 (High_2 (Input (1)), Low_4 (Input (2)));
      Output (Offset + 2) := Image_4_2 (High_4 (Input (2)), Low_2 (Input (3)));
      Output (Offset + 3) := Image (High_6 (Input (3)));
      Offset := Offset + 4;
   end Encode_Block;


   procedure Encode_Double
     (Input : in Double_Byte;
      Padding : in Double_Byte_Padding;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset) is
   begin
      Output (Offset + 0) := Image (Low_6 (Input (1)));
      Output (Offset + 1) := Image_2_4 (High_2 (Input (1)), Low_4 (Input (2)));
      Output (Offset + 2) := Image_4_2 (High_4 (Input (2)), Padding);
      Offset := Offset + 3;
   end Encode_Double;


   procedure Encode_Single
     (Input : in Character;
      Padding : in Single_Byte_Padding;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset) is
   begin
      Output (Offset + 0) := Image (Low_6 (Input));
      Output (Offset + 1) := Image_2_4 (High_2 (Input), Padding);
      Offset := Offset + 2;
   end Encode_Single;


   procedure Next_Digit
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Digit : out Base_64_Digit) is
   begin
      while Input (Offset) not in Base_64_Symbol loop
         Offset := Offset + 1;
      end loop;

      Digit := Value (Input (Offset));
      Offset := Offset + 1;
   end Next_Digit;


   function Symbol_Count (Input : Ada.Streams.Stream_Element_Array)
     return Ada.Streams.Stream_Element_Count
   is
      Result : Ada.Streams.Stream_Element_Count := 0;
   begin
      for S of Input loop
         if S in Base_64_Symbol then
            Result := Result + 1;
         end if;
      end loop;

      return Result;
   end Symbol_Count;

end Natools.Smaz_Implementations.Base_64_Tools;

Added src/natools-smaz_implementations-base_64_tools.ads. 









































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

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

------------------------------------------------------------------------------
-- 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_64_Tools provides types and primitives --
-- common to both base-64 and base-4096 variants of Smaz.                   --
------------------------------------------------------------------------------

with Ada.Streams;

package Natools.Smaz_Implementations.Base_64_Tools is
   pragma Pure;

   use type Ada.Streams.Stream_Element;


   type Base_64_Digit is range 0 .. 63;

   subtype Single_Byte_Padding is Base_64_Digit range 0 .. 15;
      --  Padding after a single-byte partial block
   subtype Double_Byte_Padding is Base_64_Digit range 0 .. 3;
      --  Padding after a double-byte partial block

   subtype Full_Block is String (1 .. 3);
   subtype Double_Byte is String (1 .. 2);

   subtype Full_Block_Image is Ada.Streams.Stream_Element_Array (1 .. 4);
   subtype Double_Byte_Image is Ada.Streams.Stream_Element_Array (1 .. 3);
   subtype Single_Byte_Image is Ada.Streams.Stream_Element_Array (1 .. 2);

   type Base_64_Array
     is array (Ada.Streams.Stream_Element_Offset range <>) of Base_64_Digit;

   subtype Base_64_Symbol is Ada.Streams.Stream_Element
     with Static_Predicate => Base_64_Symbol in
                                 Character'Pos ('A') .. Character'Pos ('Z')
                               | Character'Pos ('a') .. Character'Pos ('z')
                               | Character'Pos ('0') .. Character'Pos ('9')
                               | Character'Pos ('+')  | Character'Pos ('/');


   function Image (Digit : in Base_64_Digit) return Ada.Streams.Stream_Element
     is (case Digit is
         when 0 .. 25
           => Character'Pos ('A') + Ada.Streams.Stream_Element (Digit) - 0,
         when 26 .. 51
           => Character'Pos ('a') + Ada.Streams.Stream_Element (Digit) - 26,
         when 52 .. 61
           => Character'Pos ('0') + Ada.Streams.Stream_Element (Digit) - 52,
         when 62 => Character'Pos ('+'),
         when 63 => Character'Pos ('/'));
      --  Printable character representation of Digit

   function Value (Symbol : in Base_64_Symbol) return Base_64_Digit
     is (case Symbol is
         when Character'Pos ('A') .. Character'Pos ('Z')
           => Base_64_Digit (Symbol - Character'Pos ('A') + 0),
         when Character'Pos ('a') .. Character'Pos ('z')
           => Base_64_Digit (Symbol - Character'Pos ('a') + 26),
         when Character'Pos ('0') .. Character'Pos ('9')
           => Base_64_Digit (Symbol - Character'Pos ('0') + 52),
         when Character'Pos ('+') => 62,
         when Character'Pos ('/') => 63);
      --  Value represented by a symbol


   function Image_Length (Input_Length : in Natural)
     return Ada.Streams.Stream_Element_Count
     is (Ada.Streams.Stream_Element_Count
           (Input_Length + (Input_Length + 2) / 3));
      --  Paddingless encoded length

   function Value_Length (Input_Length : in Ada.Streams.Stream_Element_Count)
     return Natural
     is (Natural (Input_Length) - (Natural (Input_Length) + 3) / 4);
      --  Original length of an encoded array

   function Symbol_Count (Input : Ada.Streams.Stream_Element_Array)
     return Ada.Streams.Stream_Element_Count;
      --  Return the number of valid symbols in Input


   procedure Encode
     (Input : in String;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset);
      --  Paddingless raw encoding of Input data

   procedure Decode
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String);
      --  Paddingless raw decoding of Input data


   procedure Encode_Block
     (Input : in Full_Block;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset);
   procedure Encode_Double
     (Input : in Double_Byte;
      Padding : in Double_Byte_Padding;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset);
   procedure Encode_Single
     (Input : in Character;
      Padding : in Single_Byte_Padding;
      Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset);
      --  Encode a complete or partial block into Output at Offset

   procedure Decode_Block
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out Full_Block);
   procedure Decode_Double
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out Double_Byte;
      Padding : out Double_Byte_Padding);
   procedure Decode_Single
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out Character;
      Padding : out Single_Byte_Padding);


   procedure Next_Digit
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Digit : out Base_64_Digit);
      --  Look for the first valid symbol in Input from Offset, and decode it

end Natools.Smaz_Implementations.Base_64_Tools;

This page was generated in about 0.004s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47