diff options
Diffstat (limited to 'gcc-4.4.3/gcc/ada/g-rannum.adb')
| -rw-r--r-- | gcc-4.4.3/gcc/ada/g-rannum.adb | 308 |
1 files changed, 0 insertions, 308 deletions
diff --git a/gcc-4.4.3/gcc/ada/g-rannum.adb b/gcc-4.4.3/gcc/ada/g-rannum.adb deleted file mode 100644 index e35c86cb2..000000000 --- a/gcc-4.4.3/gcc/ada/g-rannum.adb +++ /dev/null @@ -1,308 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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-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 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; |