From 1e70b1a358b6ce3b894f284d88fbb90518d45cc0 Mon Sep 17 00:00:00 2001 From: Alexandre Oliva Date: Sun, 18 Oct 2020 17:19:53 -0300 Subject: [PATCH] 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. --- gcc/ada/Makefile.rtl | 27 +-- gcc/ada/libgnat/a-nagefl.ads | 171 ++++++++++++++ gcc/ada/libgnat/a-naliop.ads | 45 ++++ gcc/ada/libgnat/a-naliop__nolibm.ads | 43 ++++ .../{a-numaux__vxworks.ads => a-nallfl.ads} | 84 +++---- .../{a-numaux__darwin.ads => a-nalofl.ads} | 94 ++++---- gcc/ada/libgnat/a-nashfl.ads | 87 ++++++++ gcc/ada/libgnat/a-ngcefu.adb | 5 +- gcc/ada/libgnat/a-ngcoty.adb | 34 +-- gcc/ada/libgnat/a-ngelfu.adb | 39 ++-- gcc/ada/libgnat/a-nuauco.ads | 40 ++++ ...{a-numaux__dummy.adb => a-nuauco__x86.ads} | 17 +- .../{a-numaux__libc-x86.ads => a-nuaufl.ads} | 84 +++---- gcc/ada/libgnat/a-numaux.ads | 94 +++----- gcc/ada/libgnat/a-numaux__darwin.adb | 211 ------------------ 15 files changed, 598 insertions(+), 477 deletions(-) create mode 100644 gcc/ada/libgnat/a-nagefl.ads create mode 100644 gcc/ada/libgnat/a-naliop.ads create mode 100644 gcc/ada/libgnat/a-naliop__nolibm.ads rename gcc/ada/libgnat/{a-numaux__vxworks.ads => a-nallfl.ads} (55%) rename gcc/ada/libgnat/{a-numaux__darwin.ads => a-nalofl.ads} (52%) create mode 100644 gcc/ada/libgnat/a-nashfl.ads create mode 100644 gcc/ada/libgnat/a-nuauco.ads rename gcc/ada/libgnat/{a-numaux__dummy.adb => a-nuauco__x86.ads} (76%) rename gcc/ada/libgnat/{a-numaux__libc-x86.ads => a-nuaufl.ads} (57%) delete mode 100644 gcc/ada/libgnat/a-numaux__darwin.adb diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index cd381842100..2bc95dba7aa 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -234,6 +234,13 @@ GNATRTL_NONTASKING_OBJS= \ a-nudira$(objext) \ a-nuelfu$(objext) \ a-nuflra$(objext) \ + a-nagefl$(objext) \ + a-nallfl$(objext) \ + a-nalofl$(objext) \ + a-nuaufl$(objext) \ + a-nashfl$(objext) \ + a-nuauco$(objext) \ + a-naliop$(objext) \ a-numaux$(objext) \ a-numeri$(objext) \ a-nurear$(objext) \ @@ -834,13 +841,11 @@ ATOMICS_BUILTINS_TARGET_PAIRS = \ # Special version of units for x86 and x86-64 platforms. X86_TARGET_PAIRS = \ - a-numaux.ads. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides the basic computational interface for the generic +-- elementary functions. The C library version interfaces with the routines +-- in the C mathematical library. + +-- This version here is for use with normal Unix math functions. + +with Ada.Numerics.Aux_Long_Long_Float; +with Ada.Numerics.Aux_Long_Float; +with Ada.Numerics.Aux_Float; +with Ada.Numerics.Aux_Short_Float; + +generic + type T is digits <>; +package Ada.Numerics.Aux_Generic_Float is + pragma Pure; + + package LLF renames Aux_Long_Long_Float; + package LF renames Aux_Long_Float; + package F renames Aux_Float; + package SF renames Aux_Short_Float; + + function Sin (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Sin (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Sin (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Sin (F.T (X))) + else T'Base (SF.Sin (SF.T (X)))); + + function Cos (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Cos (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Cos (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Cos (F.T (X))) + else T'Base (SF.Cos (SF.T (X)))); + + function Tan (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Tan (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Tan (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Tan (F.T (X))) + else T'Base (SF.Tan (SF.T (X)))); + + function Exp (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Exp (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Exp (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Exp (F.T (X))) + else T'Base (SF.Exp (SF.T (X)))); + + function Sqrt (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Sqrt (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Sqrt (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Sqrt (F.T (X))) + else T'Base (SF.Sqrt (SF.T (X)))); + + function Log (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Log (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Log (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Log (F.T (X))) + else T'Base (SF.Log (SF.T (X)))); + + function Acos (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Acos (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Acos (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Acos (F.T (X))) + else T'Base (SF.Acos (SF.T (X)))); + + function Asin (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Asin (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Asin (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Asin (F.T (X))) + else T'Base (SF.Asin (SF.T (X)))); + + function Atan (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Atan (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Atan (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Atan (F.T (X))) + else T'Base (SF.Atan (SF.T (X)))); + + function Sinh (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Sinh (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Sinh (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Sinh (F.T (X))) + else T'Base (SF.Sinh (SF.T (X)))); + + function Cosh (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Cosh (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Cosh (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Cosh (F.T (X))) + else T'Base (SF.Cosh (SF.T (X)))); + + function Tanh (X : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Tanh (LLF.T (X))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Tanh (LF.T (X))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Tanh (F.T (X))) + else T'Base (SF.Tanh (SF.T (X)))); + + function Pow (X, Y : T'Base) return T'Base + is (if T'Base'Digits > LF.T'Digits + then T'Base (LLF.Pow (LLF.T (X), LLF.T (Y))) + elsif T'Base'Digits > F.T'Digits + then T'Base (LF.Pow (LF.T (X), LF.T (Y))) + elsif T'Base'Digits > SF.T'Digits + then T'Base (F.Pow (F.T (X), F.T (Y))) + else T'Base (SF.Pow (SF.T (X), SF.T (Y)))); + +end Ada.Numerics.Aux_Generic_Float; diff --git a/gcc/ada/libgnat/a-naliop.ads b/gcc/ada/libgnat/a-naliop.ads new file mode 100644 index 00000000000..81de811240e --- /dev/null +++ b/gcc/ada/libgnat/a-naliop.ads @@ -0,0 +1,45 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ L I N K E R _ O P T I O N S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2001-2020, AdaCore -- +-- -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package is used to provide target specific linker_options for +-- the support of C Library Math functions as required by other +-- children packages of Ada.Numerics.Aux. + +-- This is a version for default use that links with -lm. An +-- alternate __nolibm version is to be used where no additional +-- libraries are required. + +-- This package should not be directly with'ed by an application program + +package Ada.Numerics.Aux_Linker_Options is + pragma Pure; + pragma Linker_Options ("-lm"); +end Ada.Numerics.Aux_Linker_Options; diff --git a/gcc/ada/libgnat/a-naliop__nolibm.ads b/gcc/ada/libgnat/a-naliop__nolibm.ads new file mode 100644 index 00000000000..dc1969a7a9f --- /dev/null +++ b/gcc/ada/libgnat/a-naliop__nolibm.ads @@ -0,0 +1,43 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ L I N K E R _ O P T I O N S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2001-2020, AdaCore -- +-- -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package is used to provide target specific linker_options for +-- the support of C Library Math functions as required by other +-- children packages of Ada.Numerics.Aux. + +-- This is a version to be used where no additional libraries are +-- required. + +-- This package should not be directly with'ed by an application program + +package Ada.Numerics.Aux_Linker_Options is + pragma Pure; +end Ada.Numerics.Aux_Linker_Options; diff --git a/gcc/ada/libgnat/a-numaux__vxworks.ads b/gcc/ada/libgnat/a-nallfl.ads similarity index 55% rename from gcc/ada/libgnat/a-numaux__vxworks.ads rename to gcc/ada/libgnat/a-nallfl.ads index 410655de8a6..ca998fadc34 100644 --- a/gcc/ada/libgnat/a-numaux__vxworks.ads +++ b/gcc/ada/libgnat/a-nallfl.ads @@ -2,10 +2,10 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- A D A . N U M E R I C S . A U X -- +-- A D A . N U M E R I C S . A U X . L O N G _ L O N G _ F L O A T -- -- -- -- S p e c -- --- (C Library Version, VxWorks) -- +-- (C Math Library Version, Long Long Float) -- -- -- -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- -- -- @@ -30,68 +30,58 @@ -- -- ------------------------------------------------------------------------------ --- Version for use on VxWorks (where we have no libm.a library), so the pragma --- Linker_Options ("-lm") is omitted in this version. +-- This package provides the basic computational interface for the generic +-- elementary functions. The C library version interfaces with the routines +-- in the C mathematical library, and is thus quite portable. -package Ada.Numerics.Aux is +with Ada.Numerics.Aux_Linker_Options; +pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); + +package Ada.Numerics.Aux_Long_Long_Float is pragma Pure; - type Double is new Long_Float; - -- Type Double is the type used to call the C routines + subtype T is Long_Long_Float; -- We import these functions directly from C. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. - function Sin (X : Double) return Double; - pragma Import (Intrinsic, Sin, "sin"); - pragma Pure_Function (Sin); + function Sin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinl"; - function Cos (X : Double) return Double; - pragma Import (Intrinsic, Cos, "cos"); - pragma Pure_Function (Cos); + function Cos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cosl"; - function Tan (X : Double) return Double; - pragma Import (Intrinsic, Tan, "tan"); - pragma Pure_Function (Tan); + function Tan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanl"; - function Exp (X : Double) return Double; - pragma Import (Intrinsic, Exp, "exp"); - pragma Pure_Function (Exp); + function Exp (X : T) return T with + Import, Convention => Intrinsic, External_Name => "expl"; - function Sqrt (X : Double) return Double; - pragma Import (Intrinsic, Sqrt, "sqrt"); - pragma Pure_Function (Sqrt); + function Sqrt (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sqrtl"; - function Log (X : Double) return Double; - pragma Import (Intrinsic, Log, "log"); - pragma Pure_Function (Log); + function Log (X : T) return T with + Import, Convention => Intrinsic, External_Name => "logl"; - function Acos (X : Double) return Double; - pragma Import (Intrinsic, Acos, "acos"); - pragma Pure_Function (Acos); + function Acos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "acosl"; - function Asin (X : Double) return Double; - pragma Import (Intrinsic, Asin, "asin"); - pragma Pure_Function (Asin); + function Asin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "asinl"; - function Atan (X : Double) return Double; - pragma Import (Intrinsic, Atan, "atan"); - pragma Pure_Function (Atan); + function Atan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "atanl"; - function Sinh (X : Double) return Double; - pragma Import (Intrinsic, Sinh, "sinh"); - pragma Pure_Function (Sinh); + function Sinh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinhl"; - function Cosh (X : Double) return Double; - pragma Import (Intrinsic, Cosh, "cosh"); - pragma Pure_Function (Cosh); + function Cosh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "coshl"; - function Tanh (X : Double) return Double; - pragma Import (Intrinsic, Tanh, "tanh"); - pragma Pure_Function (Tanh); + function Tanh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanhl"; - function Pow (X, Y : Double) return Double; - pragma Import (Intrinsic, Pow, "pow"); - pragma Pure_Function (Pow); + function Pow (X, Y : T) return T with + Import, Convention => Intrinsic, External_Name => "powl"; -end Ada.Numerics.Aux; +end Ada.Numerics.Aux_Long_Long_Float; diff --git a/gcc/ada/libgnat/a-numaux__darwin.ads b/gcc/ada/libgnat/a-nalofl.ads similarity index 52% rename from gcc/ada/libgnat/a-numaux__darwin.ads rename to gcc/ada/libgnat/a-nalofl.ads index add87a49193..4cdf2f4ac9f 100644 --- a/gcc/ada/libgnat/a-numaux__darwin.ads +++ b/gcc/ada/libgnat/a-nalofl.ads @@ -2,10 +2,10 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- A D A . N U M E R I C S . A U X -- +-- A D A . N U M E R I C S . A U X _ L O N G _ F L O A T -- -- -- -- S p e c -- --- (Apple OS X Version) -- +-- (C Math Library Version, Long Float) -- -- -- -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- -- -- @@ -30,74 +30,58 @@ -- -- ------------------------------------------------------------------------------ --- This version is for use on OS X. It uses the normal Unix math functions, --- except for sine/cosine which have been implemented directly in Ada to get --- the required accuracy. +-- This package provides the basic computational interface for the generic +-- elementary functions. The C library version interfaces with the routines +-- in the C mathematical library, and is thus quite portable. -package Ada.Numerics.Aux is - pragma Pure; - - pragma Linker_Options ("-lm"); - - type Double is new Long_Float; - -- Type Double is the type used to call the C routines +with Ada.Numerics.Aux_Linker_Options; +pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); - -- The following functions have been implemented in Ada, since - -- the OS X math library didn't meet accuracy requirements for - -- argument reduction. The implementation here has been tailored - -- to match Ada strict mode Numerics requirements while maintaining - -- maximum efficiency. - function Sin (X : Double) return Double; - pragma Inline (Sin); +package Ada.Numerics.Aux_Long_Float is + pragma Pure; - function Cos (X : Double) return Double; - pragma Inline (Cos); + subtype T is Long_Float; -- We import these functions directly from C. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. - function Tan (X : Double) return Double; - pragma Import (Intrinsic, Tan, "tan"); - pragma Pure_Function (Tan); + function Sin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sin"; + + function Cos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cos"; + + function Tan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tan"; - function Exp (X : Double) return Double; - pragma Import (Intrinsic, Exp, "exp"); - pragma Pure_Function (Exp); + function Exp (X : T) return T with + Import, Convention => Intrinsic, External_Name => "exp"; - function Sqrt (X : Double) return Double; - pragma Import (Intrinsic, Sqrt, "sqrt"); - pragma Pure_Function (Sqrt); + function Sqrt (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sqrt"; - function Log (X : Double) return Double; - pragma Import (Intrinsic, Log, "log"); - pragma Pure_Function (Log); + function Log (X : T) return T with + Import, Convention => Intrinsic, External_Name => "log"; - function Acos (X : Double) return Double; - pragma Import (Intrinsic, Acos, "acos"); - pragma Pure_Function (Acos); + function Acos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "acos"; - function Asin (X : Double) return Double; - pragma Import (Intrinsic, Asin, "asin"); - pragma Pure_Function (Asin); + function Asin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "asin"; - function Atan (X : Double) return Double; - pragma Import (Intrinsic, Atan, "atan"); - pragma Pure_Function (Atan); + function Atan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "atan"; - function Sinh (X : Double) return Double; - pragma Import (Intrinsic, Sinh, "sinh"); - pragma Pure_Function (Sinh); + function Sinh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinh"; - function Cosh (X : Double) return Double; - pragma Import (Intrinsic, Cosh, "cosh"); - pragma Pure_Function (Cosh); + function Cosh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cosh"; - function Tanh (X : Double) return Double; - pragma Import (Intrinsic, Tanh, "tanh"); - pragma Pure_Function (Tanh); + function Tanh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanh"; - function Pow (X, Y : Double) return Double; - pragma Import (Intrinsic, Pow, "pow"); - pragma Pure_Function (Pow); + function Pow (X, Y : T) return T with + Import, Convention => Intrinsic, External_Name => "pow"; -end Ada.Numerics.Aux; +end Ada.Numerics.Aux_Long_Float; diff --git a/gcc/ada/libgnat/a-nashfl.ads b/gcc/ada/libgnat/a-nashfl.ads new file mode 100644 index 00000000000..eaee8622bad --- /dev/null +++ b/gcc/ada/libgnat/a-nashfl.ads @@ -0,0 +1,87 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ S H O R T _ F L O A T -- +-- -- +-- S p e c -- +-- (Short Float Wrapper in terms of Float) -- +-- -- +-- Copyright (C) 1992-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 -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides the basic computational interface for the +-- generic elementary functions. The functions in this unit are +-- wrappers for those in the Float package. + +with Ada.Numerics.Aux_Float; + +package Ada.Numerics.Aux_Short_Float is + pragma Pure; + + subtype T is Short_Float; + package Aux renames Ada.Numerics.Aux_Float; + subtype W is Aux.T; + + -- Use the Aux implementation. + + function Sin (X : T) return T + is (T (Aux.Sin (W (X)))); + + function Cos (X : T) return T + is (T (Aux.Cos (W (X)))); + + function Tan (X : T) return T + is (T (Aux.Tan (W (X)))); + + function Exp (X : T) return T + is (T (Aux.Exp (W (X)))); + + function Sqrt (X : T) return T + is (T (Aux.Sqrt (W (X)))); + + function Log (X : T) return T + is (T (Aux.Log (W (X)))); + + function Acos (X : T) return T + is (T (Aux.Acos (W (X)))); + + function Asin (X : T) return T + is (T (Aux.Asin (W (X)))); + + function Atan (X : T) return T + is (T (Aux.Atan (W (X)))); + + function Sinh (X : T) return T + is (T (Aux.Sinh (W (X)))); + + function Cosh (X : T) return T + is (T (Aux.Cosh (W (X)))); + + function Tanh (X : T) return T + is (T (Aux.Tanh (W (X)))); + + function Pow (X, Y : T) return T + is (T (Aux.Pow (W (X), W (Y)))); + +end Ada.Numerics.Aux_Short_Float; diff --git a/gcc/ada/libgnat/a-ngcefu.adb b/gcc/ada/libgnat/a-ngcefu.adb index 46af6f8ab29..d47a14f2078 100644 --- a/gcc/ada/libgnat/a-ngcefu.adb +++ b/gcc/ada/libgnat/a-ngcefu.adb @@ -481,11 +481,12 @@ package body Ada.Numerics.Generic_Complex_Elementary_Functions is --------- function Exp (X : Complex) return Complex is + ImX : constant Real'Base := Im (X); EXP_RE_X : constant Real'Base := Exp (Re (X)); begin - return Compose_From_Cartesian (EXP_RE_X * Cos (Im (X)), - EXP_RE_X * Sin (Im (X))); + return Compose_From_Cartesian (EXP_RE_X * Cos (ImX), + EXP_RE_X * Sin (ImX)); end Exp; function Exp (X : Imaginary) return Complex is diff --git a/gcc/ada/libgnat/a-ngcoty.adb b/gcc/ada/libgnat/a-ngcoty.adb index 6785ccf34a9..b369dfcfc39 100644 --- a/gcc/ada/libgnat/a-ngcoty.adb +++ b/gcc/ada/libgnat/a-ngcoty.adb @@ -29,10 +29,12 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Numerics.Aux; use Ada.Numerics.Aux; +with Ada.Numerics.Aux_Generic_Float; package body Ada.Numerics.Generic_Complex_Types is + package Aux is new Ada.Numerics.Aux_Generic_Float (Real); + subtype R is Real'Base; Two_Pi : constant R := R (2.0) * Pi; @@ -440,7 +442,7 @@ package body Ada.Numerics.Generic_Complex_Types is end if; else - arg := R (Atan (Double (abs (b / a)))); + arg := Aux.Atan (abs (b / a)); if a > 0.0 then if b > 0.0 then @@ -507,8 +509,8 @@ package body Ada.Numerics.Generic_Complex_Types is if Modulus = 0.0 then return (0.0, 0.0); else - return (Modulus * R (Cos (Double (Argument))), - Modulus * R (Sin (Double (Argument)))); + return (Modulus * Aux.Cos (Argument), + Modulus * Aux.Sin (Argument)); end if; end Compose_From_Polar; @@ -536,8 +538,8 @@ package body Ada.Numerics.Generic_Complex_Types is return (0.0, -Modulus); else Arg := Two_Pi * Argument / Cycle; - return (Modulus * R (Cos (Double (Arg))), - Modulus * R (Sin (Double (Arg)))); + return (Modulus * Aux.Cos (Arg), + Modulus * Aux.Sin (Arg)); end if; else raise Argument_Error; @@ -597,8 +599,8 @@ package body Ada.Numerics.Generic_Complex_Types is exception when Constraint_Error => pragma Assert (X.Re /= 0.0); - return R (Double (abs (X.Re)) - * Sqrt (1.0 + (Double (X.Im) / Double (X.Re)) ** 2)); + return R (abs (X.Re)) + * Aux.Sqrt (1.0 + (R (X.Im) / R (X.Re)) ** 2); end; begin @@ -612,8 +614,8 @@ package body Ada.Numerics.Generic_Complex_Types is exception when Constraint_Error => pragma Assert (X.Im /= 0.0); - return R (Double (abs (X.Im)) - * Sqrt (1.0 + (Double (X.Re) / Double (X.Im)) ** 2)); + return R (abs (X.Im)) + * Aux.Sqrt (1.0 + (R (X.Re) / R (X.Im)) ** 2); end; -- Now deal with cases of underflow. If only one of the squares @@ -632,13 +634,11 @@ package body Ada.Numerics.Generic_Complex_Types is else if abs (X.Re) > abs (X.Im) then - return - R (Double (abs (X.Re)) - * Sqrt (1.0 + (Double (X.Im) / Double (X.Re)) ** 2)); + return R (abs (X.Re)) + * Aux.Sqrt (1.0 + (R (X.Im) / R (X.Re)) ** 2); else - return - R (Double (abs (X.Im)) - * Sqrt (1.0 + (Double (X.Re) / Double (X.Im)) ** 2)); + return R (abs (X.Im)) + * Aux.Sqrt (1.0 + (R (X.Re) / R (X.Im)) ** 2); end if; end if; @@ -652,7 +652,7 @@ package body Ada.Numerics.Generic_Complex_Types is -- In all other cases, the naive computation will do else - return R (Sqrt (Double (Re2 + Im2))); + return Aux.Sqrt (Re2 + Im2); end if; end Modulus; diff --git a/gcc/ada/libgnat/a-ngelfu.adb b/gcc/ada/libgnat/a-ngelfu.adb index 7e7c6623850..3f7c3d1dc28 100644 --- a/gcc/ada/libgnat/a-ngelfu.adb +++ b/gcc/ada/libgnat/a-ngelfu.adb @@ -36,13 +36,13 @@ -- Uses functions sqrt, exp, log, pow, sin, asin, cos, acos, tan, atan, sinh, -- cosh, tanh from C library via math.h -with Ada.Numerics.Aux; +with Ada.Numerics.Aux_Generic_Float; package body Ada.Numerics.Generic_Elementary_Functions with SPARK_Mode => Off is - use type Ada.Numerics.Aux.Double; + package Aux is new Ada.Numerics.Aux_Generic_Float (Float_Type); Sqrt_Two : constant := 1.41421_35623_73095_04880_16887_24209_69807_85696; Log_Two : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755; @@ -50,7 +50,6 @@ is Half_Log_Two : constant := Log_Two / 2; subtype T is Float_Type'Base; - subtype Double is Aux.Double; Two_Pi : constant T := 2.0 * Pi; Half_Pi : constant T := Pi / 2.0; @@ -150,8 +149,7 @@ is Rest := Rest - 0.25; end if; - Result := Result * - Float_Type'Base (Aux.Pow (Double (Left), Double (Rest))); + Result := Result * Aux.Pow (Left, Rest); if Right >= 0.0 then return Result; @@ -159,8 +157,7 @@ is return (1.0 / Result); end if; else - return - Float_Type'Base (Aux.Pow (Double (Left), Double (Right))); + return Aux.Pow (Left, Right); end if; end if; @@ -194,7 +191,7 @@ is return Pi; end if; - Temp := Float_Type'Base (Aux.Acos (Double (X))); + Temp := Aux.Acos (X); if Temp < 0.0 then Temp := Pi + Temp; @@ -332,7 +329,7 @@ is return -(Pi / 2.0); end if; - return Float_Type'Base (Aux.Asin (Double (X))); + return Aux.Asin (X); end Arcsin; -- Arbitrary cycle @@ -515,7 +512,7 @@ is return 1.0; end if; - return Float_Type'Base (Aux.Cos (Double (X))); + return Aux.Cos (X); end Cos; -- Arbitrary cycle @@ -568,7 +565,7 @@ is return 1.0 / X; end if; - return 1.0 / Float_Type'Base (Aux.Tan (Double (X))); + return 1.0 / Aux.Tan (X); end Cot; -- Arbitrary cycle @@ -617,7 +614,7 @@ is return 1.0 / X; end if; - return 1.0 / Float_Type'Base (Aux.Tanh (Double (X))); + return 1.0 / Aux.Tanh (X); end Coth; --------- @@ -632,7 +629,7 @@ is return 1.0; end if; - Result := Float_Type'Base (Aux.Exp (Double (X))); + Result := Aux.Exp (X); -- Deal with case of Exp returning IEEE infinity. If Machine_Overflows -- is False, then we can just leave it as an infinity (and indeed we @@ -716,7 +713,7 @@ is Raw_Atan := (if Z < Sqrt_Epsilon then Z elsif Z = 1.0 then Pi / 4.0 - else Float_Type'Base (Aux.Atan (Double (Z)))); + else Aux.Atan (Z)); if abs Y > abs X then Raw_Atan := Half_Pi - Raw_Atan; @@ -747,7 +744,7 @@ is return 0.0; end if; - return Float_Type'Base (Aux.Log (Double (X))); + return Aux.Log (X); end Log; -- Arbitrary base @@ -767,7 +764,7 @@ is return 0.0; end if; - return Float_Type'Base (Aux.Log (Double (X)) / Aux.Log (Double (Base))); + return Aux.Log (X) / Aux.Log (Base); end Log; --------- @@ -782,7 +779,7 @@ is return X; end if; - return Float_Type'Base (Aux.Sin (Double (X))); + return Aux.Sin (X); end Sin; -- Arbitrary cycle @@ -816,7 +813,7 @@ is -- Could test for 12.0 * abs T = Cycle, and return an exact value in -- those cases. It is not clear this is worth the extra test though. - return Float_Type'Base (Aux.Sin (Double (T / Cycle * Two_Pi))); + return Aux.Sin (T / Cycle * Two_Pi); end Sin; ---------- @@ -899,7 +896,7 @@ is return X; end if; - return Float_Type'Base (Aux.Sqrt (Double (X))); + return Aux.Sqrt (X); end Sqrt; --------- @@ -919,7 +916,7 @@ is -- with, it is impossible for X to be exactly pi/2, and the result is -- always in range. - return Float_Type'Base (Aux.Tan (Double (X))); + return Aux.Tan (X); end Tan; -- Arbitrary cycle @@ -992,7 +989,7 @@ is return X + X * R; else - return Float_Type'Base (Aux.Tanh (Double (X))); + return Aux.Tanh (X); end if; end Tanh; diff --git a/gcc/ada/libgnat/a-nuauco.ads b/gcc/ada/libgnat/a-nuauco.ads new file mode 100644 index 00000000000..7fd49a8acd7 --- /dev/null +++ b/gcc/ada/libgnat/a-nuauco.ads @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ C O M P A T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2001-2020, AdaCore -- +-- -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package is used to provide the default type for the +-- backward-compatibility Ada.Numerics.Aux interface. This is +-- Long_Float for most platforms, but there is an alternate version +-- for x86 and x86_64 that uses the Long_Long_Float type. + +-- This package should not be directly with'ed by an application program + +with Ada.Numerics.Aux_Long_Float; +package Ada.Numerics.Aux_Compat renames Ada.Numerics.Aux_Long_Float; diff --git a/gcc/ada/libgnat/a-numaux__dummy.adb b/gcc/ada/libgnat/a-nuauco__x86.ads similarity index 76% rename from gcc/ada/libgnat/a-numaux__dummy.adb rename to gcc/ada/libgnat/a-nuauco__x86.ads index f5d72ece8de..f1fbb31a0f1 100644 --- a/gcc/ada/libgnat/a-numaux__dummy.adb +++ b/gcc/ada/libgnat/a-nuauco__x86.ads @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME COMPONENTS -- +-- GNAT COMPILER COMPONENTS -- -- -- --- A D A . N U M E R I C S . A U X -- +-- A D A . N U M E R I C S . A U X . C O M P A T -- -- -- --- B o d y -- +-- S p e c -- -- -- --- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2020, AdaCore -- -- -- -- 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- -- @@ -29,4 +29,11 @@ -- -- ------------------------------------------------------------------------------ -pragma No_Body; +-- This package is used to provide the default type for the +-- backward-compatibility Ada.Numerics.Aux interface. This is a +-- version for x86 and x86_64, that uses the Long_Long_Float type. + +-- This package should not be directly with'ed by an application program + +with Ada.Numerics.Aux_Long_Long_Float; +package Ada.Numerics.Aux_Compat renames Ada.Numerics.Aux_Long_Long_Float; diff --git a/gcc/ada/libgnat/a-numaux__libc-x86.ads b/gcc/ada/libgnat/a-nuaufl.ads similarity index 57% rename from gcc/ada/libgnat/a-numaux__libc-x86.ads rename to gcc/ada/libgnat/a-nuaufl.ads index f6deebecbad..16a34aebade 100644 --- a/gcc/ada/libgnat/a-numaux__libc-x86.ads +++ b/gcc/ada/libgnat/a-nuaufl.ads @@ -2,10 +2,10 @@ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- --- A D A . N U M E R I C S . A U X -- +-- A D A . N U M E R I C S . A U X _ F L O A T -- -- -- -- S p e c -- --- (C Library Version for x86) -- +-- (C Math Library Version, Float) -- -- -- -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- -- -- @@ -30,68 +30,58 @@ -- -- ------------------------------------------------------------------------------ --- This version is for the x86 using the 80-bit x86 long double format +-- This package provides the basic computational interface for the generic +-- elementary functions. The C library version interfaces with the routines +-- in the C mathematical library, and is thus quite portable. -package Ada.Numerics.Aux is - pragma Pure; +with Ada.Numerics.Aux_Linker_Options; +pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options); - pragma Linker_Options ("-lm"); +package Ada.Numerics.Aux_Float is + pragma Pure; - type Double is new Long_Long_Float; + subtype T is Float; -- We import these functions directly from C. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. - function Sin (X : Double) return Double; - pragma Import (Intrinsic, Sin, "sinl"); - pragma Pure_Function (Sin); + function Sin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinf"; - function Cos (X : Double) return Double; - pragma Import (Intrinsic, Cos, "cosl"); - pragma Pure_Function (Cos); + function Cos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "cosf"; - function Tan (X : Double) return Double; - pragma Import (Intrinsic, Tan, "tanl"); - pragma Pure_Function (Tan); + function Tan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanf"; - function Exp (X : Double) return Double; - pragma Import (Intrinsic, Exp, "expl"); - pragma Pure_Function (Exp); + function Exp (X : T) return T with + Import, Convention => Intrinsic, External_Name => "expf"; - function Sqrt (X : Double) return Double; - pragma Import (Intrinsic, Sqrt, "sqrtl"); - pragma Pure_Function (Sqrt); + function Sqrt (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sqrtf"; - function Log (X : Double) return Double; - pragma Import (Intrinsic, Log, "logl"); - pragma Pure_Function (Log); + function Log (X : T) return T with + Import, Convention => Intrinsic, External_Name => "logf"; - function Acos (X : Double) return Double; - pragma Import (Intrinsic, Acos, "acosl"); - pragma Pure_Function (Acos); + function Acos (X : T) return T with + Import, Convention => Intrinsic, External_Name => "acosf"; - function Asin (X : Double) return Double; - pragma Import (Intrinsic, Asin, "asinl"); - pragma Pure_Function (Asin); + function Asin (X : T) return T with + Import, Convention => Intrinsic, External_Name => "asinf"; - function Atan (X : Double) return Double; - pragma Import (Intrinsic, Atan, "atanl"); - pragma Pure_Function (Atan); + function Atan (X : T) return T with + Import, Convention => Intrinsic, External_Name => "atanf"; - function Sinh (X : Double) return Double; - pragma Import (Intrinsic, Sinh, "sinhl"); - pragma Pure_Function (Sinh); + function Sinh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "sinhf"; - function Cosh (X : Double) return Double; - pragma Import (Intrinsic, Cosh, "coshl"); - pragma Pure_Function (Cosh); + function Cosh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "coshf"; - function Tanh (X : Double) return Double; - pragma Import (Intrinsic, Tanh, "tanhl"); - pragma Pure_Function (Tanh); + function Tanh (X : T) return T with + Import, Convention => Intrinsic, External_Name => "tanhf"; - function Pow (X, Y : Double) return Double; - pragma Import (Intrinsic, Pow, "powl"); - pragma Pure_Function (Pow); + function Pow (X, Y : T) return T with + Import, Convention => Intrinsic, External_Name => "powf"; -end Ada.Numerics.Aux; +end Ada.Numerics.Aux_Float; diff --git a/gcc/ada/libgnat/a-numaux.ads b/gcc/ada/libgnat/a-numaux.ads index 4154e1ab216..42ed336d379 100644 --- a/gcc/ada/libgnat/a-numaux.ads +++ b/gcc/ada/libgnat/a-numaux.ads @@ -5,7 +5,6 @@ -- A D A . N U M E R I C S . A U X -- -- -- -- S p e c -- --- (C Library Version, non-x86) -- -- -- -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- -- -- @@ -30,83 +29,60 @@ -- -- ------------------------------------------------------------------------------ --- This package provides the basic computational interface for the generic --- elementary functions. The C library version interfaces with the routines --- in the C mathematical library, and is thus quite portable, although it may --- not necessarily meet the requirements for accuracy in the numerics annex. --- One advantage of using this package is that it will interface directly to --- hardware instructions, such as the those provided on the Intel x86. +-- This is a backward-compatibility unit, for users of this internal +-- package before the introduction of Aux.Generic_Float. --- This version here is for use with normal Unix math functions. Alternative --- versions are provided for special situations: - --- a-numaux-darwin For PowerPC/Darwin (special handling of sin/cos) --- a-numaux-libc-x86 For the x86, using 80-bit long double format --- a-numaux-x86 For the x86, using 80-bit long double format with --- inline asm statements --- a-numaux-vxworks For use on VxWorks (where we have no libm.a library) +with Ada.Numerics.Aux_Compat; package Ada.Numerics.Aux is pragma Pure; - pragma Linker_Options ("-lm"); + package Aux renames Aux_Compat; + + type Double is new Aux.T; - type Double is new Long_Float; - -- Type Double is the type used to call the C routines + subtype T is Double; + subtype W is Aux.T; - -- We import these functions directly from C. Note that we label them - -- all as pure functions, because indeed all of them are in fact pure. + -- Use the Aux implementation. - function Sin (X : Double) return Double; - pragma Import (Intrinsic, Sin, "sin"); - pragma Pure_Function (Sin); + function Sin (X : T) return T + is (T (Aux.Sin (W (X)))); - function Cos (X : Double) return Double; - pragma Import (Intrinsic, Cos, "cos"); - pragma Pure_Function (Cos); + function Cos (X : T) return T + is (T (Aux.Cos (W (X)))); - function Tan (X : Double) return Double; - pragma Import (Intrinsic, Tan, "tan"); - pragma Pure_Function (Tan); + function Tan (X : T) return T + is (T (Aux.Tan (W (X)))); - function Exp (X : Double) return Double; - pragma Import (Intrinsic, Exp, "exp"); - pragma Pure_Function (Exp); + function Exp (X : T) return T + is (T (Aux.Exp (W (X)))); - function Sqrt (X : Double) return Double; - pragma Import (Intrinsic, Sqrt, "sqrt"); - pragma Pure_Function (Sqrt); + function Sqrt (X : T) return T + is (T (Aux.Sqrt (W (X)))); - function Log (X : Double) return Double; - pragma Import (Intrinsic, Log, "log"); - pragma Pure_Function (Log); + function Log (X : T) return T + is (T (Aux.Log (W (X)))); - function Acos (X : Double) return Double; - pragma Import (Intrinsic, Acos, "acos"); - pragma Pure_Function (Acos); + function Acos (X : T) return T + is (T (Aux.Acos (W (X)))); - function Asin (X : Double) return Double; - pragma Import (Intrinsic, Asin, "asin"); - pragma Pure_Function (Asin); + function Asin (X : T) return T + is (T (Aux.Asin (W (X)))); - function Atan (X : Double) return Double; - pragma Import (Intrinsic, Atan, "atan"); - pragma Pure_Function (Atan); + function Atan (X : T) return T + is (T (Aux.Atan (W (X)))); - function Sinh (X : Double) return Double; - pragma Import (Intrinsic, Sinh, "sinh"); - pragma Pure_Function (Sinh); + function Sinh (X : T) return T + is (T (Aux.Sinh (W (X)))); - function Cosh (X : Double) return Double; - pragma Import (Intrinsic, Cosh, "cosh"); - pragma Pure_Function (Cosh); + function Cosh (X : T) return T + is (T (Aux.Cosh (W (X)))); - function Tanh (X : Double) return Double; - pragma Import (Intrinsic, Tanh, "tanh"); - pragma Pure_Function (Tanh); + function Tanh (X : T) return T + is (T (Aux.Tanh (W (X)))); - function Pow (X, Y : Double) return Double; - pragma Import (Intrinsic, Pow, "pow"); - pragma Pure_Function (Pow); + function Pow (X, Y : T) return T + is (T (Aux.Pow (W (X), W (Y)))); end Ada.Numerics.Aux; diff --git a/gcc/ada/libgnat/a-numaux__darwin.adb b/gcc/ada/libgnat/a-numaux__darwin.adb deleted file mode 100644 index 85fdd2468b5..00000000000 --- 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 -- --- . -- --- -- --- 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; -- 2.30.2