2007-08-14 Paul Hilfinger <hilfinger@adacore.com>

	* impunit.adb: Re-organize System.Random_Numbers and
	GNAT.Random_Numbers and add to builds.

	* Makefile.rtl: Add s-rannum.ad* and g-rannum.ad*, a-assert*

	* s-rannum.ads, s-rannum.adb, g-rannum.ads, g-rannum.adb: New files.

	* a-assert.ads, a-assert.adb: New files.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127454 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 310 insertions, 0 deletions

diff --git a/gcc/ada/g-rannum.adb b/gcc/ada/g-rannum.adb
new file mode 100644
index 00000000000..d038adbbea1
--- /dev/null
+++ b/gcc/ada/g-rannum.adb
@@ -0,0 +1,310 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  G N A T . R A N D O M _ N U M B E R S                   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2007, 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- --
+-- 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.                                              --
+--                                                                          --
+-- 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.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Numerics.Long_Elementary_Functions;
+use Ada.Numerics.Long_Elementary_Functions;
+with Ada.Unchecked_Conversion;
+with System.Random_Numbers; use System.Random_Numbers;
+
+package body GNAT.Random_Numbers is
+
+   Sys_Max_Image_Width : constant := System.Random_Numbers.Max_Image_Width;
+
+   subtype Image_String is String (1 .. Max_Image_Width);
+
+   --  Utility function declarations
+
+   procedure Insert_Image
+     (S     : in out Image_String;
+      Index : Integer;
+      V     : Integer_64);
+   --  Insert string representation of V in S starting at position Index
+
+   ---------------
+   -- To_Signed --
+   ---------------
+
+   function To_Signed is
+     new Ada.Unchecked_Conversion (Unsigned_32, Integer_32);
+   function To_Signed is
+     new Ada.Unchecked_Conversion (Unsigned_64, Integer_64);
+
+   ------------------
+   -- Insert_Image --
+   ------------------
+
+   procedure Insert_Image
+     (S     : in out Image_String;
+      Index : Integer;
+      V     : Integer_64)
+   is
+      Image : constant String := Integer_64'Image (V);
+   begin
+      S (Index .. Index + Image'Length - 1) := Image;
+   end Insert_Image;
+
+   ---------------------
+   -- Random_Discrete --
+   ---------------------
+
+   function Random_Discrete
+     (Gen   : Generator;
+      Min   : Result_Subtype := Default_Min;
+      Max   : Result_Subtype := Result_Subtype'Last) return Result_Subtype
+   is
+      function F is
+        new System.Random_Numbers.Random_Discrete
+              (Result_Subtype, Default_Min);
+   begin
+      return F (Gen.Rep, Min, Max);
+   end Random_Discrete;
+
+   ------------
+   -- Random --
+   ------------
+
+   function Random (Gen : Generator) return Float is
+   begin
+      return Random (Gen.Rep);
+   end Random;
+
+   function Random (Gen : Generator) return Long_Float is
+   begin
+      return Random (Gen.Rep);
+   end Random;
+
+   function Random (Gen : Generator) return Interfaces.Unsigned_32 is
+   begin
+      return Random (Gen.Rep);
+   end Random;
+
+   function Random (Gen : Generator) return Interfaces.Unsigned_64 is
+   begin
+      return Random (Gen.Rep);
+   end Random;
+
+   function Random (Gen : Generator) return Integer_64 is
+   begin
+      return To_Signed (Unsigned_64'(Random (Gen)));
+   end Random;
+
+   function Random (Gen : Generator) return Integer_32 is
+   begin
+      return To_Signed (Unsigned_32'(Random (Gen)));
+   end Random;
+
+   function Random (Gen : Generator) return Long_Integer is
+      function Random_Long_Integer is new Random_Discrete (Long_Integer);
+   begin
+      return Random_Long_Integer (Gen);
+   end Random;
+
+   function Random (Gen : Generator) return Integer is
+      function Random_Integer is new Random_Discrete (Integer);
+   begin
+      return Random_Integer (Gen);
+   end Random;
+
+   ------------------
+   -- Random_Float --
+   ------------------
+
+   function Random_Float (Gen   : Generator) return Result_Subtype is
+      function F is new System.Random_Numbers.Random_Float (Result_Subtype);
+   begin
+      return F (Gen.Rep);
+   end Random_Float;
+
+   ---------------------
+   -- Random_Gaussian --
+   ---------------------
+
+   --  Generates pairs of normally distributed values using the polar method of
+   --  G. E. P. Box, M. E. Muller, and G. Marsaglia. See Donald E. Knuth, The
+   --  Art of Computer Programming, Vol 2: Seminumerical Algorithms, section
+   --  3.4.1, subsection C, algorithm P. Returns half of the pair on each call,
+   --  using the Next_Gaussian field of Gen to hold the second member on
+   --  even-numbered calls.
+
+   function Random_Gaussian (Gen : Generator) return Long_Float is
+      G : Generator renames Gen'Unrestricted_Access.all;
+
+      V1, V2, Rad2, Mult : Long_Float;
+
+   begin
+      if G.Have_Gaussian then
+         G.Have_Gaussian := False;
+         return G.Next_Gaussian;
+
+      else
+         loop
+            V1 := 2.0 * Random (G) - 1.0;
+            V2 := 2.0 * Random (G) - 1.0;
+            Rad2 := V1 ** 2 + V2 ** 2;
+            exit when Rad2 < 1.0 and then Rad2 /= 0.0;
+         end loop;
+
+         --  Now V1 and V2 are coordinates in the unit circle
+
+         Mult := Sqrt (-2.0 * Log (Rad2) / Rad2);
+         G.Next_Gaussian := V2 * Mult;
+         G.Have_Gaussian := True;
+         return Long_Float'Machine (V1 * Mult);
+      end if;
+   end Random_Gaussian;
+
+   function Random_Gaussian (Gen : Generator) return Float is
+      V : constant Long_Float := Random_Gaussian (Gen);
+   begin
+      return Float'Machine (Float (V));
+   end Random_Gaussian;
+
+   -----------
+   -- Reset --
+   -----------
+
+   procedure Reset (Gen : out Generator) is
+   begin
+      Reset (Gen.Rep);
+      Gen.Have_Gaussian := False;
+   end Reset;
+
+   procedure Reset
+     (Gen       : out Generator;
+      Initiator : Initialization_Vector)
+   is
+   begin
+      Reset (Gen.Rep, Initiator);
+      Gen.Have_Gaussian := False;
+   end Reset;
+
+   procedure Reset
+     (Gen       : out Generator;
+      Initiator : Interfaces.Integer_32)
+   is
+   begin
+      Reset (Gen.Rep, Initiator);
+      Gen.Have_Gaussian := False;
+   end Reset;
+
+   procedure Reset
+     (Gen       : out Generator;
+      Initiator : Interfaces.Unsigned_32)
+   is
+   begin
+      Reset (Gen.Rep, Initiator);
+      Gen.Have_Gaussian := False;
+   end Reset;
+
+   procedure Reset
+     (Gen       : out Generator;
+      Initiator : Integer)
+   is
+   begin
+      Reset (Gen.Rep, Initiator);
+      Gen.Have_Gaussian := False;
+   end Reset;
+
+   procedure Reset
+     (Gen        : out Generator;
+      From_State : Generator)
+   is
+   begin
+      Reset (Gen.Rep, From_State.Rep);
+      Gen.Have_Gaussian := From_State.Have_Gaussian;
+      Gen.Next_Gaussian := From_State.Next_Gaussian;
+   end Reset;
+
+   Frac_Scale : constant Long_Float :=
+                  Long_Float
+                    (Long_Float'Machine_Radix) ** Long_Float'Machine_Mantissa;
+
+   function Val64 (Image : String) return Integer_64;
+   --  Renames Integer64'Value
+   --  We cannot use a 'renames Integer64'Value' since for some strange
+   --  reason, this requires a dependency on s-auxdec.ads which not all
+   --  run-times support ???
+
+   function Val64 (Image : String) return Integer_64 is
+   begin
+      return Integer_64'Value (Image);
+   end Val64;
+
+   procedure Reset
+     (Gen        : out Generator;
+      From_Image : String)
+   is
+      F0 : constant Integer := From_Image'First;
+      T0 : constant Integer := From_Image'First + Sys_Max_Image_Width;
+
+   begin
+      Reset (Gen.Rep, From_Image (F0 .. F0 + Sys_Max_Image_Width));
+
+      if From_Image (T0 + 1) = '1' then
+         Gen.Have_Gaussian := True;
+         Gen.Next_Gaussian :=
+           Long_Float (Val64 (From_Image (T0 + 3 .. T0 + 23))) / Frac_Scale
+           * Long_Float (Long_Float'Machine_Radix)
+           ** Integer (Val64 (From_Image (T0 + 25 .. From_Image'Last)));
+      else
+         Gen.Have_Gaussian := False;
+      end if;
+   end Reset;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Gen : Generator) return String is
+      Result : Image_String;
+
+   begin
+      Result := (others => ' ');
+      Result (1 .. Sys_Max_Image_Width) := Image (Gen.Rep);
+
+      if Gen.Have_Gaussian then
+         Result (Sys_Max_Image_Width + 2) := '1';
+         Insert_Image (Result, Sys_Max_Image_Width + 4,
+                       Integer_64 (Long_Float'Fraction (Gen.Next_Gaussian)
+                                   * Frac_Scale));
+         Insert_Image (Result, Sys_Max_Image_Width + 24,
+                       Integer_64 (Long_Float'Exponent (Gen.Next_Gaussian)));
+
+      else
+         Result (Sys_Max_Image_Width + 2) := '0';
+      end if;
+
+      return Result;
+   end Image;
+
+end GNAT.Random_Numbers;