summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2009-11-30 14:45:15 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2009-11-30 14:45:15 +0000
commita719e6c5398ef2aff23a81c2a7f16d4beca9cc18 (patch)
treee7a407d411fe6cebd3380036f323670e2daea090 /gcc/ada
parent0547d011053dccb9ae4d7758d565879df37a75c0 (diff)
downloadgcc-a719e6c5398ef2aff23a81c2a7f16d4beca9cc18.tar.gz
2009-11-30 Pascal Obry <obry@adacore.com>
* expect.c: Fix cast to avoid warnings in x86-64 Windows. 2009-11-30 Thomas Quinot <quinot@adacore.com> * gnat_rm.texi, s-sechas.adb, s-sechas.ads, s-shshco.adb, s-shshco.ads, g-md5.adb, g-md5.ads, g-sha256.ads, s-shsh64.adb, s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, g-sha512.ads, g-sha1.adb, g-sha1.ads, Makefile.rtl, g-sha224.ads, g-sha384.ads, s-shsh32.adb, s-shsh32.ads, s-sehash.adb, s-sehash.ads: Reimplementation of GNAT.MD5 and GNAT.SHA1 to factor shared code and avoid unnecessary stack copies. Also introduce new functions SHA-{224,256,384,512} git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154812 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog14
-rw-r--r--gcc/ada/Makefile.rtl44
-rw-r--r--gcc/ada/expect.c4
-rw-r--r--gcc/ada/g-md5.adb535
-rw-r--r--gcc/ada/g-md5.ads95
-rw-r--r--gcc/ada/g-sha1.adb377
-rw-r--r--gcc/ada/g-sha1.ads100
-rw-r--r--gcc/ada/g-sha224.ads41
-rw-r--r--gcc/ada/g-sha256.ads41
-rw-r--r--gcc/ada/g-sha384.ads41
-rw-r--r--gcc/ada/g-sha512.ads41
-rw-r--r--gcc/ada/gnat_rm.texi43
-rw-r--r--gcc/ada/s-sechas.adb358
-rw-r--r--gcc/ada/s-sechas.ads178
-rw-r--r--gcc/ada/s-sehamd.adb340
-rw-r--r--gcc/ada/s-sehamd.ads71
-rw-r--r--gcc/ada/s-sehash.adb177
-rw-r--r--gcc/ada/s-sehash.ads69
-rw-r--r--gcc/ada/s-shsh32.adb80
-rw-r--r--gcc/ada/s-shsh32.ads105
-rw-r--r--gcc/ada/s-shsh64.adb80
-rw-r--r--gcc/ada/s-shsh64.ads129
-rw-r--r--gcc/ada/s-shshco.adb133
-rw-r--r--gcc/ada/s-shshco.ads63
24 files changed, 2084 insertions, 1075 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1c071f6b7ac..149391c7cfe 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2009-11-30 Pascal Obry <obry@adacore.com>
+
+ * expect.c: Fix cast to avoid warnings in x86-64 Windows.
+
+2009-11-30 Thomas Quinot <quinot@adacore.com>
+
+ * gnat_rm.texi, s-sechas.adb, s-sechas.ads, s-shshco.adb,
+ s-shshco.ads, g-md5.adb, g-md5.ads, g-sha256.ads, s-shsh64.adb,
+ s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, g-sha512.ads, g-sha1.adb,
+ g-sha1.ads, Makefile.rtl, g-sha224.ads, g-sha384.ads, s-shsh32.adb,
+ s-shsh32.ads, s-sehash.adb, s-sehash.ads: Reimplementation of GNAT.MD5
+ and GNAT.SHA1 to factor shared code and avoid unnecessary stack copies.
+ Also introduce new functions SHA-{224,256,384,512}
+
2009-11-30 Jerome Lambourg <lambourg@adacore.com>
* exp_ch3.adb (Make_Predefined_Primitive_Specs): Improve comment for
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 7563c448fa6..5b095292d43 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -80,9 +80,9 @@ GNATRTL_TASKING_OBJS= \
GNATRTL_NONTASKING_OBJS= \
a-assert$(objext) \
a-calari$(objext) \
+ a-calcon$(objext) \
a-caldel$(objext) \
a-calend$(objext) \
- a-calcon$(objext) \
a-calfor$(objext) \
a-catizo$(objext) \
a-cdlili$(objext) \
@@ -146,12 +146,12 @@ GNATRTL_NONTASKING_OBJS= \
a-izteio$(objext) \
a-lcteio$(objext) \
a-lfteio$(objext) \
- a-llctio$(objext) \
a-lfwtio$(objext) \
a-lfztio$(objext) \
a-liteio$(objext) \
a-liwtio$(objext) \
a-liztio$(objext) \
+ a-llctio$(objext) \
a-llftio$(objext) \
a-llfwti$(objext) \
a-llfzti$(objext) \
@@ -239,9 +239,9 @@ GNATRTL_NONTASKING_OBJS= \
a-szuzha$(objext) \
a-szuzti$(objext) \
a-tags$(objext) \
- a-tgdico$(objext) \
a-teioed$(objext) \
a-textio$(objext) \
+ a-tgdico$(objext) \
a-tiboio$(objext) \
a-ticoau$(objext) \
a-ticoio$(objext) \
@@ -337,18 +337,18 @@ GNATRTL_NONTASKING_OBJS= \
g-crc32$(objext) \
g-ctrl_c$(objext) \
g-curexc$(objext) \
- g-debuti$(objext) \
g-debpoo$(objext) \
+ g-debuti$(objext) \
g-decstr$(objext) \
g-deutst$(objext) \
g-diopit$(objext) \
g-dirope$(objext) \
- g-dyntab$(objext) \
g-dynhta$(objext) \
+ g-dyntab$(objext) \
g-encstr$(objext) \
g-enutst$(objext) \
- g-except$(objext) \
g-excact$(objext) \
+ g-except$(objext) \
g-exctra$(objext) \
g-expect$(objext) \
g-flocon$(objext) \
@@ -370,9 +370,13 @@ GNATRTL_NONTASKING_OBJS= \
g-sercom$(objext) \
g-sestin$(objext) \
g-sha1$(objext) \
+ g-sha224$(objext) \
+ g-sha256$(objext) \
+ g-sha384$(objext) \
+ g-sha512$(objext) \
g-souinf$(objext) \
- g-speche$(objext) \
g-spchge$(objext) \
+ g-speche$(objext) \
g-spipat$(objext) \
g-spitbo$(objext) \
g-sptabo$(objext) \
@@ -384,8 +388,8 @@ GNATRTL_NONTASKING_OBJS= \
g-tasloc$(objext) \
g-timsta$(objext) \
g-traceb$(objext) \
- g-utf_32$(objext) \
g-u3spch$(objext) \
+ g-utf_32$(objext) \
g-wispch$(objext) \
g-wistsp$(objext) \
g-zspche$(objext) \
@@ -430,13 +434,13 @@ GNATRTL_NONTASKING_OBJS= \
s-conca7$(objext) \
s-conca8$(objext) \
s-conca9$(objext) \
+ s-crc32$(objext) \
s-crtl$(objext) \
s-crtrun$(objext) \
- s-crc32$(objext) \
s-direio$(objext) \
s-dsaser$(objext) \
- s-exctab$(objext) \
s-except$(objext) \
+ s-exctab$(objext) \
s-exnint$(objext) \
s-exnllf$(objext) \
s-exnlli$(objext) \
@@ -453,14 +457,15 @@ GNATRTL_NONTASKING_OBJS= \
s-ficobl$(objext) \
s-fileio$(objext) \
s-filofl$(objext) \
- s-fishfl$(objext) \
s-finimp$(objext) \
s-finroo$(objext) \
+ s-fishfl$(objext) \
s-fore$(objext) \
s-fvadfl$(objext) \
s-fvaffl$(objext) \
s-fvagfl$(objext) \
s-geveop$(objext) \
+ s-gloloc$(objext) \
s-htable$(objext) \
s-imenne$(objext) \
s-imgbiu$(objext) \
@@ -479,10 +484,11 @@ GNATRTL_NONTASKING_OBJS= \
s-imgwch$(objext) \
s-imgwiu$(objext) \
s-io$(objext) \
- s-gloloc$(objext) \
s-maccod$(objext) \
s-mantis$(objext) \
s-mastop$(objext) \
+ s-memcop$(objext) \
+ s-memory$(objext) \
s-os_lib$(objext) \
s-osprim$(objext) \
s-pack03$(objext) \
@@ -556,22 +562,26 @@ GNATRTL_NONTASKING_OBJS= \
s-rident$(objext) \
s-rpc$(objext) \
s-scaval$(objext) \
+ s-sechas$(objext) \
s-secsta$(objext) \
+ s-sehamd$(objext) \
+ s-sehash$(objext) \
s-sequio$(objext) \
s-shasto$(objext) \
+ s-shsh32$(objext) \
+ s-shsh64$(objext) \
+ s-shshco$(objext) \
+ s-soflin$(objext) \
s-stache$(objext) \
+ s-stalib$(objext) \
s-stausa$(objext) \
s-stchop$(objext) \
- s-stalib$(objext) \
s-stoele$(objext) \
s-stopoo$(objext) \
s-stratt$(objext) \
s-strhas$(objext) \
- s-ststop$(objext) \
- s-soflin$(objext) \
- s-memory$(objext) \
- s-memcop$(objext) \
s-string$(objext) \
+ s-ststop$(objext) \
s-tasloc$(objext) \
s-traceb$(objext) \
s-traces$(objext) \
diff --git a/gcc/ada/expect.c b/gcc/ada/expect.c
index c013feba625..4f0f73fd15b 100644
--- a/gcc/ada/expect.c
+++ b/gcc/ada/expect.c
@@ -143,8 +143,8 @@ __gnat_pipe (int *fd)
HANDLE read, write;
CreatePipe (&read, &write, NULL, 0);
- fd[0]=_open_osfhandle ((long)read, 0);
- fd[1]=_open_osfhandle ((long)write, 0);
+ fd[0]=_open_osfhandle ((intptr_t)read, 0);
+ fd[1]=_open_osfhandle ((intptr_t)write, 0);
return 0; /* always success */
}
diff --git a/gcc/ada/g-md5.adb b/gcc/ada/g-md5.adb
index 6c1148804fd..40c5af37ab7 100644
--- a/gcc/ada/g-md5.adb
+++ b/gcc/ada/g-md5.adb
@@ -1,12 +1,12 @@
------------------------------------------------------------------------------
-- --
--- GNAT LIBRARY COMPONENTS --
+-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . M D 5 --
-- --
--- B o d y --
+-- B o d y --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
@@ -31,525 +31,8 @@
-- --
------------------------------------------------------------------------------
-with Ada.Unchecked_Conversion;
+-- This package does not require a body, since it is a package renaming. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
-package body GNAT.MD5 is
-
- use Interfaces;
-
- Padding : constant String :=
- (1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL);
-
- Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character :=
- ('0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
- -- Look-up table for each hex digit of the Message-Digest.
- -- Used by function Digest (Context).
-
- -- The sixteen values used to rotate the context words.
- -- Four for each rounds. Used in procedure Transform.
-
- -- Round 1
-
- S11 : constant := 7;
- S12 : constant := 12;
- S13 : constant := 17;
- S14 : constant := 22;
-
- -- Round 2
-
- S21 : constant := 5;
- S22 : constant := 9;
- S23 : constant := 14;
- S24 : constant := 20;
-
- -- Round 3
-
- S31 : constant := 4;
- S32 : constant := 11;
- S33 : constant := 16;
- S34 : constant := 23;
-
- -- Round 4
-
- S41 : constant := 6;
- S42 : constant := 10;
- S43 : constant := 15;
- S44 : constant := 21;
-
- type Sixteen_Words is array (Natural range 0 .. 15)
- of Interfaces.Unsigned_32;
- -- Sixteen 32-bit words, converted from block of 64 characters.
- -- Used in procedure Decode and Transform.
-
- procedure Decode
- (Block : String;
- X : out Sixteen_Words);
- -- Convert a String of 64 characters into 16 32-bit numbers
-
- -- The following functions (F, FF, G, GG, H, HH, I and II) are the
- -- equivalent of the macros of the same name in the example
- -- C implementation in the annex of RFC 1321.
-
- function F (X, Y, Z : Unsigned_32) return Unsigned_32;
- pragma Inline (F);
-
- procedure FF
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive);
- pragma Inline (FF);
-
- function G (X, Y, Z : Unsigned_32) return Unsigned_32;
- pragma Inline (G);
-
- procedure GG
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive);
- pragma Inline (GG);
-
- function H (X, Y, Z : Unsigned_32) return Unsigned_32;
- pragma Inline (H);
-
- procedure HH
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive);
- pragma Inline (HH);
-
- function I (X, Y, Z : Unsigned_32) return Unsigned_32;
- pragma Inline (I);
-
- procedure II
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive);
- pragma Inline (II);
-
- procedure Transform
- (C : in out Context;
- Block : String);
- -- Process one block of 64 characters
-
- ------------
- -- Decode --
- ------------
-
- procedure Decode
- (Block : String;
- X : out Sixteen_Words)
- is
- Cur : Positive := Block'First;
-
- begin
- pragma Assert (Block'Length = 64);
-
- for Index in X'Range loop
- X (Index) :=
- Unsigned_32 (Character'Pos (Block (Cur))) +
- Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 8) +
- Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 16) +
- Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 3))), 24);
- Cur := Cur + 4;
- end loop;
- end Decode;
-
- ------------
- -- Digest --
- ------------
-
- function Digest (C : Context) return Message_Digest is
- Result : Message_Digest;
-
- Cur : Natural := 1;
- -- Index in Result where the next character will be placed
-
- Last_Block : String (1 .. 64);
-
- C1 : Context := C;
-
- procedure Convert (X : Unsigned_32);
- -- Put the contribution of one of the four words (A, B, C, D) of the
- -- Context in Result. Increments Cur.
-
- -------------
- -- Convert --
- -------------
-
- procedure Convert (X : Unsigned_32) is
- Y : Unsigned_32 := X;
- begin
- for J in 1 .. 4 loop
- Result (Cur + 1) := Hex_Digit (Y and Unsigned_32'(16#0F#));
- Y := Shift_Right (Y, 4);
- Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
- Y := Shift_Right (Y, 4);
- Cur := Cur + 2;
- end loop;
- end Convert;
-
- -- Start of processing for Digest
-
- begin
- -- Process characters in the context buffer, if any
-
- Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
-
- -- Too many magic literals below, should be defined as constants ???
-
- if C.Last > 55 then
- Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
- Transform (C1, Last_Block);
- Last_Block := (others => ASCII.NUL);
-
- else
- Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
- end if;
-
- -- Add the input length (as stored in the context) as 8 characters
-
- Last_Block (57 .. 64) := (others => ASCII.NUL);
-
- declare
- L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
- Idx : Positive := 57;
-
- begin
- while L > 0 loop
- Last_Block (Idx) := Character'Val (L and 16#Ff#);
- L := Shift_Right (L, 8);
- Idx := Idx + 1;
- end loop;
- end;
-
- Transform (C1, Last_Block);
-
- Convert (C1.A);
- Convert (C1.B);
- Convert (C1.C);
- Convert (C1.D);
- return Result;
- end Digest;
-
- function Digest (S : String) return Message_Digest is
- C : Context;
- begin
- Update (C, S);
- return Digest (C);
- end Digest;
-
- function Digest
- (A : Ada.Streams.Stream_Element_Array) return Message_Digest
- is
- C : Context;
- begin
- Update (C, A);
- return Digest (C);
- end Digest;
-
- -------
- -- F --
- -------
-
- function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
- begin
- return (X and Y) or ((not X) and Z);
- end F;
-
- --------
- -- FF --
- --------
-
- procedure FF
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive)
- is
- begin
- A := A + F (B, C, D) + X + AC;
- A := Rotate_Left (A, S);
- A := A + B;
- end FF;
-
- -------
- -- G --
- -------
-
- function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
- begin
- return (X and Z) or (Y and (not Z));
- end G;
-
- --------
- -- GG --
- --------
-
- procedure GG
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive)
- is
- begin
- A := A + G (B, C, D) + X + AC;
- A := Rotate_Left (A, S);
- A := A + B;
- end GG;
-
- -------
- -- H --
- -------
-
- function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
- begin
- return X xor Y xor Z;
- end H;
-
- --------
- -- HH --
- --------
-
- procedure HH
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive)
- is
- begin
- A := A + H (B, C, D) + X + AC;
- A := Rotate_Left (A, S);
- A := A + B;
- end HH;
-
- -------
- -- I --
- -------
-
- function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
- begin
- return Y xor (X or (not Z));
- end I;
-
- --------
- -- II --
- --------
-
- procedure II
- (A : in out Unsigned_32;
- B, C, D : Unsigned_32;
- X : Unsigned_32;
- AC : Unsigned_32;
- S : Positive)
- is
- begin
- A := A + I (B, C, D) + X + AC;
- A := Rotate_Left (A, S);
- A := A + B;
- end II;
-
- ---------------
- -- Transform --
- ---------------
-
- procedure Transform
- (C : in out Context;
- Block : String)
- is
- X : Sixteen_Words;
-
- AA : Unsigned_32 := C.A;
- BB : Unsigned_32 := C.B;
- CC : Unsigned_32 := C.C;
- DD : Unsigned_32 := C.D;
-
- begin
- pragma Assert (Block'Length = 64);
-
- Decode (Block, X);
-
- -- Round 1
-
- FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
- FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
- FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
- FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
-
- FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
- FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
- FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
- FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
-
- FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
- FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
- FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
- FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
-
- FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
- FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
- FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
- FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
-
- -- Round 2
-
- GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
- GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
- GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
- GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
-
- GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
- GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
- GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
- GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
-
- GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
- GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
- GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
- GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
-
- GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
- GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
- GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
- GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
-
- -- Round 3
-
- HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
- HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
- HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
- HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
-
- HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
- HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
- HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
- HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
-
- HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
- HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
- HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
- HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
-
- HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
- HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
- HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
- HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
-
- -- Round 4
-
- II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
- II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
- II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
- II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
-
- II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
- II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
- II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
- II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
-
- II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
- II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
- II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
- II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
-
- II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
- II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
- II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
- II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
-
- C.A := C.A + AA;
- C.B := C.B + BB;
- C.C := C.C + CC;
- C.D := C.D + DD;
-
- end Transform;
-
- ------------
- -- Update --
- ------------
-
- procedure Update
- (C : in out Context;
- Input : String)
- is
- Inp : constant String := C.Buffer (1 .. C.Last) & Input;
- Cur : Positive := Inp'First;
-
- begin
- C.Length := C.Length + Input'Length;
-
- while Cur + 63 <= Inp'Last loop
- Transform (C, Inp (Cur .. Cur + 63));
- Cur := Cur + 64;
- end loop;
-
- C.Last := Inp'Last - Cur + 1;
- C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
- end Update;
-
- procedure Update
- (C : in out Context;
- Input : Ada.Streams.Stream_Element_Array)
- is
- subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
- subtype Stream_String is
- String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
-
- function To_String is new Ada.Unchecked_Conversion
- (Stream_Array, Stream_String);
-
- String_Input : constant String := To_String (Input);
- begin
- Update (C, String_Input);
- end Update;
-
- -----------------
- -- Wide_Digest --
- -----------------
-
- function Wide_Digest (W : Wide_String) return Message_Digest is
- C : Context;
- begin
- Wide_Update (C, W);
- return Digest (C);
- end Wide_Digest;
-
- -----------------
- -- Wide_Update --
- -----------------
-
- procedure Wide_Update
- (C : in out Context;
- Input : Wide_String)
- is
- String_Input : String (1 .. 2 * Input'Length);
- Cur : Positive := 1;
-
- begin
- for Index in Input'Range loop
- String_Input (Cur) :=
- Character'Val
- (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
- Cur := Cur + 1;
- String_Input (Cur) :=
- Character'Val
- (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
- and 16#FF#);
- Cur := Cur + 1;
- end loop;
-
- Update (C, String_Input);
- end Wide_Update;
-
-end GNAT.MD5;
+pragma No_Body;
diff --git a/gcc/ada/g-md5.ads b/gcc/ada/g-md5.ads
index cea8eb6a802..ac0985c278d 100644
--- a/gcc/ada/g-md5.ads
+++ b/gcc/ada/g-md5.ads
@@ -1,12 +1,12 @@
------------------------------------------------------------------------------
-- --
--- GNAT LIBRARY COMPONENTS --
+-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . M D 5 --
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
@@ -31,81 +31,12 @@
-- --
------------------------------------------------------------------------------
--- This package implements the MD5 Message-Digest Algorithm as described in
--- RFC 1321. The complete text of RFC 1321 can be found at:
---
--- http://www.ietf.org/rfc/rfc1321.txt
---
--- The implementation is derived from the RSA Data Security, Inc. MD5
--- Message-Digest Algorithm, as described in RFC 1321.
-
-with Ada.Streams;
-with Interfaces;
-
-package GNAT.MD5 is
-
- type Context is private;
- -- This type is the four-word (16 byte) MD buffer, as described in
- -- RFC 1321 (3.3). Its initial value is Initial_Context below.
-
- Initial_Context : constant Context;
- -- Initial value of a Context object. May be used to reinitialize
- -- a Context value by simple assignment of this value to the object.
-
- procedure Update
- (C : in out Context;
- Input : String);
- procedure Wide_Update
- (C : in out Context;
- Input : Wide_String);
- procedure Update
- (C : in out Context;
- Input : Ada.Streams.Stream_Element_Array);
- -- Modify the Context C. If C has the initial value Initial_Context,
- -- then, after a call to one of these procedures, Digest (C) will return
- -- the Message-Digest of Input.
- --
- -- These procedures may be called successively with the same context and
- -- different inputs, and these several successive calls will produce
- -- the same final context as a call with the concatenation of the inputs.
-
- subtype Message_Digest is String (1 .. 32);
- -- The string type returned by function Digest
-
- function Digest (C : Context) return Message_Digest;
- -- Extracts the Message-Digest from a context. This function should be
- -- used after one or several calls to Update.
-
- function Digest (S : String) return Message_Digest;
- function Wide_Digest (W : Wide_String) return Message_Digest;
- function Digest
- (A : Ada.Streams.Stream_Element_Array)
- return Message_Digest;
- -- These functions are equivalent to the corresponding Update (or
- -- Wide_Update) on a default initialized Context, followed by Digest
- -- on the resulting Context.
-
-private
-
- -- Magic numbers
-
- Initial_A : constant := 16#67452301#;
- Initial_B : constant := 16#EFCDAB89#;
- Initial_C : constant := 16#98BADCFE#;
- Initial_D : constant := 16#10325476#;
-
- type Context is record
- A : Interfaces.Unsigned_32 := Initial_A;
- B : Interfaces.Unsigned_32 := Initial_B;
- C : Interfaces.Unsigned_32 := Initial_C;
- D : Interfaces.Unsigned_32 := Initial_D;
- Buffer : String (1 .. 64) := (others => ASCII.NUL);
- Last : Natural := 0;
- Length : Natural := 0;
- end record;
-
- Initial_Context : constant Context :=
- (A => Initial_A, B => Initial_B, C => Initial_C, D => Initial_D,
- Buffer => (others => ASCII.NUL), Last => 0, Length => 0);
-
-end GNAT.MD5;
+with System.Secure_Hashes.MD5;
+package GNAT.MD5 is new System.Secure_Hashes.H
+ (Block_Words => System.Secure_Hashes.MD5.Block_Words,
+ State_Words => 4,
+ Hash_Words => 4,
+ Hash_Bit_Order => System.Low_Order_First,
+ Hash_State => System.Secure_Hashes.MD5.Hash_State,
+ Initial_State => System.Secure_Hashes.MD5.Initial_State,
+ Transform => System.Secure_Hashes.MD5.Transform);
diff --git a/gcc/ada/g-sha1.adb b/gcc/ada/g-sha1.adb
index 72b19244a36..91253934786 100644
--- a/gcc/ada/g-sha1.adb
+++ b/gcc/ada/g-sha1.adb
@@ -1,379 +1,36 @@
------------------------------------------------------------------------------
-- --
--- GNAT LIBRARY COMPONENTS --
+-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 1 --
-- --
--- B o d y --
+-- B o d y --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
--- Note: the code for this unit is derived from GNAT.MD5
-
-with Ada.Unchecked_Conversion;
-
-package body GNAT.SHA1 is
-
- use Interfaces;
-
- Padding : constant String :=
- (1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL);
-
- Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character :=
- ('0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
- -- Look-up table for each hex digit of the Message-Digest.
- -- Used by function Digest (Context).
-
- type Sixteen_Words is array (Natural range 0 .. 15)
- of Interfaces.Unsigned_32;
- -- Sixteen 32-bit words, converted from block of 64 characters.
- -- Used in procedure Decode and Transform.
-
- procedure Decode (Block : String; X : out Sixteen_Words);
- -- Convert a String of 64 characters into 16 32-bit numbers
-
- -- The following functions are the four elementary components of each
- -- of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79)
- -- defined in RFC 3174.
-
- function F0 (B, C, D : Unsigned_32) return Unsigned_32;
- pragma Inline (F0);
-
- function F1 (B, C, D : Unsigned_32) return Unsigned_32;
- pragma Inline (F1);
-
- function F2 (B, C, D : Unsigned_32) return Unsigned_32;
- pragma Inline (F2);
-
- function F3 (B, C, D : Unsigned_32) return Unsigned_32;
- pragma Inline (F3);
-
- procedure Transform (Ctx : in out Context; Block : String);
- -- Process one block of 64 characters
-
- ------------
- -- Decode --
- ------------
-
- procedure Decode (Block : String; X : out Sixteen_Words) is
- Cur : Positive := Block'First;
-
- begin
- pragma Assert (Block'Length = 64);
-
- for Index in X'Range loop
- X (Index) :=
- Unsigned_32 (Character'Pos (Block (Cur + 3))) +
- Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 8) +
- Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 16) +
- Shift_Left (Unsigned_32 (Character'Pos (Block (Cur))), 24);
- Cur := Cur + 4;
- end loop;
- end Decode;
-
- ------------
- -- Digest --
- ------------
-
- function Digest (C : Context) return Message_Digest is
- Result : Message_Digest;
-
- Cur : Natural := 1;
- -- Index in Result where the next character will be placed
-
- Last_Block : String (1 .. 64);
-
- C1 : Context := C;
-
- procedure Convert (X : Unsigned_32);
- -- Put the contribution of one of the five H words of the Context in
- -- Result. Increments Cur.
-
- -------------
- -- Convert --
- -------------
-
- procedure Convert (X : Unsigned_32) is
- Y : Unsigned_32 := X;
- begin
- for J in 1 .. 8 loop
- Y := Rotate_Left (Y, 4);
- Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
- Cur := Cur + 1;
- end loop;
- end Convert;
-
- -- Start of processing for Digest
-
- begin
- -- Process characters in the context buffer, if any
-
- pragma Assert (C.Last /= C.Buffer'Last);
- Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
-
- if C.Last > 55 then
- Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
- Transform (C1, Last_Block);
- Last_Block := (others => ASCII.NUL);
-
- else
- Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
- end if;
-
- -- Add the input length (as stored in the context) as 8 characters
-
- Last_Block (57 .. 64) := (others => ASCII.NUL);
-
- declare
- L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
- Idx : Positive := 64;
- begin
- while L > 0 loop
- Last_Block (Idx) := Character'Val (L and 16#Ff#);
- L := Shift_Right (L, 8);
- Idx := Idx - 1;
- end loop;
- end;
-
- Transform (C1, Last_Block);
-
- Convert (C1.H (0));
- Convert (C1.H (1));
- Convert (C1.H (2));
- Convert (C1.H (3));
- Convert (C1.H (4));
- return Result;
- end Digest;
-
- function Digest (S : String) return Message_Digest is
- C : Context;
- begin
- Update (C, S);
- return Digest (C);
- end Digest;
-
- function Digest
- (A : Ada.Streams.Stream_Element_Array) return Message_Digest
- is
- C : Context;
- begin
- Update (C, A);
- return Digest (C);
- end Digest;
-
- --------
- -- F0 --
- --------
-
- function F0
- (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
- is
- begin
- return (B and C) or ((not B) and D);
- end F0;
-
- --------
- -- F1 --
- --------
-
- function F1
- (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
- is
- begin
- return B xor C xor D;
- end F1;
-
- --------
- -- F2 --
- --------
-
- function F2
- (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
- is
- begin
- return (B and C) or (B and D) or (C and D);
- end F2;
-
- --------
- -- F3 --
- --------
-
- function F3
- (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
- renames F1;
-
- ---------------
- -- Transform --
- ---------------
-
- procedure Transform
- (Ctx : in out Context;
- Block : String)
- is
- W : array (0 .. 79) of Interfaces.Unsigned_32;
-
- A, B, C, D, E, Temp : Interfaces.Unsigned_32;
-
- begin
- pragma Assert (Block'Length = 64);
-
- -- a. Divide data block into sixteen words
-
- Decode (Block, Sixteen_Words (W (0 .. 15)));
-
- -- b. Prepare working block of 80 words
-
- for T in 16 .. 79 loop
-
- -- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
-
- W (T) := Rotate_Left
- (W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
-
- end loop;
-
- -- c. Set up transformation variables
-
- A := Ctx.H (0);
- B := Ctx.H (1);
- C := Ctx.H (2);
- D := Ctx.H (3);
- E := Ctx.H (4);
-
- -- d. For each of the 80 rounds, compute:
-
- -- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
- -- E = D; D = C; C = S^30(B); B = A; A = TEMP;
-
- for T in 0 .. 19 loop
- Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
- E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
- end loop;
-
- for T in 20 .. 39 loop
- Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
- E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
- end loop;
-
- for T in 40 .. 59 loop
- Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
- E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
- end loop;
-
- for T in 60 .. 79 loop
- Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
- E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
- end loop;
-
- -- e. Update context:
- -- H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
-
- Ctx.H (0) := Ctx.H (0) + A;
- Ctx.H (1) := Ctx.H (1) + B;
- Ctx.H (2) := Ctx.H (2) + C;
- Ctx.H (3) := Ctx.H (3) + D;
- Ctx.H (4) := Ctx.H (4) + E;
- end Transform;
-
- ------------
- -- Update --
- ------------
-
- procedure Update
- (C : in out Context;
- Input : String)
- is
- Inp : constant String := C.Buffer (1 .. C.Last) & Input;
- Cur : Positive := Inp'First;
-
- begin
- C.Length := C.Length + Input'Length;
-
- while Cur + 63 <= Inp'Last loop
- Transform (C, Inp (Cur .. Cur + 63));
- Cur := Cur + 64;
- end loop;
-
- C.Last := Inp'Last - Cur + 1;
- C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
- end Update;
-
- procedure Update
- (C : in out Context;
- Input : Ada.Streams.Stream_Element_Array)
- is
- subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
- subtype Stream_String is
- String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
-
- function To_String is new Ada.Unchecked_Conversion
- (Stream_Array, Stream_String);
-
- String_Input : constant String := To_String (Input);
- begin
- Update (C, String_Input);
- end Update;
-
- -----------------
- -- Wide_Digest --
- -----------------
-
- function Wide_Digest (W : Wide_String) return Message_Digest is
- C : Context;
- begin
- Wide_Update (C, W);
- return Digest (C);
- end Wide_Digest;
-
- -----------------
- -- Wide_Update --
- -----------------
-
- procedure Wide_Update
- (C : in out Context;
- Input : Wide_String)
- is
- String_Input : String (1 .. 2 * Input'Length);
- Cur : Positive := 1;
-
- begin
- for Index in Input'Range loop
- String_Input (Cur) :=
- Character'Val
- (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
- Cur := Cur + 1;
- String_Input (Cur) :=
- Character'Val
- (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
- and 16#FF#);
- Cur := Cur + 1;
- end loop;
-
- Update (C, String_Input);
- end Wide_Update;
+-- This package does not require a body, since it is a package renaming. We
+-- provide a dummy file containing a No_Body pragma so that previous versions
+-- of the body (which did exist) will not interfere.
-end GNAT.SHA1;
+pragma No_Body;
diff --git a/gcc/ada/g-sha1.ads b/gcc/ada/g-sha1.ads
index 36e2e25d853..912510bdd77 100644
--- a/gcc/ada/g-sha1.ads
+++ b/gcc/ada/g-sha1.ads
@@ -1,12 +1,12 @@
------------------------------------------------------------------------------
-- --
--- GNAT LIBRARY COMPONENTS --
+-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 1 --
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
@@ -31,86 +31,12 @@
-- --
------------------------------------------------------------------------------
--- This package implements the US Secure Hash Algorithm 1 (SHA1) as described
--- in RFC 3174. The complete text of RFC 3174 can be found at:
-
--- http://www.ietf.org/rfc/rfc3174.txt
-
--- Note: the code for this unit is derived from GNAT.MD5
-
-with Ada.Streams;
-with Interfaces;
-
-package GNAT.SHA1 is
-
- type Context is private;
- -- This type holds the five-word (20 byte) buffer H, as described in
- -- RFC 3174 (6.1). Its initial value is Initial_Context below.
-
- Initial_Context : constant Context;
- -- Initial value of a Context object. May be used to reinitialize
- -- a Context value by simple assignment of this value to the object.
-
- procedure Update
- (C : in out Context;
- Input : String);
- procedure Wide_Update
- (C : in out Context;
- Input : Wide_String);
- procedure Update
- (C : in out Context;
- Input : Ada.Streams.Stream_Element_Array);
- -- Modify the Context C. If C has the initial value Initial_Context,
- -- then, after a call to one of these procedures, Digest (C) will return
- -- the Message-Digest of Input.
- --
- -- These procedures may be called successively with the same context and
- -- different inputs, and these several successive calls will produce
- -- the same final context as a call with the concatenation of the inputs.
-
- subtype Message_Digest is String (1 .. 40);
- -- The string type returned by function Digest
-
- function Digest (C : Context) return Message_Digest;
- -- Extracts the Message-Digest from a context. This function should be
- -- used after one or several calls to Update.
-
- function Digest (S : String) return Message_Digest;
- function Wide_Digest (W : Wide_String) return Message_Digest;
- function Digest
- (A : Ada.Streams.Stream_Element_Array) return Message_Digest;
- -- These functions are equivalent to the corresponding Update (or
- -- Wide_Update) on a default initialized Context, followed by Digest
- -- on the resulting Context.
-
-private
-
- -- Magic numbers
-
- Initial_H0 : constant := 16#67452301#;
- Initial_H1 : constant := 16#EFCDAB89#;
- Initial_H2 : constant := 16#98BADCFE#;
- Initial_H3 : constant := 16#10325476#;
- Initial_H4 : constant := 16#C3D2E1F0#;
-
- type H_Type is array (0 .. 4) of Interfaces.Unsigned_32;
-
- Initial_H : constant H_Type :=
- (0 => Initial_H0,
- 1 => Initial_H1,
- 2 => Initial_H2,
- 3 => Initial_H3,
- 4 => Initial_H4);
-
- type Context is record
- H : H_Type := Initial_H;
- Buffer : String (1 .. 64) := (others => ASCII.NUL);
- Last : Natural := 0;
- Length : Natural := 0;
- end record;
-
- Initial_Context : constant Context :=
- (H => Initial_H,
- Buffer => (others => ASCII.NUL), Last => 0, Length => 0);
-
-end GNAT.SHA1;
+with System.Secure_Hashes.SHA1;
+package GNAT.SHA1 is new System.Secure_Hashes.H
+ (Block_Words => System.Secure_Hashes.SHA1.Block_Words,
+ State_Words => 5,
+ Hash_Words => 5,
+ Hash_Bit_Order => System.High_Order_First,
+ Hash_State => System.Secure_Hashes.SHA1.Hash_State,
+ Initial_State => System.Secure_Hashes.SHA1.Initial_State,
+ Transform => System.Secure_Hashes.SHA1.Transform);
diff --git a/gcc/ada/g-sha224.ads b/gcc/ada/g-sha224.ads
new file mode 100644
index 00000000000..1a6391d6229
--- /dev/null
+++ b/gcc/ada/g-sha224.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S H A 2 2 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Secure_Hashes.SHA2_Common;
+with System.Secure_Hashes.SHA2_32;
+package GNAT.SHA224 is new System.Secure_Hashes.H
+ (Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
+ State_Words => 8,
+ Hash_Words => 7,
+ Hash_Bit_Order => System.High_Order_First,
+ Hash_State => System.Secure_Hashes.SHA2_32.Hash_State,
+ Initial_State => System.Secure_Hashes.SHA2_32.SHA224_Init_State,
+ Transform => System.Secure_Hashes.SHA2_32.Transform);
diff --git a/gcc/ada/g-sha256.ads b/gcc/ada/g-sha256.ads
new file mode 100644
index 00000000000..6f3de58986c
--- /dev/null
+++ b/gcc/ada/g-sha256.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S H A 2 5 6 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Secure_Hashes.SHA2_Common;
+with System.Secure_Hashes.SHA2_32;
+package GNAT.SHA256 is new System.Secure_Hashes.H
+ (Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
+ State_Words => 8,
+ Hash_Words => 8,
+ Hash_Bit_Order => System.High_Order_First,
+ Hash_State => System.Secure_Hashes.SHA2_32.Hash_State,
+ Initial_State => System.Secure_Hashes.SHA2_32.SHA256_Init_State,
+ Transform => System.Secure_Hashes.SHA2_32.Transform);
diff --git a/gcc/ada/g-sha384.ads b/gcc/ada/g-sha384.ads
new file mode 100644
index 00000000000..5fcd180e570
--- /dev/null
+++ b/gcc/ada/g-sha384.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S H A 3 8 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Secure_Hashes.SHA2_Common;
+with System.Secure_Hashes.SHA2_64;
+package GNAT.SHA384 is new System.Secure_Hashes.H
+ (Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
+ State_Words => 8,
+ Hash_Words => 6,
+ Hash_Bit_Order => System.High_Order_First,
+ Hash_State => System.Secure_Hashes.SHA2_64.Hash_State,
+ Initial_State => System.Secure_Hashes.SHA2_64.SHA384_Init_State,
+ Transform => System.Secure_Hashes.SHA2_64.Transform);
diff --git a/gcc/ada/g-sha512.ads b/gcc/ada/g-sha512.ads
new file mode 100644
index 00000000000..7b39512c41c
--- /dev/null
+++ b/gcc/ada/g-sha512.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S H A 5 1 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Secure_Hashes.SHA2_Common;
+with System.Secure_Hashes.SHA2_64;
+package GNAT.SHA512 is new System.Secure_Hashes.H
+ (Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
+ State_Words => 8,
+ Hash_Words => 8,
+ Hash_Bit_Order => System.High_Order_First,
+ Hash_State => System.Secure_Hashes.SHA2_64.Hash_State,
+ Initial_State => System.Secure_Hashes.SHA2_64.SHA512_Init_State,
+ Transform => System.Secure_Hashes.SHA2_64.Transform);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 2f09ddcc7ae..46823f9ebad 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -377,6 +377,10 @@ The GNAT Library
* GNAT.Semaphores (g-semaph.ads)::
* GNAT.Serial_Communications (g-sercom.ads)::
* GNAT.SHA1 (g-sha1.ads)::
+* GNAT.SHA224 (g-sha224.ads)::
+* GNAT.SHA256 (g-sha256.ads)::
+* GNAT.SHA384 (g-sha384.ads)::
+* GNAT.SHA512 (g-sha512.ads)::
* GNAT.Signals (g-signal.ads)::
* GNAT.Sockets (g-socket.ads)::
* GNAT.Source_Info (g-souinf.ads)::
@@ -13554,6 +13558,10 @@ of GNAT, and will generate a warning message.
* GNAT.Semaphores (g-semaph.ads)::
* GNAT.Serial_Communications (g-sercom.ads)::
* GNAT.SHA1 (g-sha1.ads)::
+* GNAT.SHA224 (g-sha224.ads)::
+* GNAT.SHA256 (g-sha256.ads)::
+* GNAT.SHA384 (g-sha384.ads)::
+* GNAT.SHA512 (g-sha512.ads)::
* GNAT.Signals (g-signal.ads)::
* GNAT.Sockets (g-socket.ads)::
* GNAT.Source_Info (g-souinf.ads)::
@@ -14551,7 +14559,40 @@ port. This is only supported on GNU/Linux and Windows.
@cindex Secure Hash Algorithm SHA-1
@noindent
-Implements the SHA-1 Secure Hash Algorithm as described in RFC 3174.
+Implements the SHA-1 Secure Hash Algorithm as described in FIPS PUB 180-3
+and RFC 3174.
+
+@node GNAT.SHA224 (g-sha224.ads)
+@section @code{GNAT.SHA224} (@file{g-sha224.ads})
+@cindex @code{GNAT.SHA224} (@file{g-sha224.ads})
+@cindex Secure Hash Algorithm SHA-224
+
+@noindent
+Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3.
+
+@node GNAT.SHA256 (g-sha256.ads)
+@section @code{GNAT.SHA256} (@file{g-sha256.ads})
+@cindex @code{GNAT.SHA256} (@file{g-sha256.ads})
+@cindex Secure Hash Algorithm SHA-256
+
+@noindent
+Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3.
+
+@node GNAT.SHA384 (g-sha384.ads)
+@section @code{GNAT.SHA384} (@file{g-sha384.ads})
+@cindex @code{GNAT.SHA384} (@file{g-sha384.ads})
+@cindex Secure Hash Algorithm SHA-384
+
+@noindent
+Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3.
+
+@node GNAT.SHA512 (g-sha512.ads)
+@section @code{GNAT.SHA512} (@file{g-sha512.ads})
+@cindex @code{GNAT.SHA512} (@file{g-sha512.ads})
+@cindex Secure Hash Algorithm SHA-512
+
+@noindent
+Implements the SHA-512 Secure Hash Algorithm as described in FIPS PUB 180-3.
@node GNAT.Signals (g-signal.ads)
@section @code{GNAT.Signals} (@file{g-signal.ads})
diff --git a/gcc/ada/s-sechas.adb b/gcc/ada/s-sechas.adb
new file mode 100644
index 00000000000..72121eb5a7f
--- /dev/null
+++ b/gcc/ada/s-sechas.adb
@@ -0,0 +1,358 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System; use System;
+with Interfaces; use Interfaces;
+
+package body System.Secure_Hashes is
+
+ use Ada.Streams;
+
+ Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character :=
+ ('0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
+
+ type Fill_Buffer_Access is
+ access procedure
+ (M : in out Message_State;
+ S : String;
+ First : Natural;
+ Last : out Natural);
+ -- A procedure to transfer data from S into M's block buffer until either
+ -- the block buffer is full or all data from S has been consumed.
+
+ procedure Fill_Buffer_Copy
+ (M : in out Message_State;
+ S : String;
+ First : Natural;
+ Last : out Natural);
+ -- Transfer procedure which just copies data from S to M
+
+ procedure Fill_Buffer_Swap
+ (M : in out Message_State;
+ S : String;
+ First : Natural;
+ Last : out Natural);
+ -- Transfer procedure which swaps bytes from S when copying into M
+
+ procedure To_String (SEA : Stream_Element_Array; S : out String);
+ -- Return the hexadecimal representation of SEA
+
+ ----------------------
+ -- Fill_Buffer_Copy --
+ ----------------------
+
+ procedure Fill_Buffer_Copy
+ (M : in out Message_State;
+ S : String;
+ First : Natural;
+ Last : out Natural)
+ is
+ Buf_String : String (M.Buffer'Range);
+ for Buf_String'Address use M.Buffer'Address;
+ pragma Import (Ada, Buf_String);
+ Length : constant Natural :=
+ Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
+ begin
+ pragma Assert (Length > 0);
+
+ Buf_String (M.Last + 1 .. M.Last + Length) :=
+ S (First .. First + Length);
+ M.Last := M.Last + Length;
+ Last := First + Length - 1;
+ end Fill_Buffer_Copy;
+
+ ----------------------
+ -- Fill_Buffer_Swap --
+ ----------------------
+
+ procedure Fill_Buffer_Swap
+ (M : in out Message_State;
+ S : String;
+ First : Natural;
+ Last : out Natural)
+ is
+ Length : constant Natural :=
+ Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
+ begin
+ Last := First;
+ while Last - First < Length loop
+ M.Buffer (M.Last + 1 + Last - First) :=
+ (if (Last - First) mod 2 = 0 then S (Last + 1) else S (Last - 1));
+ Last := Last + 1;
+ end loop;
+ M.Last := M.Last + Length;
+ Last := First + Length - 1;
+ end Fill_Buffer_Swap;
+
+ ---------------
+ -- To_String --
+ ---------------
+
+ procedure To_String (SEA : Stream_Element_Array; S : out String) is
+ pragma Assert (S'Length = 2 * SEA'Length);
+ begin
+ for J in SEA'Range loop
+ declare
+ S_J : constant Natural := 1 + Natural (J - SEA'First) * 2;
+ begin
+ S (S_J) := Hex_Digit (SEA (J) / 16);
+ S (S_J + 1) := Hex_Digit (SEA (J) mod 16);
+ end;
+ end loop;
+ end To_String;
+
+ -------
+ -- H --
+ -------
+
+ package body H is
+
+ procedure Update
+ (C : in out Context;
+ S : String;
+ Fill_Buffer : Fill_Buffer_Access);
+ -- Internal common routine for all Update procedures
+
+ procedure Final
+ (C : Context;
+ Hash_Bits : out Ada.Streams.Stream_Element_Array);
+ -- Perform final hashing operations (data padding) and extract the
+ -- (possibly truncated) state of C into Hash_Bits.
+
+ ------------
+ -- Digest --
+ ------------
+
+ function Digest (C : Context) return Message_Digest is
+ Hash_Bits : Stream_Element_Array
+ (1 .. Stream_Element_Offset (Hash_Length));
+ begin
+ Final (C, Hash_Bits);
+ return MD : Message_Digest do
+ To_String (Hash_Bits, MD);
+ end return;
+ end Digest;
+
+ ------------
+ -- Digest --
+ ------------
+
+ function Digest (S : String) return Message_Digest is
+ C : Context;
+ begin
+ Update (C, S);
+ return Digest (C);
+ end Digest;
+
+ ------------
+ -- Digest --
+ ------------
+
+ function Digest (A : Stream_Element_Array) return Message_Digest is
+ C : Context;
+ begin
+ Update (C, A);
+ return Digest (C);
+ end Digest;
+
+ -----------
+ -- Final --
+ -----------
+
+ -- Once a complete message has been processed, it is padded with one
+ -- 1 bit followed by enough 0 bits so that the last block is
+ -- 2 * Word'Size bits short of being completed. The last 2 * Word'Size
+ -- bits are set to the message size in bits (excluding padding).
+
+ procedure Final
+ (C : Context;
+ Hash_Bits : out Stream_Element_Array)
+ is
+ FC : Context := C;
+
+ Zeroes : Natural;
+ -- Number of 0 bytes in padding
+
+ Message_Length : Unsigned_64 := FC.M_State.Length;
+ -- Message length in bytes
+
+ Size_Length : constant Natural :=
+ 2 * Hash_State.Word'Size / 8;
+ -- Length in bytes of the size representation
+
+ begin
+ Zeroes := (Block_Length - 1 - Size_Length - FC.M_State.Last)
+ mod FC.M_State.Block_Length;
+ declare
+ Pad : String (1 .. 1 + Zeroes + Size_Length) :=
+ (1 => Character'Val (128), others => ASCII.NUL);
+ Index : Natural;
+ First_Index : Natural;
+ begin
+ First_Index := (if Hash_Bit_Order = Low_Order_First then
+ Pad'Last - Size_Length + 1
+ else
+ Pad'Last);
+
+ Index := First_Index;
+ while Message_Length > 0 loop
+ if Index = First_Index then
+ -- Message_Length is in bytes, but we need to store it as
+ -- a bit count).
+
+ Pad (Index) := Character'Val
+ (Shift_Left (Message_Length and 16#1f#, 3));
+ Message_Length := Shift_Right (Message_Length, 5);
+ else
+ Pad (Index) := Character'Val (Message_Length and 16#ff#);
+ Message_Length := Shift_Right (Message_Length, 8);
+ end if;
+ Index := Index +
+ (if Hash_Bit_Order = Low_Order_First then 1 else -1);
+ end loop;
+
+ Update (FC, Pad);
+ end;
+
+ pragma Assert (FC.M_State.Last = 0);
+
+ Hash_State.To_Hash (FC.H_State, Hash_Bits);
+ end Final;
+
+ ------------
+ -- Update --
+ ------------
+
+ procedure Update
+ (C : in out Context;
+ S : String;
+ Fill_Buffer : Fill_Buffer_Access)
+ is
+ Last : Natural := S'First - 1;
+ begin
+ C.M_State.Length := C.M_State.Length + S'Length;
+
+ while Last < S'Last loop
+ Fill_Buffer (C.M_State, S, Last + 1, Last);
+
+ if C.M_State.Last = Block_Length then
+ Transform (C.H_State, C.M_State);
+ C.M_State.Last := 0;
+ end if;
+ end loop;
+
+ end Update;
+
+ ------------
+ -- Update --
+ ------------
+
+ procedure Update (C : in out Context; Input : String) is
+ begin
+ Update (C, Input, Fill_Buffer_Copy'Access);
+ end Update;
+
+ ------------
+ -- Update --
+ ------------
+
+ procedure Update (C : in out Context; Input : Stream_Element_Array) is
+ S : String (1 .. Input'Length);
+ for S'Address use Input'Address;
+ pragma Import (Ada, S);
+ begin
+ Update (C, S, Fill_Buffer_Copy'Access);
+ end Update;
+
+ -----------------
+ -- Wide_Update --
+ -----------------
+
+ procedure Wide_Update (C : in out Context; Input : Wide_String) is
+ S : String (1 .. 2 * Input'Length);
+ for S'Address use Input'Address;
+ pragma Import (Ada, S);
+ begin
+ Update
+ (C, S,
+ (if System.Default_Bit_Order /= Low_Order_First
+ then Fill_Buffer_Swap'Access
+ else Fill_Buffer_Copy'Access));
+ end Wide_Update;
+
+ -----------------
+ -- Wide_Digest --
+ -----------------
+
+ function Wide_Digest (W : Wide_String) return Message_Digest is
+ C : Context;
+ begin
+ Wide_Update (C, W);
+ return Digest (C);
+ end Wide_Digest;
+
+ end H;
+
+ -------------------------
+ -- Hash_Function_State --
+ -------------------------
+
+ package body Hash_Function_State is
+
+ -------------
+ -- To_Hash --
+ -------------
+
+ procedure To_Hash (H : State; H_Bits : out Stream_Element_Array) is
+ Hash_Words : constant Natural := H'Size / Word'Size;
+ Result : State (1 .. Hash_Words) :=
+ H (H'Last - Hash_Words + 1 .. H'Last);
+
+ R_SEA : Stream_Element_Array (1 .. Result'Size / 8);
+ for R_SEA'Address use Result'Address;
+ pragma Import (Ada, R_SEA);
+ begin
+ if System.Default_Bit_Order /= Hash_Bit_Order then
+ for J in Result'Range loop
+ Swap (Result (J)'Address);
+ end loop;
+ end if;
+
+ -- Return truncated hash
+
+ pragma Assert (H_Bits'Length <= R_SEA'Length);
+ H_Bits := R_SEA (R_SEA'First .. R_SEA'First + H_Bits'Length - 1);
+ end To_Hash;
+
+ end Hash_Function_State;
+
+end System.Secure_Hashes;
diff --git a/gcc/ada/s-sechas.ads b/gcc/ada/s-sechas.ads
new file mode 100644
index 00000000000..3d9bc7635c0
--- /dev/null
+++ b/gcc/ada/s-sechas.ads
@@ -0,0 +1,178 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides common suporting code for a family of secure
+-- hash functions (including MD5 and the FIPS PUB 180-3 functions SHA-1,
+-- SHA-224, SHA-256, SHA-384 and SHA-512).
+
+with Ada.Streams;
+with Interfaces;
+
+package System.Secure_Hashes is
+
+ type Buffer_Type is new String;
+ for Buffer_Type'Alignment use 8;
+ -- Secure hash functions use a string buffer that is also accessed as an
+ -- array of words, which may require up to 64 bit alignment.
+
+ -- The function-independent part of processing state:
+ -- A buffer of data being accumulated until a complete block is ready for
+ -- hashing.
+
+ type Message_State (Block_Length : Natural) is record
+ Last : Natural := 0;
+ -- Index of last used element in Buffer
+
+ Length : Interfaces.Unsigned_64 := 0;
+ -- Total length of processed data
+
+ Buffer : Buffer_Type (1 .. Block_Length);
+ -- Data buffer
+ end record;
+
+ -- The function-specific part of processing state:
+ -- Each hash function maintains an internal state as an array of words,
+ -- which is ultimately converted to a stream representation with the
+ -- appropriate bit order.
+
+ generic
+ type Word is mod <>;
+ -- Either 32 or 64 bits
+
+ with procedure Swap (X : System.Address);
+ -- Byte swapping function for a Word at X
+
+ Hash_Bit_Order : System.Bit_Order;
+ -- Bit order of the produced hash
+
+ package Hash_Function_State is
+
+ type State is array (Natural range <>) of Word;
+ -- Used to store a hash function's internal state
+
+ procedure To_Hash
+ (H : State;
+ H_Bits : out Ada.Streams.Stream_Element_Array);
+ -- Convert H to stream representation with the given bit order.
+ -- If H_Bits is smaller than the internal hash state, then the state
+ -- is truncated.
+
+ end Hash_Function_State;
+
+ -- Generic hashing framework:
+ -- The user interface for each implemented secure hash function is an
+ -- instance of this generic package.
+
+ generic
+ Block_Words : Natural;
+ -- Number of words in each block
+
+ State_Words : Natural;
+ -- Number of words in internal state
+
+ Hash_Words : Natural;
+ -- Number of words in the final hash (must be no greater than
+ -- State_Words).
+
+ Hash_Bit_Order : System.Bit_Order;
+ -- Bit order used for conversion between bit representation and word
+ -- representation.
+
+ with package Hash_State is new Hash_Function_State (<>);
+ -- Hash function state package
+
+ Initial_State : Hash_State.State;
+ -- Initial value of the hash function state
+
+ with procedure Transform
+ (H : in out Hash_State.State;
+ M : in out Message_State);
+ -- Transformation function updating H by processing a complete data
+ -- block from M.
+
+ package H is
+
+ pragma Assert (Hash_Words <= State_Words);
+
+ type Context is private;
+ -- The internal processing state of the hashing function
+
+ Initial_Context : constant Context;
+ -- Initial value of a Context object. May be used to reinitialize
+ -- a Context value by simple assignment of this value to the object.
+
+ procedure Update (C : in out Context; Input : String);
+ procedure Wide_Update (C : in out Context; Input : Wide_String);
+ procedure Update
+ (C : in out Context; Input : Ada.Streams.Stream_Element_Array);
+ -- Update C to process the given input. Successive calls to
+ -- Update are equivalent to a single call with the concatenation
+ -- of the inputs. For the Wide_String version, each Wide_Character is
+ -- processed low order byte first.
+
+ Word_Length : constant Natural := Hash_State.Word'Size / 8;
+ Hash_Length : constant Natural := Hash_Words * Word_Length;
+
+ subtype Message_Digest is String (1 .. 2 * Hash_Length);
+ -- The fixed-length string returned by Digest, providing the
+ -- hash in hexadecimal representation.
+
+ function Digest (C : Context) return Message_Digest;
+ -- Return the hash for the data accumulated with C in hexadecimal
+ -- representation.
+
+ function Digest (S : String) return Message_Digest;
+ function Wide_Digest (W : Wide_String) return Message_Digest;
+ function Digest
+ (A : Ada.Streams.Stream_Element_Array) return Message_Digest;
+ -- These functions are equivalent to the corresponding Update (or
+ -- Wide_Update) on a default initialized Context, followed by Digest
+ -- on the resulting Context.
+
+ private
+
+ Block_Length : constant Natural := Block_Words * Word_Length;
+ -- Length in bytes of a data block
+
+ type Context is record
+ H_State : Hash_State.State (0 .. State_Words - 1) := Initial_State;
+ -- Function-specific state
+
+ M_State : Message_State (Block_Length);
+ -- Function-independent state (block buffer)
+ end record;
+
+ Initial_Context : constant Context := (others => <>);
+ -- Initial values are provided by default initialization of Context
+
+ end H;
+
+end System.Secure_Hashes;
diff --git a/gcc/ada/s-sehamd.adb b/gcc/ada/s-sehamd.adb
new file mode 100644
index 00000000000..30fff896364
--- /dev/null
+++ b/gcc/ada/s-sehamd.adb
@@ -0,0 +1,340 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . M D 5 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with GNAT.Byte_Swapping; use GNAT.Byte_Swapping;
+
+package body System.Secure_Hashes.MD5 is
+
+ use Interfaces;
+
+ -- The sixteen values used to rotate the context words.
+ -- Four for each rounds. Used in procedure Transform.
+
+ -- Round 1
+
+ S11 : constant := 7;
+ S12 : constant := 12;
+ S13 : constant := 17;
+ S14 : constant := 22;
+
+ -- Round 2
+
+ S21 : constant := 5;
+ S22 : constant := 9;
+ S23 : constant := 14;
+ S24 : constant := 20;
+
+ -- Round 3
+
+ S31 : constant := 4;
+ S32 : constant := 11;
+ S33 : constant := 16;
+ S34 : constant := 23;
+
+ -- Round 4
+
+ S41 : constant := 6;
+ S42 : constant := 10;
+ S43 : constant := 15;
+ S44 : constant := 21;
+
+ -- The following functions (F, FF, G, GG, H, HH, I and II) are the
+ -- equivalent of the macros of the same name in the example
+ -- C implementation in the annex of RFC 1321.
+
+ function F (X, Y, Z : Unsigned_32) return Unsigned_32;
+ pragma Inline (F);
+
+ procedure FF
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive);
+ pragma Inline (FF);
+
+ function G (X, Y, Z : Unsigned_32) return Unsigned_32;
+ pragma Inline (G);
+
+ procedure GG
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive);
+ pragma Inline (GG);
+
+ function H (X, Y, Z : Unsigned_32) return Unsigned_32;
+ pragma Inline (H);
+
+ procedure HH
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive);
+ pragma Inline (HH);
+
+ function I (X, Y, Z : Unsigned_32) return Unsigned_32;
+ pragma Inline (I);
+
+ procedure II
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive);
+ pragma Inline (II);
+
+ -------
+ -- F --
+ -------
+
+ function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
+ begin
+ return (X and Y) or ((not X) and Z);
+ end F;
+
+ --------
+ -- FF --
+ --------
+
+ procedure FF
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive)
+ is
+ begin
+ A := A + F (B, C, D) + X + AC;
+ A := Rotate_Left (A, S);
+ A := A + B;
+ end FF;
+
+ -------
+ -- G --
+ -------
+
+ function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
+ begin
+ return (X and Z) or (Y and (not Z));
+ end G;
+
+ --------
+ -- GG --
+ --------
+
+ procedure GG
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive)
+ is
+ begin
+ A := A + G (B, C, D) + X + AC;
+ A := Rotate_Left (A, S);
+ A := A + B;
+ end GG;
+
+ -------
+ -- H --
+ -------
+
+ function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
+ begin
+ return X xor Y xor Z;
+ end H;
+
+ --------
+ -- HH --
+ --------
+
+ procedure HH
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive)
+ is
+ begin
+ A := A + H (B, C, D) + X + AC;
+ A := Rotate_Left (A, S);
+ A := A + B;
+ end HH;
+
+ -------
+ -- I --
+ -------
+
+ function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
+ begin
+ return Y xor (X or (not Z));
+ end I;
+
+ --------
+ -- II --
+ --------
+
+ procedure II
+ (A : in out Unsigned_32;
+ B, C, D : Unsigned_32;
+ X : Unsigned_32;
+ AC : Unsigned_32;
+ S : Positive)
+ is
+ begin
+ A := A + I (B, C, D) + X + AC;
+ A := Rotate_Left (A, S);
+ A := A + B;
+ end II;
+
+ ---------------
+ -- Transform --
+ ---------------
+
+ procedure Transform
+ (H : in out Hash_State.State;
+ M : in out Message_State)
+ is
+ X : array (0 .. 15) of Interfaces.Unsigned_32;
+ for X'Address use M.Buffer'Address;
+ pragma Import (Ada, X);
+
+ AA : Unsigned_32 := H (0);
+ BB : Unsigned_32 := H (1);
+ CC : Unsigned_32 := H (2);
+ DD : Unsigned_32 := H (3);
+
+ begin
+ if System.Default_Bit_Order /= Low_Order_First then
+ for J in X'Range loop
+ Swap4 (X (J)'Address);
+ end loop;
+ end if;
+
+ -- Round 1
+
+ FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
+ FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
+ FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
+ FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
+
+ FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
+ FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
+ FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
+ FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
+
+ FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
+ FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
+ FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
+ FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
+
+ FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
+ FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
+ FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
+ FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
+
+ -- Round 2
+
+ GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
+ GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
+ GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
+ GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
+
+ GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
+ GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
+ GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
+ GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
+
+ GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
+ GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
+ GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
+ GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
+
+ GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
+ GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
+ GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
+ GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
+
+ -- Round 3
+
+ HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
+ HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
+ HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
+ HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
+
+ HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
+ HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
+ HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
+ HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
+
+ HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
+ HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
+ HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
+ HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
+
+ HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
+ HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
+ HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
+ HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
+
+ -- Round 4
+
+ II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
+ II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
+ II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
+ II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
+
+ II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
+ II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
+ II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
+ II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
+
+ II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
+ II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
+ II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
+ II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
+
+ II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
+ II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
+ II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
+ II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
+
+ H (0) := H (0) + AA;
+ H (1) := H (1) + BB;
+ H (2) := H (2) + CC;
+ H (3) := H (3) + DD;
+
+ end Transform;
+
+end System.Secure_Hashes.MD5;
diff --git a/gcc/ada/s-sehamd.ads b/gcc/ada/s-sehamd.ads
new file mode 100644
index 00000000000..63385d38005
--- /dev/null
+++ b/gcc/ada/s-sehamd.ads
@@ -0,0 +1,71 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . M D 5 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides supporting code for implementation of the MD5
+-- Message-Digest Algorithm as described in RFC 1321. The complete text of
+-- RFC 1321 can be found at:
+-- http://www.ietf.org/rfc/rfc1321.txt
+
+with GNAT.Byte_Swapping;
+with Interfaces;
+
+package System.Secure_Hashes.MD5 is
+
+ package Hash_State is
+ new System.Secure_Hashes.Hash_Function_State
+ (Word => Interfaces.Unsigned_32,
+ Swap => GNAT.Byte_Swapping.Swap4,
+ Hash_Bit_Order => System.Low_Order_First);
+ -- MD5 operates on 32-bit little endian words
+
+ Block_Words : constant := 16;
+ -- Messages are processed in chunks of 16 words
+
+ procedure Transform
+ (H : in out Hash_State.State;
+ M : in out Message_State);
+ -- Transformation function applied for each block
+
+ Initial_State : constant Hash_State.State;
+ -- Initialization vector
+
+private
+
+ Initial_A : constant := 16#67452301#;
+ Initial_B : constant := 16#EFCDAB89#;
+ Initial_C : constant := 16#98BADCFE#;
+ Initial_D : constant := 16#10325476#;
+
+ Initial_State : constant Hash_State.State :=
+ (Initial_A, Initial_B, Initial_C, Initial_D);
+ -- Initialization vector from RFC 1321
+
+end System.Secure_Hashes.MD5;
diff --git a/gcc/ada/s-sehash.adb b/gcc/ada/s-sehash.adb
new file mode 100644
index 00000000000..8cd919a9e65
--- /dev/null
+++ b/gcc/ada/s-sehash.adb
@@ -0,0 +1,177 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 1 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body System.Secure_Hashes.SHA1 is
+
+ use Interfaces;
+ use GNAT.Byte_Swapping;
+
+ -- The following functions are the four elementary components of each
+ -- of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79)
+ -- defined in RFC 3174.
+
+ function F0 (B, C, D : Unsigned_32) return Unsigned_32;
+ pragma Inline (F0);
+
+ function F1 (B, C, D : Unsigned_32) return Unsigned_32;
+ pragma Inline (F1);
+
+ function F2 (B, C, D : Unsigned_32) return Unsigned_32;
+ pragma Inline (F2);
+
+ function F3 (B, C, D : Unsigned_32) return Unsigned_32;
+ pragma Inline (F3);
+
+ --------
+ -- F0 --
+ --------
+
+ function F0
+ (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
+ is
+ begin
+ return (B and C) or ((not B) and D);
+ end F0;
+
+ --------
+ -- F1 --
+ --------
+
+ function F1
+ (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
+ is
+ begin
+ return B xor C xor D;
+ end F1;
+
+ --------
+ -- F2 --
+ --------
+
+ function F2
+ (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
+ is
+ begin
+ return (B and C) or (B and D) or (C and D);
+ end F2;
+
+ --------
+ -- F3 --
+ --------
+
+ function F3
+ (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
+ renames F1;
+
+ ---------------
+ -- Transform --
+ ---------------
+
+ procedure Transform
+ (H : in out Hash_State.State;
+ M : in out Message_State)
+ is
+ type Words is array (Natural range <>) of Interfaces.Unsigned_32;
+
+ X : Words (0 .. 15);
+ for X'Address use M.Buffer'Address;
+ pragma Import (Ada, X);
+
+ W : Words (0 .. 79);
+
+ A, B, C, D, E, Temp : Interfaces.Unsigned_32;
+
+ begin
+ if System.Default_Bit_Order /= High_Order_First then
+ for J in X'Range loop
+ Swap4 (X (J)'Address);
+ end loop;
+ end if;
+
+ -- a. Divide data block into sixteen words
+
+ W (0 .. 15) := X;
+
+ -- b. Prepare working block of 80 words
+
+ for T in 16 .. 79 loop
+
+ -- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
+
+ W (T) := Rotate_Left
+ (W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
+
+ end loop;
+
+ -- c. Set up transformation variables
+
+ A := H (0);
+ B := H (1);
+ C := H (2);
+ D := H (3);
+ E := H (4);
+
+ -- d. For each of the 80 rounds, compute:
+
+ -- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
+ -- E = D; D = C; C = S^30(B); B = A; A = TEMP;
+
+ for T in 0 .. 19 loop
+ Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
+ E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
+ end loop;
+
+ for T in 20 .. 39 loop
+ Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
+ E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
+ end loop;
+
+ for T in 40 .. 59 loop
+ Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
+ E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
+ end loop;
+
+ for T in 60 .. 79 loop
+ Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
+ E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
+ end loop;
+
+ -- e. Update context:
+ -- H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
+
+ H (0) := H (0) + A;
+ H (1) := H (1) + B;
+ H (2) := H (2) + C;
+ H (3) := H (3) + D;
+ H (4) := H (4) + E;
+ end Transform;
+
+end System.Secure_Hashes.SHA1;
diff --git a/gcc/ada/s-sehash.ads b/gcc/ada/s-sehash.ads
new file mode 100644
index 00000000000..63d31a8dff9
--- /dev/null
+++ b/gcc/ada/s-sehash.ads
@@ -0,0 +1,69 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 1 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides supporting code for implementation of the SHA-1
+-- secure hash function as decsribed in FIPS PUB 180-3. The complete text
+-- of FIPS PUB 180-3 can be found at:
+-- http://csrc.nist.gov/publications/fips/fips180-3/fips180-3_final.pdf
+
+with GNAT.Byte_Swapping;
+with Interfaces;
+
+package System.Secure_Hashes.SHA1 is
+
+ package Hash_State is new Hash_Function_State
+ (Word => Interfaces.Unsigned_32,
+ Swap => GNAT.Byte_Swapping.Swap4,
+ Hash_Bit_Order => System.High_Order_First);
+ -- SHA-1 operates on 32-bit big endian words
+
+ Block_Words : constant := 16;
+ -- Messages are processed in chunks of 16 words
+
+ procedure Transform
+ (H : in out Hash_State.State;
+ M : in out Message_State);
+ -- Transformation function applied for each block
+
+ Initial_State : constant Hash_State.State;
+ -- Initialization vector
+
+private
+
+ Initial_State : constant Hash_State.State :=
+ (0 => 16#67452301#,
+ 1 => 16#EFCDAB89#,
+ 2 => 16#98BADCFE#,
+ 3 => 16#10325476#,
+ 4 => 16#C3D2E1F0#);
+ -- Initialization vector from FIPS PUB 180-3
+
+end System.Secure_Hashes.SHA1;
diff --git a/gcc/ada/s-shsh32.adb b/gcc/ada/s-shsh32.adb
new file mode 100644
index 00000000000..48baadbe867
--- /dev/null
+++ b/gcc/ada/s-shsh32.adb
@@ -0,0 +1,80 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 3 2 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body System.Secure_Hashes.SHA2_32 is
+
+ use Interfaces;
+
+ ------------
+ -- Sigma0 --
+ ------------
+
+ function Sigma0 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 2)
+ xor Rotate_Right (X, 13)
+ xor Rotate_Right (X, 22);
+ end Sigma0;
+
+ ------------
+ -- Sigma1 --
+ ------------
+
+ function Sigma1 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 6)
+ xor Rotate_Right (X, 11)
+ xor Rotate_Right (X, 25);
+ end Sigma1;
+
+ --------
+ -- S0 --
+ --------
+
+ function S0 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 7)
+ xor Rotate_Right (X, 18)
+ xor Shift_Right (X, 3);
+ end S0;
+
+ --------
+ -- S1 --
+ --------
+
+ function S1 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 17)
+ xor Rotate_Right (X, 19)
+ xor Shift_Right (X, 10);
+ end S1;
+
+end System.Secure_Hashes.SHA2_32;
diff --git a/gcc/ada/s-shsh32.ads b/gcc/ada/s-shsh32.ads
new file mode 100644
index 00000000000..293d06f71c4
--- /dev/null
+++ b/gcc/ada/s-shsh32.ads
@@ -0,0 +1,105 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 3 2 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This pacakge provides support for the 32-bit FIPS PUB 180-3 functions
+-- SHA-256 and SHA-224.
+
+with Interfaces;
+with GNAT.Byte_Swapping;
+with System.Secure_Hashes.SHA2_Common;
+
+package System.Secure_Hashes.SHA2_32 is
+
+ subtype Word is Interfaces.Unsigned_32;
+
+ package Hash_State is new Hash_Function_State
+ (Word => Word,
+ Swap => GNAT.Byte_Swapping.Swap4,
+ Hash_Bit_Order => System.High_Order_First);
+ -- SHA-224 and SHA-256 operate on 32-bit big endian words
+
+ K : constant Hash_State.State (0 .. 63) :=
+ (16#428a2f98#, 16#71374491#, 16#b5c0fbcf#, 16#e9b5dba5#,
+ 16#3956c25b#, 16#59f111f1#, 16#923f82a4#, 16#ab1c5ed5#,
+ 16#d807aa98#, 16#12835b01#, 16#243185be#, 16#550c7dc3#,
+ 16#72be5d74#, 16#80deb1fe#, 16#9bdc06a7#, 16#c19bf174#,
+ 16#e49b69c1#, 16#efbe4786#, 16#0fc19dc6#, 16#240ca1cc#,
+ 16#2de92c6f#, 16#4a7484aa#, 16#5cb0a9dc#, 16#76f988da#,
+ 16#983e5152#, 16#a831c66d#, 16#b00327c8#, 16#bf597fc7#,
+ 16#c6e00bf3#, 16#d5a79147#, 16#06ca6351#, 16#14292967#,
+ 16#27b70a85#, 16#2e1b2138#, 16#4d2c6dfc#, 16#53380d13#,
+ 16#650a7354#, 16#766a0abb#, 16#81c2c92e#, 16#92722c85#,
+ 16#a2bfe8a1#, 16#a81a664b#, 16#c24b8b70#, 16#c76c51a3#,
+ 16#d192e819#, 16#d6990624#, 16#f40e3585#, 16#106aa070#,
+ 16#19a4c116#, 16#1e376c08#, 16#2748774c#, 16#34b0bcb5#,
+ 16#391c0cb3#, 16#4ed8aa4a#, 16#5b9cca4f#, 16#682e6ff3#,
+ 16#748f82ee#, 16#78a5636f#, 16#84c87814#, 16#8cc70208#,
+ 16#90befffa#, 16#a4506ceb#, 16#bef9a3f7#, 16#c67178f2#);
+ -- Constants from FIPS PUB 180-3
+
+ function Sigma0 (X : Word) return Word;
+ function Sigma1 (X : Word) return Word;
+ function S0 (X : Word) return Word;
+ function S1 (X : Word) return Word;
+ pragma Inline (Sigma0, Sigma1, S0, S1);
+ -- Elementary functions Sigma^256_0, Sigma^256_1, sigma^256_0, sigma^256_1
+ -- from FIPS PUB 180-3.
+
+ procedure Transform is new SHA2_Common.Transform
+ (Hash_State => Hash_State,
+ K => K,
+ Rounds => 64,
+ Sigma0 => Sigma0,
+ Sigma1 => Sigma1,
+ S0 => S0,
+ S1 => S1);
+
+ SHA224_Init_State : constant Hash_State.State (0 .. 7) :=
+ (0 => 16#c1059ed8#,
+ 1 => 16#367cd507#,
+ 2 => 16#3070dd17#,
+ 3 => 16#f70e5939#,
+ 4 => 16#ffc00b31#,
+ 5 => 16#68581511#,
+ 6 => 16#64f98fa7#,
+ 7 => 16#befa4fa4#);
+ SHA256_Init_State : constant Hash_State.State (0 .. 7) :=
+ (0 => 16#6a09e667#,
+ 1 => 16#bb67ae85#,
+ 2 => 16#3c6ef372#,
+ 3 => 16#a54ff53a#,
+ 4 => 16#510e527f#,
+ 5 => 16#9b05688c#,
+ 6 => 16#1f83d9ab#,
+ 7 => 16#5be0cd19#);
+ -- Initialization vectors from FIPS PUB 180-3
+
+end System.Secure_Hashes.SHA2_32;
diff --git a/gcc/ada/s-shsh64.adb b/gcc/ada/s-shsh64.adb
new file mode 100644
index 00000000000..d49a6bd9b3a
--- /dev/null
+++ b/gcc/ada/s-shsh64.adb
@@ -0,0 +1,80 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 6 4 --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body System.Secure_Hashes.SHA2_64 is
+
+ use Interfaces;
+
+ ------------
+ -- Sigma0 --
+ ------------
+
+ function Sigma0 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 28)
+ xor Rotate_Right (X, 34)
+ xor Rotate_Right (X, 39);
+ end Sigma0;
+
+ ------------
+ -- Sigma1 --
+ ------------
+
+ function Sigma1 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 14)
+ xor Rotate_Right (X, 18)
+ xor Rotate_Right (X, 41);
+ end Sigma1;
+
+ --------
+ -- S0 --
+ --------
+
+ function S0 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 1)
+ xor Rotate_Right (X, 8)
+ xor Shift_Right (X, 7);
+ end S0;
+
+ --------
+ -- S1 --
+ --------
+
+ function S1 (X : Word) return Word is
+ begin
+ return Rotate_Right (X, 19)
+ xor Rotate_Right (X, 61)
+ xor Shift_Right (X, 6);
+ end S1;
+
+end System.Secure_Hashes.SHA2_64;
diff --git a/gcc/ada/s-shsh64.ads b/gcc/ada/s-shsh64.ads
new file mode 100644
index 00000000000..c8949733e2e
--- /dev/null
+++ b/gcc/ada/s-shsh64.ads
@@ -0,0 +1,129 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 6 4 --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This pacakge provides support for the 64-bit FIPS PUB 180-3 functions
+-- (SHA-384 and SHA-512).
+
+with Interfaces;
+with GNAT.Byte_Swapping;
+
+with System.Secure_Hashes.SHA2_Common;
+
+package System.Secure_Hashes.SHA2_64 is
+ subtype Word is Interfaces.Unsigned_64;
+
+ package Hash_State is new Hash_Function_State
+ (Word => Word,
+ Swap => GNAT.Byte_Swapping.Swap8,
+ Hash_Bit_Order => System.High_Order_First);
+ -- SHA-384 and SHA-512 operate on 64-bit big endian words
+
+ K : Hash_State.State (0 .. 79) :=
+ (16#428a2f98d728ae22#, 16#7137449123ef65cd#,
+ 16#b5c0fbcfec4d3b2f#, 16#e9b5dba58189dbbc#,
+ 16#3956c25bf348b538#, 16#59f111f1b605d019#,
+ 16#923f82a4af194f9b#, 16#ab1c5ed5da6d8118#,
+ 16#d807aa98a3030242#, 16#12835b0145706fbe#,
+ 16#243185be4ee4b28c#, 16#550c7dc3d5ffb4e2#,
+ 16#72be5d74f27b896f#, 16#80deb1fe3b1696b1#,
+ 16#9bdc06a725c71235#, 16#c19bf174cf692694#,
+ 16#e49b69c19ef14ad2#, 16#efbe4786384f25e3#,
+ 16#0fc19dc68b8cd5b5#, 16#240ca1cc77ac9c65#,
+ 16#2de92c6f592b0275#, 16#4a7484aa6ea6e483#,
+ 16#5cb0a9dcbd41fbd4#, 16#76f988da831153b5#,
+ 16#983e5152ee66dfab#, 16#a831c66d2db43210#,
+ 16#b00327c898fb213f#, 16#bf597fc7beef0ee4#,
+ 16#c6e00bf33da88fc2#, 16#d5a79147930aa725#,
+ 16#06ca6351e003826f#, 16#142929670a0e6e70#,
+ 16#27b70a8546d22ffc#, 16#2e1b21385c26c926#,
+ 16#4d2c6dfc5ac42aed#, 16#53380d139d95b3df#,
+ 16#650a73548baf63de#, 16#766a0abb3c77b2a8#,
+ 16#81c2c92e47edaee6#, 16#92722c851482353b#,
+ 16#a2bfe8a14cf10364#, 16#a81a664bbc423001#,
+ 16#c24b8b70d0f89791#, 16#c76c51a30654be30#,
+ 16#d192e819d6ef5218#, 16#d69906245565a910#,
+ 16#f40e35855771202a#, 16#106aa07032bbd1b8#,
+ 16#19a4c116b8d2d0c8#, 16#1e376c085141ab53#,
+ 16#2748774cdf8eeb99#, 16#34b0bcb5e19b48a8#,
+ 16#391c0cb3c5c95a63#, 16#4ed8aa4ae3418acb#,
+ 16#5b9cca4f7763e373#, 16#682e6ff3d6b2b8a3#,
+ 16#748f82ee5defb2fc#, 16#78a5636f43172f60#,
+ 16#84c87814a1f0ab72#, 16#8cc702081a6439ec#,
+ 16#90befffa23631e28#, 16#a4506cebde82bde9#,
+ 16#bef9a3f7b2c67915#, 16#c67178f2e372532b#,
+ 16#ca273eceea26619c#, 16#d186b8c721c0c207#,
+ 16#eada7dd6cde0eb1e#, 16#f57d4f7fee6ed178#,
+ 16#06f067aa72176fba#, 16#0a637dc5a2c898a6#,
+ 16#113f9804bef90dae#, 16#1b710b35131c471b#,
+ 16#28db77f523047d84#, 16#32caab7b40c72493#,
+ 16#3c9ebe0a15c9bebc#, 16#431d67c49c100d4c#,
+ 16#4cc5d4becb3e42b6#, 16#597f299cfc657e2a#,
+ 16#5fcb6fab3ad6faec#, 16#6c44198c4a475817#);
+ -- Constants from FIPS PUB 180-3
+
+ function Sigma0 (X : Word) return Word;
+ function Sigma1 (X : Word) return Word;
+ function S0 (X : Word) return Word;
+ function S1 (X : Word) return Word;
+ pragma Inline (Sigma0, Sigma1, S0, S1);
+ -- Elementary functions Sigma^512_0, Sigma^512_1, sigma^512_0, sigma^512_1
+ -- from FIPS PUB 180-3.
+
+ procedure Transform is new SHA2_Common.Transform
+ (Hash_State => Hash_State,
+ K => K,
+ Rounds => 80,
+ Sigma0 => Sigma0,
+ Sigma1 => Sigma1,
+ S0 => S0,
+ S1 => S1);
+
+ SHA384_Init_State : constant Hash_State.State :=
+ (0 => 16#cbbb9d5dc1059ed8#,
+ 1 => 16#629a292a367cd507#,
+ 2 => 16#9159015a3070dd17#,
+ 3 => 16#152fecd8f70e5939#,
+ 4 => 16#67332667ffc00b31#,
+ 5 => 16#8eb44a8768581511#,
+ 6 => 16#db0c2e0d64f98fa7#,
+ 7 => 16#47b5481dbefa4fa4#);
+ SHA512_Init_State : constant Hash_State.State :=
+ (0 => 16#6a09e667f3bcc908#,
+ 1 => 16#bb67ae8584caa73b#,
+ 2 => 16#3c6ef372fe94f82b#,
+ 3 => 16#a54ff53a5f1d36f1#,
+ 4 => 16#510e527fade682d1#,
+ 5 => 16#9b05688c2b3e6c1f#,
+ 6 => 16#1f83d9abfb41bd6b#,
+ 7 => 16#5be0cd19137e2179#);
+ -- Initialization vectors from FIPS PUB 180-3
+
+end System.Secure_Hashes.SHA2_64;
diff --git a/gcc/ada/s-shshco.adb b/gcc/ada/s-shshco.adb
new file mode 100644
index 00000000000..8b54406f10a
--- /dev/null
+++ b/gcc/ada/s-shshco.adb
@@ -0,0 +1,133 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ C O M M O N --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body System.Secure_Hashes.SHA2_Common is
+
+ ---------------
+ -- Transform --
+ ---------------
+
+ procedure Transform
+ (H_St : in out Hash_State.State;
+ M_St : in out Message_State)
+ is
+ subtype Word is Hash_State.Word;
+ use type Hash_State.Word;
+
+ function Ch (X, Y, Z : Word) return Word;
+ function Maj (X, Y, Z : Word) return Word;
+ pragma Inline (Ch, Maj);
+ -- Elementary functions from FIPS PUB 180-3
+
+ --------
+ -- Ch --
+ --------
+
+ function Ch (X, Y, Z : Word) return Word is
+ begin
+ return (X and Y) xor ((not X) and Z);
+ end Ch;
+
+ ---------
+ -- Maj --
+ ---------
+
+ function Maj (X, Y, Z : Word) return Word is
+ begin
+ return (X and Y) xor (X and Z) xor (Y and Z);
+ end Maj;
+
+ type Words is array (Natural range <>) of Word;
+
+ X : Words (0 .. 15);
+ for X'Address use M_St.Buffer'Address;
+ pragma Import (Ada, X);
+
+ W : Words (0 .. Rounds - 1);
+
+ A, B, C, D, E, F, G, H, T1, T2 : Word;
+
+ -- Start of processing for Transform
+
+ begin
+ if System.Default_Bit_Order /= High_Order_First then
+ for J in X'Range loop
+ Hash_State.Swap (X (J)'Address);
+ end loop;
+ end if;
+
+ -- 1. Prepare message schedule
+
+ W (0 .. 15) := X;
+
+ for T in 16 .. Rounds - 1 loop
+ W (T) := S1 (W (T - 2)) + W (T - 7) + S0 (W (T - 15)) + W (T - 16);
+ end loop;
+
+ -- 2. Initialize working variables
+
+ A := H_St (0);
+ B := H_St (1);
+ C := H_St (2);
+ D := H_St (3);
+ E := H_St (4);
+ F := H_St (5);
+ G := H_St (6);
+ H := H_St (7);
+
+ -- 3. Perform transformation rounds
+
+ for T in 0 .. Rounds - 1 loop
+ T1 := H + Sigma1 (E) + Ch (E, F, G) + K (T) + W (T);
+ T2 := Sigma0 (A) + Maj (A, B, C);
+ H := G;
+ G := F;
+ F := E;
+ E := D + T1;
+ D := C;
+ C := B;
+ B := A;
+ A := T1 + T2;
+ end loop;
+
+ -- 4. Update hash state
+
+ H_St (0) := A + H_St (0);
+ H_St (1) := B + H_St (1);
+ H_St (2) := C + H_St (2);
+ H_St (3) := D + H_St (3);
+ H_St (4) := E + H_St (4);
+ H_St (5) := F + H_St (5);
+ H_St (6) := G + H_St (6);
+ H_St (7) := H + H_St (7);
+ end Transform;
+
+end System.Secure_Hashes.SHA2_Common;
diff --git a/gcc/ada/s-shshco.ads b/gcc/ada/s-shshco.ads
new file mode 100644
index 00000000000..d4600f12b58
--- /dev/null
+++ b/gcc/ada/s-shshco.ads
@@ -0,0 +1,63 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ C O M M O N --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides supporting code for implementation of the following
+-- secure hash functions described in FIPS PUB 180-3: SHA-224, SHA-256,
+-- SHA-384, SHA-512. It contains the generic transform operation that is
+-- common to the above four functions. The complete text of FIPS PUB 180-3
+-- can be found at:
+-- http://csrc.nist.gov/publications/fips/fips180-3/fips180-3_final.pdf
+
+package System.Secure_Hashes.SHA2_Common is
+
+ Block_Words : constant := 16;
+ -- All functions operate on blocks of 16 words
+
+ generic
+ with package Hash_State is new Hash_Function_State (<>);
+
+ Rounds : Natural;
+ -- Number of transformation rounds
+
+ K : Hash_State.State;
+ -- Constants used in the transform operation
+
+ with function Sigma0 (X : Hash_State.Word) return Hash_State.Word is <>;
+ with function Sigma1 (X : Hash_State.Word) return Hash_State.Word is <>;
+ with function S0 (X : Hash_State.Word) return Hash_State.Word is <>;
+ with function S1 (X : Hash_State.Word) return Hash_State.Word is <>;
+ -- FIPS PUB 180-3 elementary functions
+
+ procedure Transform
+ (H_St : in out Hash_State.State;
+ M_St : in out Message_State);
+
+end System.Secure_Hashes.SHA2_Common;