raw
keccak                  1  -- S.MG, 2018
keccak                  2 with System; use System;  -- for Bit_Order
keccak                  3 
keccak                  4 package body SMG_Keccak is
keccak                  5 
keccak                  6 -- public function, sponge
keccak                  7   procedure Sponge( Input      : in Bitstream;
keccak                  8                     Output     : out Bitstream;
keccak                  9                     Block_Len  : in Keccak_Rate := Default_Bitrate ) is
keccak                 10     Internal  : State := (others => (others => 0));
keccak                 11   begin
keccak                 12     --absorb input into sponge in a loop on available blocks, including padding
keccak                 13     declare
keccak                 14       -- number of input blocks after padding (between 2 and block_len bits pad)
keccak                 15       Padded_Blocks : constant Positive := 1 + (Input'Length + 1) / Block_Len;
keccak                 16       Padded        : Bitstream ( 1 .. Padded_Blocks * Block_Len );
keccak                 17       Block         : Bitstream ( 1 .. Block_Len );
keccak                 18     begin
keccak                 19       -- initialise Padded with 0 everywhere
keccak                 20       Padded := ( others => 0 );
keccak                 21       -- copy and pad input with rule 10*1
keccak                 22       Padded( Padded'First .. Padded'First + Input'Length - 1 ) := Input;
keccak                 23       Padded( Padded'First + Input'Length )                     := 1;
keccak                 24       Padded( Padded'Last )                                     := 1;
keccak                 25 
keccak                 26       -- loop through padded input and absorb block by block into sponge
keccak                 27       -- padded input IS a multiple of blocks, so no stray bits left
keccak                 28       for B in 0 .. Padded_Blocks - 1 loop
keccak                 29         -- first get the current block to absorb
keccak                 30         Block   := Padded( Padded'First + B * Block_Len .. 
keccak                 31                            Padded'First + (B+1) * Block_Len - 1 );
keccak                 32         AbsorbBlock( Block, Internal );
keccak                 33         -- scramble state with Keccak function
keccak                 34         Internal := Keccak_Function( Internal );
keccak                 35 
keccak                 36       end loop; -- end absorb loop for blocks
keccak                 37     end; -- end absorb stage
keccak                 38 
keccak                 39     --squeeze required bits from sponge in a loop as needed
keccak                 40     declare
keccak                 41       -- full blocks per output
keccak                 42       BPO     : constant Natural := Output'Length / Block_Len;
keccak                 43       -- stray bits per output
keccak                 44       SPO     : constant Natural := Output'Length mod Block_Len;
keccak                 45       Block   : Bitstream( 1 .. Block_Len );
keccak                 46     begin
keccak                 47       -- squeeze block by block (if at least one full block is needed)
keccak                 48       for I in 0 .. BPO - 1 loop
keccak                 49         SqueezeBlock( Block, Internal );
keccak                 50         Output( Output'First + I * Block_Len .. 
keccak                 51                 Output'First + (I + 1) * Block_Len -1) := Block;
keccak                 52  
keccak                 53         -- scramble state
keccak                 54         Internal := Keccak_Function( Internal );
keccak                 55       end loop;  -- end squeezing full blocks
keccak                 56 
keccak                 57       -- squeeze any partial block needed (stray bits)
keccak                 58       if SPO > 0 then
keccak                 59         SqueezeBlock( Block, Internal );
keccak                 60         Output( Output'Last - SPO + 1 .. Output'Last ) := 
keccak                 61                 Block( Block'First .. Block'First + SPO - 1 );
keccak                 62       end if; -- end squeezing partial last block (stray bits)
keccak                 63 
keccak                 64     end; -- end squeeze stage
keccak                 65   end Sponge;
keccak                 66 
keccak                 67   -- convert from a bitstream of ZWord size to an actual ZWord number
keccak                 68   function BitsToWord( BWord: in Bitword ) return ZWord is
keccak                 69     W    : ZWord;
keccak                 70     Bits: Bitword;
keccak                 71   begin
keccak                 72     -- just copy octets if machine is little endian
keccak                 73     -- flip octets if machine is big endian
keccak                 74     if Default_Bit_Order = Low_Order_First then
keccak                 75       Bits := BWord;
keccak                 76     else
keccak                 77       Bits := FlipOctets( BWord );
keccak                 78     end if;
keccak                 79     -- actual bits to word conversion
keccak                 80     W := 0;
keccak                 81     -- LSB bit order (inside octet) as per Keccak spec
keccak                 82     for I in reverse Bitword'Range loop
keccak                 83       W := Shift_Left( W, 1 ) + ZWord( Bits( I ) );
keccak                 84     end loop;
keccak                 85     return W;
keccak                 86   end BitsToWord;
keccak                 87 
keccak                 88   -- convert from a ZWord (lane of state) to a bitstream of ZWord size
keccak                 89   function WordToBits( Word: in ZWord ) return Bitword is
keccak                 90     Bits: Bitword := (others => 0);
keccak                 91     W: ZWord;
keccak                 92   begin
keccak                 93     W := Word;
keccak                 94     for I in Bitword'Range loop
keccak                 95       Bits( I ) := Bit( W mod 2 );
keccak                 96       W := Shift_Right( W, 1 );
keccak                 97     end loop;
keccak                 98 
keccak                 99     -- flip octets if machine is big endian
keccak                100     if Default_Bit_Order = High_Order_First then
keccak                101       Bits := FlipOctets( Bits );
keccak                102     end if;
keccak                103 
keccak                104     return Bits;
keccak                105   end WordToBits;
keccak                106 
keccak                107   -- flip given octets (i.e. groups of 8 bits)
keccak                108   function FlipOctets( BWord : in Bitword ) return Bitword is
keccak                109     Bits : Bitword;
keccak                110   begin
keccak                111     -- copy groups of 8 octets changing their order in the array 
keccak                112     -- i.e. 1st octet in BWord becomes last octet in Bits and so on
keccak                113     for I in 0 .. ( Bitword'Length / 8 - 1 ) loop
keccak                114       Bits ( Bits'First  + I * 8     .. Bits'First + I * 8 + 7 ) :=
keccak                115       BWord( BWord'Last  - I * 8 - 7 .. BWord'Last - I * 8);
keccak                116     end loop;
keccak                117     return Bits;
keccak                118   end FlipOctets;
keccak                119 
keccak                120 -- helper procedures for sponge absorb/squeeze
keccak                121 
keccak                122   -- NO scramble here, this will absorb ALL given block, make sure it fits!
keccak                123   procedure AbsorbBlock( Block: in Bitstream; S: in out State ) is
keccak                124     WPB: constant Natural := Block'Length / Z_Length;   -- words per block
keccak                125     SBB: constant Natural := Block'Length mod Z_Length; -- stray bits
keccak                126     FromPos, ToPos        : Natural;
keccak                127     X, Y                  : XYCoord;
keccak                128     Word                  : ZWord;
keccak                129     BWord                 : Bitword;
keccak                130   begin
keccak                131     -- xor current block into first Block'Length bits of state
keccak                132     -- a block can consist in more than one word
keccak                133     X := 0;
keccak                134     Y := 0;
keccak                135     for I in 0..WPB-1 loop
keccak                136       FromPos := Block'First + I * Z_Length;
keccak                137       ToPos   := FromPos + Z_Length - 1;
keccak                138       Word := BitsToWord( Block( FromPos .. ToPos ) );
keccak                139       S( X, Y ) := S( X, Y ) xor Word;
keccak                140       -- move on to next word in state
keccak                141       X := X + 1;
keccak                142       if X = 0 then
keccak                143         Y := Y + 1;
keccak                144       end if;
keccak                145     end loop;
keccak                146     -- absorb also any remaining bits from block
keccak                147     if SBB > 0 then
keccak                148       ToPos := Block'Last;
keccak                149       FromPos := ToPos - SBB + 1;
keccak                150       BWord := (others => 0);
keccak                151       BWord(Bitword'First .. Bitword'First + SBB - 1) := Block(ToPos..FromPos);
keccak                152       Word := BitsToWord( BWord );
keccak                153       S( X, Y ) := S( X, Y ) xor Word;
keccak                154     end if;
keccak                155   end AbsorbBlock;
keccak                156 
keccak                157   -- NO scramble here, this will squeeze Block'Length bits out of *same* state S
keccak                158   procedure SqueezeBlock( Block: out Bitstream; S: in State) is
keccak                159     X, Y    : XYCoord;
keccak                160     BWord   : Bitword;
keccak                161     FromPos : Natural;
keccak                162     Len     : Natural;
keccak                163   begin
keccak                164     X := 0;
keccak                165     Y := 0;
keccak                166     FromPos := Block'First;
keccak                167 
keccak                168     while FromPos <= Block'Last loop
keccak                169       BWord := WordToBits( S(X, Y) );
keccak                170 
keccak                171       X := X + 1;
keccak                172       if X = 0 then
keccak                173         Y := Y + 1;
keccak                174       end if;
keccak                175 
keccak                176       -- copy full word if it fits or
keccak                177       --   only as many bits as are still needed to fill the block
keccak                178       Len := Block'Last - FromPos + 1;
keccak                179       if Len > Z_Length then
keccak                180         Len := Z_Length;
keccak                181       end if;
keccak                182 
keccak                183       Block(FromPos..FromPos+Len-1) := BWord(BWord'First..BWord'First+Len-1);
keccak                184       FromPos := FromPos + Len;
keccak                185     end loop;
keccak                186   end SqueezeBlock;
keccak                187 
keccak                188 
keccak                189 -- private, internal transformations
keccak                190   function Theta(Input : in State) return State is
keccak                191     Output : State;
keccak                192     C      : Plane;
keccak                193     W      : ZWord;
keccak                194   begin
keccak                195     for X in XYCoord loop
keccak                196       C(X) := Input(X, 0);
keccak                197       for Y in 1..XYCoord'Last loop
keccak                198         C(X) := C(X) xor Input(X, Y);
keccak                199       end loop;
keccak                200     end loop;
keccak                201 
keccak                202     for X in XYCoord loop
keccak                203       W := C(X-1) xor Rotate_Left(C(X+1), 1);
keccak                204       for Y in XYCoord loop
keccak                205         Output(X,Y) := Input(X,Y) xor W;
keccak                206       end loop;
keccak                207     end loop;
keccak                208 
keccak                209     return Output;
keccak                210   end Theta;
keccak                211 
keccak                212   function Rho(Input : in State) return State is
keccak                213     Output      : State;
keccak                214     X, Y, Old_Y : XYCoord;
keccak                215   begin
keccak                216     Output(0,0) := Input(0,0);
keccak                217     X           := 1;
keccak                218     Y           := 0;
keccak                219 
keccak                220     for T in 0..23 loop
keccak                221       Output(X, Y) := Rotate_Left(Input(X,Y), ((T+1)*(T+2)/2) mod Z_Length);
keccak                222       Old_Y := Y;
keccak                223       Y := 2*X + 3*Y;
keccak                224       X := Old_Y;
keccak                225     end loop;
keccak                226     return Output;
keccak                227   end rho;
keccak                228 
keccak                229   function Pi(Input : in State) return State is
keccak                230     Output: State;
keccak                231   begin
keccak                232     for X in XYCoord loop
keccak                233       for Y in XYCoord loop
keccak                234         Output(Y, 2*X + 3*Y) := Input(X, Y);
keccak                235       end loop;
keccak                236     end loop;
keccak                237     return Output;
keccak                238   end pi;
keccak                239 
keccak                240   function Chi(Input : in State) return State is
keccak                241     Output: State;
keccak                242   begin
keccak                243     for Y in XYCoord loop
keccak                244       for X in XYCoord loop
keccak                245         Output(X, Y) := Input(X, Y) xor 
keccak                246                         ( (not Input(X + 1, Y)) and Input(X + 2, Y) );
keccak                247       end loop;
keccak                248     end loop;
keccak                249     return Output;
keccak                250   end chi;
keccak                251 
keccak                252   function Iota(Round_Const : in ZWord; Input : in State) return State is
keccak                253     Output: State;
keccak                254   begin
keccak                255     Output := Input;
keccak                256     Output(0,0) := Input(0,0) xor Round_Const;
keccak                257     return Output;
keccak                258   end iota;
keccak                259 
keccak                260   function Keccak_Function(Input: in State) return State is
keccak                261     Output: State;
keccak                262   begin
keccak                263     Output := Input;
keccak                264     for I in Round_Index loop
keccak                265       Output := Iota(RC(I), Chi(Pi(Rho(Theta(Output)))));
keccak                266     end loop;
keccak                267 
keccak                268     return Output;
keccak                269   end Keccak_Function;
keccak                270 
keccak                271 end SMG_Keccak;