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