Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/g-sehamd.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT LIBRARY COMPONENTS -- | |
4 -- -- | |
5 -- G N A T . S E C U R E _ H A S H E S . M D 5 -- | |
6 -- -- | |
7 -- B o d y -- | |
8 -- -- | |
9 -- Copyright (C) 2002-2017, Free Software Foundation, Inc. -- | |
10 -- -- | |
11 -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 -- or FITNESS FOR A PARTICULAR PURPOSE. -- | |
17 -- -- | |
18 -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 -- version 3.1, as published by the Free Software Foundation. -- | |
21 -- -- | |
22 -- You should have received a copy of the GNU General Public License and -- | |
23 -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 -- <http://www.gnu.org/licenses/>. -- | |
26 -- -- | |
27 -- GNAT was originally developed by the GNAT team at New York University. -- | |
28 -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
29 -- -- | |
30 ------------------------------------------------------------------------------ | |
31 | |
32 with GNAT.Byte_Swapping; use GNAT.Byte_Swapping; | |
33 | |
34 package body GNAT.Secure_Hashes.MD5 is | |
35 | |
36 use Interfaces; | |
37 | |
38 -- The sixteen values used to rotate the context words. Four for each | |
39 -- rounds. Used in procedure Transform. | |
40 | |
41 -- Round 1 | |
42 | |
43 S11 : constant := 7; | |
44 S12 : constant := 12; | |
45 S13 : constant := 17; | |
46 S14 : constant := 22; | |
47 | |
48 -- Round 2 | |
49 | |
50 S21 : constant := 5; | |
51 S22 : constant := 9; | |
52 S23 : constant := 14; | |
53 S24 : constant := 20; | |
54 | |
55 -- Round 3 | |
56 | |
57 S31 : constant := 4; | |
58 S32 : constant := 11; | |
59 S33 : constant := 16; | |
60 S34 : constant := 23; | |
61 | |
62 -- Round 4 | |
63 | |
64 S41 : constant := 6; | |
65 S42 : constant := 10; | |
66 S43 : constant := 15; | |
67 S44 : constant := 21; | |
68 | |
69 -- The following functions (F, FF, G, GG, H, HH, I and II) are the | |
70 -- equivalent of the macros of the same name in the example C | |
71 -- implementation in the annex of RFC 1321. | |
72 | |
73 function F (X, Y, Z : Unsigned_32) return Unsigned_32; | |
74 pragma Inline (F); | |
75 | |
76 procedure FF | |
77 (A : in out Unsigned_32; | |
78 B, C, D : Unsigned_32; | |
79 X : Unsigned_32; | |
80 AC : Unsigned_32; | |
81 S : Positive); | |
82 pragma Inline (FF); | |
83 | |
84 function G (X, Y, Z : Unsigned_32) return Unsigned_32; | |
85 pragma Inline (G); | |
86 | |
87 procedure GG | |
88 (A : in out Unsigned_32; | |
89 B, C, D : Unsigned_32; | |
90 X : Unsigned_32; | |
91 AC : Unsigned_32; | |
92 S : Positive); | |
93 pragma Inline (GG); | |
94 | |
95 function H (X, Y, Z : Unsigned_32) return Unsigned_32; | |
96 pragma Inline (H); | |
97 | |
98 procedure HH | |
99 (A : in out Unsigned_32; | |
100 B, C, D : Unsigned_32; | |
101 X : Unsigned_32; | |
102 AC : Unsigned_32; | |
103 S : Positive); | |
104 pragma Inline (HH); | |
105 | |
106 function I (X, Y, Z : Unsigned_32) return Unsigned_32; | |
107 pragma Inline (I); | |
108 | |
109 procedure II | |
110 (A : in out Unsigned_32; | |
111 B, C, D : Unsigned_32; | |
112 X : Unsigned_32; | |
113 AC : Unsigned_32; | |
114 S : Positive); | |
115 pragma Inline (II); | |
116 | |
117 ------- | |
118 -- F -- | |
119 ------- | |
120 | |
121 function F (X, Y, Z : Unsigned_32) return Unsigned_32 is | |
122 begin | |
123 return (X and Y) or ((not X) and Z); | |
124 end F; | |
125 | |
126 -------- | |
127 -- FF -- | |
128 -------- | |
129 | |
130 procedure FF | |
131 (A : in out Unsigned_32; | |
132 B, C, D : Unsigned_32; | |
133 X : Unsigned_32; | |
134 AC : Unsigned_32; | |
135 S : Positive) | |
136 is | |
137 begin | |
138 A := A + F (B, C, D) + X + AC; | |
139 A := Rotate_Left (A, S); | |
140 A := A + B; | |
141 end FF; | |
142 | |
143 ------- | |
144 -- G -- | |
145 ------- | |
146 | |
147 function G (X, Y, Z : Unsigned_32) return Unsigned_32 is | |
148 begin | |
149 return (X and Z) or (Y and (not Z)); | |
150 end G; | |
151 | |
152 -------- | |
153 -- GG -- | |
154 -------- | |
155 | |
156 procedure GG | |
157 (A : in out Unsigned_32; | |
158 B, C, D : Unsigned_32; | |
159 X : Unsigned_32; | |
160 AC : Unsigned_32; | |
161 S : Positive) | |
162 is | |
163 begin | |
164 A := A + G (B, C, D) + X + AC; | |
165 A := Rotate_Left (A, S); | |
166 A := A + B; | |
167 end GG; | |
168 | |
169 ------- | |
170 -- H -- | |
171 ------- | |
172 | |
173 function H (X, Y, Z : Unsigned_32) return Unsigned_32 is | |
174 begin | |
175 return X xor Y xor Z; | |
176 end H; | |
177 | |
178 -------- | |
179 -- HH -- | |
180 -------- | |
181 | |
182 procedure HH | |
183 (A : in out Unsigned_32; | |
184 B, C, D : Unsigned_32; | |
185 X : Unsigned_32; | |
186 AC : Unsigned_32; | |
187 S : Positive) | |
188 is | |
189 begin | |
190 A := A + H (B, C, D) + X + AC; | |
191 A := Rotate_Left (A, S); | |
192 A := A + B; | |
193 end HH; | |
194 | |
195 ------- | |
196 -- I -- | |
197 ------- | |
198 | |
199 function I (X, Y, Z : Unsigned_32) return Unsigned_32 is | |
200 begin | |
201 return Y xor (X or (not Z)); | |
202 end I; | |
203 | |
204 -------- | |
205 -- II -- | |
206 -------- | |
207 | |
208 procedure II | |
209 (A : in out Unsigned_32; | |
210 B, C, D : Unsigned_32; | |
211 X : Unsigned_32; | |
212 AC : Unsigned_32; | |
213 S : Positive) | |
214 is | |
215 begin | |
216 A := A + I (B, C, D) + X + AC; | |
217 A := Rotate_Left (A, S); | |
218 A := A + B; | |
219 end II; | |
220 | |
221 --------------- | |
222 -- Transform -- | |
223 --------------- | |
224 | |
225 procedure Transform | |
226 (H : in out Hash_State.State; | |
227 M : in out Message_State) | |
228 is | |
229 use System; | |
230 | |
231 X : array (0 .. 15) of Interfaces.Unsigned_32; | |
232 for X'Address use M.Buffer'Address; | |
233 pragma Import (Ada, X); | |
234 | |
235 AA : Unsigned_32 := H (0); | |
236 BB : Unsigned_32 := H (1); | |
237 CC : Unsigned_32 := H (2); | |
238 DD : Unsigned_32 := H (3); | |
239 | |
240 begin | |
241 if Default_Bit_Order /= Low_Order_First then | |
242 for J in X'Range loop | |
243 Swap4 (X (J)'Address); | |
244 end loop; | |
245 end if; | |
246 | |
247 -- Round 1 | |
248 | |
249 FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1 | |
250 FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2 | |
251 FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3 | |
252 FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4 | |
253 | |
254 FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5 | |
255 FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6 | |
256 FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7 | |
257 FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8 | |
258 | |
259 FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9 | |
260 FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10 | |
261 FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11 | |
262 FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12 | |
263 | |
264 FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13 | |
265 FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14 | |
266 FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15 | |
267 FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16 | |
268 | |
269 -- Round 2 | |
270 | |
271 GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17 | |
272 GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18 | |
273 GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19 | |
274 GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20 | |
275 | |
276 GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21 | |
277 GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22 | |
278 GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23 | |
279 GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24 | |
280 | |
281 GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25 | |
282 GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26 | |
283 GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27 | |
284 GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28 | |
285 | |
286 GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29 | |
287 GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30 | |
288 GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31 | |
289 GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32 | |
290 | |
291 -- Round 3 | |
292 | |
293 HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33 | |
294 HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34 | |
295 HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35 | |
296 HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36 | |
297 | |
298 HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37 | |
299 HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38 | |
300 HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39 | |
301 HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40 | |
302 | |
303 HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41 | |
304 HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42 | |
305 HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43 | |
306 HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44 | |
307 | |
308 HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45 | |
309 HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46 | |
310 HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47 | |
311 HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48 | |
312 | |
313 -- Round 4 | |
314 | |
315 II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49 | |
316 II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50 | |
317 II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51 | |
318 II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52 | |
319 | |
320 II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53 | |
321 II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54 | |
322 II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55 | |
323 II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56 | |
324 | |
325 II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57 | |
326 II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58 | |
327 II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59 | |
328 II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60 | |
329 | |
330 II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61 | |
331 II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62 | |
332 II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63 | |
333 II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64 | |
334 | |
335 H (0) := H (0) + AA; | |
336 H (1) := H (1) + BB; | |
337 H (2) := H (2) + CC; | |
338 H (3) := H (3) + DD; | |
339 | |
340 end Transform; | |
341 | |
342 end GNAT.Secure_Hashes.MD5; |