ADDED src/natools-smaz_implementations-base_64_tools.adb Index: src/natools-smaz_implementations-base_64_tools.adb ================================================================== --- src/natools-smaz_implementations-base_64_tools.adb +++ src/natools-smaz_implementations-base_64_tools.adb @@ -0,0 +1,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 Index: src/natools-smaz_implementations-base_64_tools.ads ================================================================== --- src/natools-smaz_implementations-base_64_tools.ads +++ src/natools-smaz_implementations-base_64_tools.ads @@ -0,0 +1,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;