From be3416c681291e5a3f6e68d311c958fb05bc7f41 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 11:35:46 +0200 Subject: [multiple changes] 2017-04-25 Eric Botcazou * a-numaux.ads: Fix description of a-numaux-darwin and a-numaux-x86. (Double): Define to Long_Float. * a-numaux-vxworks.ads (Double): Likewise. * a-numaux-darwin.ads (Double): Likewise. * a-numaux-libc-x86.ads (Double): Define to Long_Long_Float. * a-numaux-x86.ads: Fix package description. * a-numaux-x86.adb (Is_Nan): Minor tweak. (Reduce): Adjust and complete description. Call Is_Nan instead of testing manually. Use an integer temporary to hold rounded value. * a-numaux-darwin.adb (Reduce): Likewise. (Is_Nan): New function. 2017-04-25 Ed Schonberg * sem_ch4.adb (Analyze_Selected_Component): Additional refinement on analysis of prefix whose type is a current instance of a synchronized type, but where the prefix itself is an entity that is an object. 2017-04-25 Ed Schonberg * exp_ch5.adb (Replace_Target): When rewriting the RHS, preserve the identity of callable entities therein, because they have been properly resolved, and prefixed calls may have been rewritten as normal calls. 2017-04-25 Patrick Bernardi * exp_ch3.adb (Build_Init_Statements): Convert the expression of the pragma/aspect Secondary_Stack_Size to internal type System.Parameters.Size_Type before assigning it to the Secondary_Stack_Size component of the task type's corresponding record. 2017-04-25 Eric Botcazou * sem_eval.adb (Compile_Time_Compare): Reinstate the expr+literal (etc) optimizations when the type is modular and the offsets are equal. 2017-04-25 Eric Botcazou * s-osinte-freebsd.ads: Minor comment tweaks 2017-04-25 Javier Miranda * urealp.adb (UR_Write): Reverse previous patch adding documentation on why we generate multiplications instead of divisions (needed to avoid expressions whose computation with large numbers may cause division by 0). 2017-04-25 Bob Duff * erroutc.adb (Set_Specific_Warning_Off, Set_Warnings_Mode_Off): Use the correct source file for Stop. Was using Current_Source_File, which is only valid during parsing. Current_Source_File will have a leftover value from whatever file happened to be parsed last, because of a with_clause or something. 2017-04-25 Bob Duff * lib.ads, lib.adb (In_Internal_Unit): New functions similar to In_Predefined_Unit, but including GNAT units. * sem_util.ads, sem_util.adb (Should_Ignore_Pragma): Replace with Should_Ignore_Pragma_Par and Should_Ignore_Pragma_Sem, because Should_Ignore_Pragma was not working reliably outside the parser, because Current_Source_File is not valid. * sem_prag.adb, exp_prag.adb: Call Should_Ignore_Pragma_Sem. * par-prag.adb: Call Should_Ignore_Pragma_Par. From-SVN: r247162 --- gcc/ada/a-numaux-darwin.adb | 48 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 38 insertions(+), 10 deletions(-) (limited to 'gcc/ada/a-numaux-darwin.adb') diff --git a/gcc/ada/a-numaux-darwin.adb b/gcc/ada/a-numaux-darwin.adb index 2e9ffd9..3c4a101 100644 --- a/gcc/ada/a-numaux-darwin.adb +++ b/gcc/ada/a-numaux-darwin.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Apple OS X Version) -- -- -- --- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2016, 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- -- @@ -36,11 +36,17 @@ package body Ada.Numerics.Aux is -- Local subprograms -- ----------------------- + function Is_Nan (X : Double) return Boolean; + -- Return True iff X is a IEEE NaN value + procedure Reduce (X : in out Double; Q : out Natural); - -- Implements reduction of X by Pi/2. Q is the quadrant of the final - -- result in the range 0 .. 3. The absolute value of X is at most Pi/4. + -- Implement reduction of X by Pi/2. Q is the quadrant of the final + -- result in the range 0..3. The absolute value of X is at most Pi/4. + -- It is needed to avoid a loss of accuracy for sin near Pi and cos + -- near Pi/2 due to the use of an insufficiently precise value of Pi + -- in the range reduction. - -- The following three functions implement Chebishev approximations + -- The following two functions implement Chebishev approximations -- of the trigonometric functions in their reduced domain. -- These approximations have been computed using Maple. @@ -51,6 +57,10 @@ package body Ada.Numerics.Aux is pragma Inline (Sine_Approx); pragma Inline (Cosine_Approx); + ------------------- + -- Cosine_Approx -- + ------------------- + function Cosine_Approx (X : Double) return Double is XX : constant Double := X * X; begin @@ -63,6 +73,10 @@ package body Ada.Numerics.Aux is - 16#3.655E64869ECCE#E-14 + 1.0; end Cosine_Approx; + ----------------- + -- Sine_Approx -- + ----------------- + function Sine_Approx (X : Double) return Double is XX : constant Double := X * X; begin @@ -75,6 +89,17 @@ package body Ada.Numerics.Aux is end Sine_Approx; ------------ + -- Is_Nan -- + ------------ + + function Is_Nan (X : Double) return Boolean is + begin + -- The IEEE NaN values are the only ones that do not equal themselves + + return X /= X; + end Is_Nan; + + ------------ -- Reduce -- ------------ @@ -92,6 +117,7 @@ package body Ada.Numerics.Aux is - P4, HM); P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5); K : Double; + R : Integer; begin -- For X < 2.0**HM, all products below are computed exactly. @@ -101,7 +127,7 @@ package body Ada.Numerics.Aux is -- rounded result of X - K * (Pi / 2.0). K := X * Two_Over_Pi; - while abs K >= 2.0 ** HM loop + while abs K >= 2.0**HM loop K := K * M - (K * M - K); X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; @@ -110,14 +136,16 @@ package body Ada.Numerics.Aux is -- If K is not a number (because X was not finite) raise exception - if K /= K then + if Is_Nan (K) then raise Constraint_Error; end if; - K := Double'Rounding (K); - Q := Integer (K) mod 4; - X := (((((X - K * P1) - K * P2) - K * P3) - - K * P4) - K * P5) - K * P6; + -- Go through an integer temporary so as to use machine instructions + + R := Integer (Double'Rounding (K)); + Q := R mod 4; + K := Double (R); + X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; end Reduce; --------- -- cgit v1.1