From 3186be22b6598fbd467b126347d1c7f48ccb7f71 Mon Sep 17 00:00:00 2001 From: Dan Albert Date: Thu, 14 Jan 2016 16:43:34 -0800 Subject: Check in a pristine copy of GCC 4.8.1. The copy of GCC that we use for Android is still not working for mingw. Rather than finding all the differences that have crept into our GCC, just check in a copy from ftp://ftp.gnu.org/gnu/gcc/gcc-4.9.3/gcc-4.8.1.tar.bz2. GCC 4.8.1 was chosen because it is what we have been using for mingw thus far, and the emulator doesn't yet work when upgrading to 4.9. Bug: http://b/26523949 Change-Id: Iedc0f05243d4332cc27ccd46b8a4b203c88dcaa3 --- gcc-4.8.1/gcc/ada/g-rannum.adb | 308 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 308 insertions(+) create mode 100644 gcc-4.8.1/gcc/ada/g-rannum.adb (limited to 'gcc-4.8.1/gcc/ada/g-rannum.adb') diff --git a/gcc-4.8.1/gcc/ada/g-rannum.adb b/gcc-4.8.1/gcc/ada/g-rannum.adb new file mode 100644 index 000000000..e35c86cb2 --- /dev/null +++ b/gcc-4.8.1/gcc/ada/g-rannum.adb @@ -0,0 +1,308 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- . -- +-- -- +-- 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; -- cgit v1.2.3