diff options
author | Alexandre Oliva <oliva@adacore.com> | 2020-10-18 17:19:53 -0300 |
---|---|---|
committer | Alexandre Oliva <oliva@gnu.org> | 2020-10-18 17:19:53 -0300 |
commit | 1e70b1a358b6ce3b894f284d88fbb90518d45cc0 (patch) | |
tree | c944e5cf3eb433dcea8fbc2ad4a850c7d38846cc /gcc/ada/libgnat/a-numaux__darwin.adb | |
parent | 476036b35c5e9203735b19b9967ff0e9932c8c31 (diff) | |
download | gcc-1e70b1a358b6ce3b894f284d88fbb90518d45cc0.zip gcc-1e70b1a358b6ce3b894f284d88fbb90518d45cc0.tar.gz gcc-1e70b1a358b6ce3b894f284d88fbb90518d45cc0.tar.bz2 |
revamp ada.numerics.aux
Instead of mapping elementary functions for all types to a single
type, use the intrinsics available for the various base types.
A new Ada.Numerics.Aux_Generic_Float is introduced to explicitly
dispatch, based on the 'Digits attribute of the base type, to the
various newly-added Aux_Short_Float, Aux_Float, Aux_Long_Float, or
Aux_Long_Long_Float.
The Aux_Short_Float unit is implemented in terms of the Aux_Float one,
and the others rely on the elementary functions from the C Math
library for float, double and long double types, respectively.
An Aux_Linker_Options is added, and units that import intrinsics from
libm/libc depend on it to provide the "-lm" linker option if needed.
The option is provided by default, but there is an alternate version
that doesn't, that is used for vxworks targets.
The Aux variant that used to open-code Sin and Cos for the ancient
ppc-darwin, because of insufficient precision in libc, is dropped,
along with the alternate dummy body for Aux. Both are presumed no
longer needed.
The original Ada.Numerics.Aux is retained, for backward compatibility,
as a wrapper for a newly-added Aux_Compat, that renames
Aux_Long_Float, except on x86, in which an alternate version renames
Aux_Long_Long_Float.
Generic_Elementary_Functions and Generic_Complex_Types are adjusted to
use Aux_Generic_Float, avoiding the type conversions and inefficiencies of
computing results in higher precision than requested.
Generic_Complex_Elementary_Functions is adjusted to enable an
additional instance of the sincos optimization, even without -gnatn.
for gcc/ada/ChangeLog
* Makefile.rtl (GNATRTL_NONTASKING_OBJS): Compile Ada.Numerics
child units Aux_Generic_Float, Aux_Long_Long_Float, Aux_Long_Float,
Aux_Float, Aux_Short_Float, Aux_Compat, and Aux_Linker_Options.
(X86_TARGET_PAIRS): Drop dummy body for Aux. Use x86 version
of Aux_Compat.
(X86_64_TARGET_PAIRS): Likewise.
(LIBGNAT_TARGET_PAIRS): On VxWorks, select the nolibm
variants. Drop the darwin version of Aux. Drop the redundant
libc-x86 numaux variants on x86* kfreebsd variants.
* libgnat/a-nagefl.ads: New Aux_Generic_Float.
* libgnat/a-naliop.ads: New Aux_Linker_Options.
* libgnat/a-naliop__nolibm.ads: New.
* libgnat/a-nallfl.ads: New Aux_Long_Long_Float.
* libgnat/a-nalofl.ads: New Aux_Long_Float.
* libgnat/a-nuaufl.ads: New Aux_Float.
* libgnat/a-nashfl.ads: New Aux_Short_Float.
* libgnat/a-ngcefu.adb (Exp): Factor out the Im (X) passed to
Sin and Cos in the Complex variant too.
* libgnat/a-ngcoty.adb: Switch to Aux_Generic_Float. Drop
redundant conversions.
* libgnat/a-ngelfu.adb: Likewise.
* libgnat/a-nuauco.ads: New Aux_Compat.
* libgnat/a-nuauco__x86.ads: New.
* libgnat/a-numaux.ads: Replace with Compat wrapper.
* libgnat/a-numaux__darwin.adb: Remove.
* libgnat/a-numaux__darwin.ads: Remove.
* libgnat/a-numaux__dummy.adb: Remove.
* libgnat/a-numaux__libc-x86.ads: Remove.
* libgnat/a-numaux__vxworks.ads: Remove.
Diffstat (limited to 'gcc/ada/libgnat/a-numaux__darwin.adb')
-rw-r--r-- | gcc/ada/libgnat/a-numaux__darwin.adb | 211 |
1 files changed, 0 insertions, 211 deletions
diff --git a/gcc/ada/libgnat/a-numaux__darwin.adb b/gcc/ada/libgnat/a-numaux__darwin.adb deleted file mode 100644 index 85fdd24..0000000 --- a/gcc/ada/libgnat/a-numaux__darwin.adb +++ /dev/null @@ -1,211 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- A D A . N U M E R I C S . A U X -- --- -- --- B o d y -- --- (Apple OS X Version) -- --- -- --- Copyright (C) 1998-2020, 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 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); - -- 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 two functions implement Chebishev approximations - -- of the trigonometric functions in their reduced domain. - -- These approximations have been computed using Maple. - - function Sine_Approx (X : Double) return Double; - function Cosine_Approx (X : Double) return Double; - - pragma Inline (Reduce); - pragma Inline (Sine_Approx); - pragma Inline (Cosine_Approx); - - ------------------- - -- Cosine_Approx -- - ------------------- - - function Cosine_Approx (X : Double) return Double is - XX : constant Double := X * X; - begin - return (((((16#8.DC57FBD05F640#E-08 * XX - - 16#4.9F7D00BF25D80#E-06) * XX - + 16#1.A019F7FDEFCC2#E-04) * XX - - 16#5.B05B058F18B20#E-03) * XX - + 16#A.AAAAAAAA73FA8#E-02) * XX - - 16#7.FFFFFFFFFFDE4#E-01) * XX - - 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 - return (((((16#A.EA2D4ABE41808#E-09 * XX - - 16#6.B974C10F9D078#E-07) * XX - + 16#2.E3BC673425B0E#E-05) * XX - - 16#D.00D00CCA7AF00#E-04) * XX - + 16#2.222222221B190#E-02) * XX - - 16#2.AAAAAAAAAAA44#E-01) * (XX * X) + X; - 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 -- - ------------ - - procedure Reduce (X : in out Double; Q : out Natural) is - Half_Pi : constant := Pi / 2.0; - Two_Over_Pi : constant := 2.0 / Pi; - - HM : constant := Integer'Min (Double'Machine_Mantissa / 2, Natural'Size); - M : constant Double := 0.5 + 2.0**(1 - HM); -- Splitting constant - P1 : constant Double := Double'Leading_Part (Half_Pi, HM); - P2 : constant Double := Double'Leading_Part (Half_Pi - P1, HM); - P3 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2, HM); - P4 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3, HM); - P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3 - - 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. - -- Due to cancellation effects all subtractions are exact as well. - -- As no double extended floating-point number has more than 75 - -- zeros after the binary point, the result will be the correctly - -- rounded result of X - K * (Pi / 2.0). - - K := X * Two_Over_Pi; - 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; - K := X * Two_Over_Pi; - end loop; - - -- If K is not a number (because X was not finite) raise exception - - if Is_Nan (K) then - raise Constraint_Error; - end if; - - -- 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; - - --------- - -- Cos -- - --------- - - function Cos (X : Double) return Double is - Reduced_X : Double := abs X; - Quadrant : Natural range 0 .. 3; - - begin - if Reduced_X > Pi / 4.0 then - Reduce (Reduced_X, Quadrant); - - case Quadrant is - when 0 => - return Cosine_Approx (Reduced_X); - - when 1 => - return Sine_Approx (-Reduced_X); - - when 2 => - return -Cosine_Approx (Reduced_X); - - when 3 => - return Sine_Approx (Reduced_X); - end case; - end if; - - return Cosine_Approx (Reduced_X); - end Cos; - - --------- - -- Sin -- - --------- - - function Sin (X : Double) return Double is - Reduced_X : Double := X; - Quadrant : Natural range 0 .. 3; - - begin - if abs X > Pi / 4.0 then - Reduce (Reduced_X, Quadrant); - - case Quadrant is - when 0 => - return Sine_Approx (Reduced_X); - - when 1 => - return Cosine_Approx (Reduced_X); - - when 2 => - return Sine_Approx (-Reduced_X); - - when 3 => - return -Cosine_Approx (Reduced_X); - end case; - end if; - - return Sine_Approx (Reduced_X); - end Sin; - -end Ada.Numerics.Aux; |