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 
vdiff_keccak           67   -- public interface, state based Sponge
vdiff_keccak           68   procedure KeccakBegin(Ctx : in out Keccak_Context) is
vdiff_keccak           69   begin
vdiff_keccak           70      Ctx.Internal := (others => (others => 0));
vdiff_keccak           71      Ctx.Block := (others => 0);
vdiff_keccak           72      Ctx.Pos := Ctx.Block'First;
vdiff_keccak           73   end;
vdiff_keccak           74 
vdiff_keccak           75   procedure KeccakHash(Ctx : in out Keccak_Context;
vdiff_keccak           76                        Input : Bitstream) is
vdiff_keccak           77      I0 : Natural;
vdiff_keccak           78      I1 : Natural;
vdiff_keccak           79      B0 : Natural;
vdiff_keccak           80      B1 : Natural;
vdiff_keccak           81   begin
vdiff_keccak           82      I0 := Input'First;
vdiff_keccak           83      <<Block_Process_Loop>>
vdiff_keccak           84          I1 := Input'Last;
vdiff_keccak           85          B0 := Ctx.Pos;
vdiff_keccak           86          B1 := B0 + (I1-I0);
vdiff_keccak           87 
vdiff_keccak           88          if B1>Ctx.Block'Last then
vdiff_keccak           89             B1 := Ctx.Block'Last;
vdiff_keccak           90             I1 := I0 + (B1-B0);
vdiff_keccak           91          end if;
vdiff_keccak           92          Ctx.Block(B0..B1) := Input(I0..I1);
vdiff_keccak           93          Ctx.Pos := B1 + 1;
vdiff_keccak           94          -- we've filled up the buffer
vdiff_keccak           95          if Ctx.Pos > Ctx.Block'Last then
vdiff_keccak           96             AbsorbBlock(Ctx.Block, Ctx.Internal);
vdiff_keccak           97             Ctx.Internal := Keccak_Function(Ctx.Internal);
vdiff_keccak           98             Ctx.Pos := Ctx.Block'First;
vdiff_keccak           99          end if;
vdiff_keccak          100          -- we haven't processed entire input block, loop
vdiff_keccak          101          if I1 < Input'Last then
vdiff_keccak          102             I0 := I1 + 1;
vdiff_keccak          103             goto Block_Process_Loop;
vdiff_keccak          104          end if;
vdiff_keccak          105   end;
vdiff_keccak          106 
vdiff_keccak          107   procedure KeccakEnd(Ctx : in out Keccak_Context;
vdiff_keccak          108                       Output : out Bitstream) is
vdiff_keccak          109      BlocksPerOutput : constant Natural := Output'Length / Ctx.Block_Len;
vdiff_keccak          110      StrayPerOutput : constant Natural := Output'Length mod Ctx.Block_Len;
vdiff_keccak          111      Block : Bitstream(1 .. Ctx.Block_Len);
vdiff_keccak          112      Need : Natural;
vdiff_keccak          113   begin
vdiff_keccak          114      if Ctx.Pos /= 0 then -- needs padding
vdiff_keccak          115         Block := (others => 0);
vdiff_keccak          116         Need := Ctx.Block'Last - Ctx.Pos;
vdiff_keccak          117         Block(Block'First) := 1;
vdiff_keccak          118         Block(Block'First+Need) := 1;
vdiff_keccak          119         KeccakHash(Ctx, Block(1..Need+1));
vdiff_keccak          120      end if;
vdiff_keccak          121 
vdiff_keccak          122      -- squeez bits
vdiff_keccak          123      for I in 0 .. BlocksPerOutput - 1 loop
vdiff_keccak          124         SqueezeBlock(Block, Ctx.Internal);
vdiff_keccak          125         Output(Output'First + I * Ctx.Block_Len ..
vdiff_keccak          126                  Output'First + (I + 1) * Ctx.Block_Len -1) := Block;
vdiff_keccak          127         Ctx.Internal := Keccak_Function(Ctx.Internal);
vdiff_keccak          128      end loop;
vdiff_keccak          129      if StrayPerOutput > 0 then
vdiff_keccak          130         SqueezeBlock(Block, Ctx.Internal);
vdiff_keccak          131         Output(Output'Last - StrayPerOutput + 1 .. Output'Last) :=
vdiff_keccak          132           Block(Block'First .. Block'First + StrayPerOutput - 1);
vdiff_keccak          133      end if;
vdiff_keccak          134   end;
vdiff_keccak          135 
keccak                136   -- convert from a bitstream of ZWord size to an actual ZWord number
keccak                137   function BitsToWord( BWord: in Bitword ) return ZWord is
keccak                138     W    : ZWord;
keccak                139     Bits: Bitword;
keccak                140   begin
keccak                141     -- just copy octets if machine is little endian
keccak                142     -- flip octets if machine is big endian
keccak                143     if Default_Bit_Order = Low_Order_First then
keccak                144       Bits := BWord;
keccak                145     else
keccak                146       Bits := FlipOctets( BWord );
keccak                147     end if;
keccak                148     -- actual bits to word conversion
keccak                149     W := 0;
keccak                150     -- LSB bit order (inside octet) as per Keccak spec
keccak                151     for I in reverse Bitword'Range loop
keccak                152       W := Shift_Left( W, 1 ) + ZWord( Bits( I ) );
keccak                153     end loop;
keccak                154     return W;
keccak                155   end BitsToWord;
keccak                156 
keccak                157   -- convert from a ZWord (lane of state) to a bitstream of ZWord size
keccak                158   function WordToBits( Word: in ZWord ) return Bitword is
keccak                159     Bits: Bitword := (others => 0);
keccak                160     W: ZWord;
keccak                161   begin
keccak                162     W := Word;
keccak                163     for I in Bitword'Range loop
keccak                164       Bits( I ) := Bit( W mod 2 );
keccak                165       W := Shift_Right( W, 1 );
keccak                166     end loop;
keccak                167 
keccak                168     -- flip octets if machine is big endian
keccak                169     if Default_Bit_Order = High_Order_First then
keccak                170       Bits := FlipOctets( Bits );
keccak                171     end if;
keccak                172 
keccak                173     return Bits;
keccak                174   end WordToBits;
keccak                175 
keccak                176   -- flip given octets (i.e. groups of 8 bits)
keccak                177   function FlipOctets( BWord : in Bitword ) return Bitword is
keccak                178     Bits : Bitword;
keccak                179   begin
keccak                180     -- copy groups of 8 octets changing their order in the array 
keccak                181     -- i.e. 1st octet in BWord becomes last octet in Bits and so on
keccak                182     for I in 0 .. ( Bitword'Length / 8 - 1 ) loop
keccak                183       Bits ( Bits'First  + I * 8     .. Bits'First + I * 8 + 7 ) :=
keccak                184       BWord( BWord'Last  - I * 8 - 7 .. BWord'Last - I * 8);
keccak                185     end loop;
keccak                186     return Bits;
keccak                187   end FlipOctets;
keccak                188 
keccak                189 -- helper procedures for sponge absorb/squeeze
keccak                190 
keccak                191   -- NO scramble here, this will absorb ALL given block, make sure it fits!
keccak                192   procedure AbsorbBlock( Block: in Bitstream; S: in out State ) is
keccak                193     WPB: constant Natural := Block'Length / Z_Length;   -- words per block
keccak                194     SBB: constant Natural := Block'Length mod Z_Length; -- stray bits
keccak                195     FromPos, ToPos        : Natural;
keccak                196     X, Y                  : XYCoord;
keccak                197     Word                  : ZWord;
keccak                198     BWord                 : Bitword;
keccak                199   begin
keccak                200     -- xor current block into first Block'Length bits of state
keccak                201     -- a block can consist in more than one word
keccak                202     X := 0;
keccak                203     Y := 0;
keccak                204     for I in 0..WPB-1 loop
keccak                205       FromPos := Block'First + I * Z_Length;
keccak                206       ToPos   := FromPos + Z_Length - 1;
keccak                207       Word := BitsToWord( Block( FromPos .. ToPos ) );
keccak                208       S( X, Y ) := S( X, Y ) xor Word;
keccak                209       -- move on to next word in state
keccak                210       X := X + 1;
keccak                211       if X = 0 then
keccak                212         Y := Y + 1;
keccak                213       end if;
keccak                214     end loop;
keccak                215     -- absorb also any remaining bits from block
keccak                216     if SBB > 0 then
keccak                217       ToPos := Block'Last;
keccak                218       FromPos := ToPos - SBB + 1;
keccak                219       BWord := (others => 0);
keccak                220       BWord(Bitword'First .. Bitword'First + SBB - 1) := Block(ToPos..FromPos);
keccak                221       Word := BitsToWord( BWord );
keccak                222       S( X, Y ) := S( X, Y ) xor Word;
keccak                223     end if;
keccak                224   end AbsorbBlock;
keccak                225 
keccak                226   -- NO scramble here, this will squeeze Block'Length bits out of *same* state S
keccak                227   procedure SqueezeBlock( Block: out Bitstream; S: in State) is
keccak                228     X, Y    : XYCoord;
keccak                229     BWord   : Bitword;
keccak                230     FromPos : Natural;
keccak                231     Len     : Natural;
keccak                232   begin
keccak                233     X := 0;
keccak                234     Y := 0;
keccak                235     FromPos := Block'First;
keccak                236 
keccak                237     while FromPos <= Block'Last loop
keccak                238       BWord := WordToBits( S(X, Y) );
keccak                239 
keccak                240       X := X + 1;
keccak                241       if X = 0 then
keccak                242         Y := Y + 1;
keccak                243       end if;
keccak                244 
keccak                245       -- copy full word if it fits or
keccak                246       --   only as many bits as are still needed to fill the block
keccak                247       Len := Block'Last - FromPos + 1;
keccak                248       if Len > Z_Length then
keccak                249         Len := Z_Length;
keccak                250       end if;
keccak                251 
keccak                252       Block(FromPos..FromPos+Len-1) := BWord(BWord'First..BWord'First+Len-1);
keccak                253       FromPos := FromPos + Len;
keccak                254     end loop;
keccak                255   end SqueezeBlock;
keccak                256 
keccak                257 
keccak                258 -- private, internal transformations
keccak                259   function Theta(Input : in State) return State is
keccak                260     Output : State;
keccak                261     C      : Plane;
keccak                262     W      : ZWord;
keccak                263   begin
keccak                264     for X in XYCoord loop
keccak                265       C(X) := Input(X, 0);
keccak                266       for Y in 1..XYCoord'Last loop
keccak                267         C(X) := C(X) xor Input(X, Y);
keccak                268       end loop;
keccak                269     end loop;
keccak                270 
keccak                271     for X in XYCoord loop
keccak                272       W := C(X-1) xor Rotate_Left(C(X+1), 1);
keccak                273       for Y in XYCoord loop
keccak                274         Output(X,Y) := Input(X,Y) xor W;
keccak                275       end loop;
keccak                276     end loop;
keccak                277 
keccak                278     return Output;
keccak                279   end Theta;
keccak                280 
keccak                281   function Rho(Input : in State) return State is
keccak                282     Output      : State;
keccak                283     X, Y, Old_Y : XYCoord;
keccak                284   begin
keccak                285     Output(0,0) := Input(0,0);
keccak                286     X           := 1;
keccak                287     Y           := 0;
keccak                288 
keccak                289     for T in 0..23 loop
keccak                290       Output(X, Y) := Rotate_Left(Input(X,Y), ((T+1)*(T+2)/2) mod Z_Length);
keccak                291       Old_Y := Y;
keccak                292       Y := 2*X + 3*Y;
keccak                293       X := Old_Y;
keccak                294     end loop;
keccak                295     return Output;
keccak                296   end rho;
keccak                297 
keccak                298   function Pi(Input : in State) return State is
keccak                299     Output: State;
keccak                300   begin
keccak                301     for X in XYCoord loop
keccak                302       for Y in XYCoord loop
keccak                303         Output(Y, 2*X + 3*Y) := Input(X, Y);
keccak                304       end loop;
keccak                305     end loop;
keccak                306     return Output;
keccak                307   end pi;
keccak                308 
keccak                309   function Chi(Input : in State) return State is
keccak                310     Output: State;
keccak                311   begin
keccak                312     for Y in XYCoord loop
keccak                313       for X in XYCoord loop
keccak                314         Output(X, Y) := Input(X, Y) xor 
keccak                315                         ( (not Input(X + 1, Y)) and Input(X + 2, Y) );
keccak                316       end loop;
keccak                317     end loop;
keccak                318     return Output;
keccak                319   end chi;
keccak                320 
keccak                321   function Iota(Round_Const : in ZWord; Input : in State) return State is
keccak                322     Output: State;
keccak                323   begin
keccak                324     Output := Input;
keccak                325     Output(0,0) := Input(0,0) xor Round_Const;
keccak                326     return Output;
keccak                327   end iota;
keccak                328 
keccak                329   function Keccak_Function(Input: in State) return State is
keccak                330     Output: State;
keccak                331   begin
keccak                332     Output := Input;
keccak                333     for I in Round_Index loop
keccak                334       Output := Iota(RC(I), Chi(Pi(Rho(Theta(Output)))));
keccak                335     end loop;
keccak                336 
keccak                337     return Output;
keccak                338   end Keccak_Function;
keccak                339 
keccak                340 end SMG_Keccak;