OSDN Git Service

2009-11-30 Pascal Obry <obry@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 14:45:15 +0000 (14:45 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 14:45:15 +0000 (14:45 +0000)
* 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

24 files changed:
gcc/ada/ChangeLog
gcc/ada/Makefile.rtl
gcc/ada/expect.c
gcc/ada/g-md5.adb
gcc/ada/g-md5.ads
gcc/ada/g-sha1.adb
gcc/ada/g-sha1.ads
gcc/ada/g-sha224.ads [new file with mode: 0644]
gcc/ada/g-sha256.ads [new file with mode: 0644]
gcc/ada/g-sha384.ads [new file with mode: 0644]
gcc/ada/g-sha512.ads [new file with mode: 0644]
gcc/ada/gnat_rm.texi
gcc/ada/s-sechas.adb [new file with mode: 0644]
gcc/ada/s-sechas.ads [new file with mode: 0644]
gcc/ada/s-sehamd.adb [new file with mode: 0644]
gcc/ada/s-sehamd.ads [new file with mode: 0644]
gcc/ada/s-sehash.adb [new file with mode: 0644]
gcc/ada/s-sehash.ads [new file with mode: 0644]
gcc/ada/s-shsh32.adb [new file with mode: 0644]
gcc/ada/s-shsh32.ads [new file with mode: 0644]
gcc/ada/s-shsh64.adb [new file with mode: 0644]
gcc/ada/s-shsh64.ads [new file with mode: 0644]
gcc/ada/s-shshco.adb [new file with mode: 0644]
gcc/ada/s-shshco.ads [new file with mode: 0644]

index 1c071f6..149391c 100644 (file)
@@ -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
index 7563c44..5b09529 100644 (file)
@@ -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) \
index c013feb..4f0f73f 100644 (file)
@@ -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 */
 }
 
index 6c11488..40c5af3 100644 (file)
@@ -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, --
 --                                                                          --
 ------------------------------------------------------------------------------
 
-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;
index cea8eb6..ac0985c 100644 (file)
@@ -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, --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  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);
index 72b1924..9125393 100644 (file)
 ------------------------------------------------------------------------------
 --                                                                          --
---                         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;
index 36e2e25..912510b 100644 (file)
@@ -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, --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  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 (file)
index 0000000..1a6391d
--- /dev/null
@@ -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 (file)
index 0000000..6f3de58
--- /dev/null
@@ -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 (file)
index 0000000..5fcd180
--- /dev/null
@@ -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 (file)
index 0000000..7b39512
--- /dev/null
@@ -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);
index 2f09ddc..46823f9 100644 (file)
@@ -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 (file)
index 0000000..72121eb
--- /dev/null
@@ -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 (file)
index 0000000..3d9bc76
--- /dev/null
@@ -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 (file)
index 0000000..30fff89
--- /dev/null
@@ -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 (file)
index 0000000..63385d3
--- /dev/null
@@ -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 (file)
index 0000000..8cd919a
--- /dev/null
@@ -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 (file)
index 0000000..63d31a8
--- /dev/null
@@ -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 (file)
index 0000000..48baadb
--- /dev/null
@@ -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 (file)
index 0000000..293d06f
--- /dev/null
@@ -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 (file)
index 0000000..d49a6bd
--- /dev/null
@@ -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 (file)
index 0000000..c894973
--- /dev/null
@@ -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 (file)
index 0000000..8b54406
--- /dev/null
@@ -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 (file)
index 0000000..d4600f1
--- /dev/null
@@ -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;