diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/Makefile.rtl | 27 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nagefl.ads | 171 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-naliop.ads | 45 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-naliop__nolibm.ads | 43 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nallfl.ads (renamed from gcc/ada/libgnat/a-numaux__vxworks.ads) | 84 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nalofl.ads (renamed from gcc/ada/libgnat/a-numaux__darwin.ads) | 94 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nashfl.ads | 87 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-ngcefu.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-ngcoty.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-ngelfu.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nuauco.ads | 40 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nuauco__x86.ads (renamed from gcc/ada/libgnat/a-numaux__dummy.adb) | 17 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-nuaufl.ads (renamed from gcc/ada/libgnat/a-numaux__libc-x86.ads) | 84 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-numaux.ads | 94 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-numaux__darwin.adb | 211 |
15 files changed, 598 insertions, 477 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index cd38184..2bc95db 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<libgnat/a-numaux__libc-x86.ads \ - a-numaux.adb<libgnat/a-numaux__dummy.adb \ + a-nuauco.ads<libgnat/a-nuauco__x86.ads \ s-atocou.adb<libgnat/s-atocou__x86.adb X86_64_TARGET_PAIRS = \ - a-numaux.ads<libgnat/a-numaux__libc-x86.ads \ - a-numaux.adb<libgnat/a-numaux__dummy.adb \ + a-nuauco.ads<libgnat/a-nuauco__x86.ads \ s-atocou.adb<libgnat/s-atocou__builtin.adb # Implementation of symbolic traceback based on dwarf @@ -916,7 +921,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworksspe vxworks7% vxworks7spe LIBGNAT_TARGET_PAIRS = \ a-intnam.ads<libgnarl/a-intnam__vxworks.ads \ - a-numaux.ads<libgnat/a-numaux__vxworks.ads \ + a-naliop.ads<libgnat/a-naliop__nolibm.ads \ s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \ s-intman.ads<libgnarl/s-intman__vxworks.ads \ s-intman.adb<libgnarl/s-intman__vxworks.adb \ @@ -1039,7 +1044,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae vxworksaespe,$(target_cpu) $(t LIBGNAT_TARGET_PAIRS = \ a-elchha.adb<libgnat/a-elchha__vxworks-ppc-full.adb \ a-intnam.ads<libgnarl/a-intnam__vxworks.ads \ - a-numaux.ads<libgnat/a-numaux__vxworks.ads \ + a-naliop.ads<libgnat/a-naliop__nolibm.ads \ g-io.adb<hie/g-io__vxworks-cert.adb \ s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \ s-interr.adb<libgnarl/s-interr__vxworks.adb \ @@ -1095,7 +1100,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae,$(target_cpu) $(target_vendor) $(ta LIBGNAT_TARGET_PAIRS = \ a-elchha.adb<libgnat/a-elchha__vxworks-ppc-full.adb \ a-intnam.ads<libgnarl/a-intnam__vxworks.ads \ - a-numaux.ads<libgnat/a-numaux__vxworks.ads \ + a-naliop.ads<libgnat/a-naliop__nolibm.ads \ g-io.adb<hie/g-io__vxworks-cert.adb \ s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \ s-interr.adb<libgnarl/s-interr__vxworks.adb \ @@ -1314,7 +1319,7 @@ ifeq ($(strip $(filter-out aarch64 arm% coff wrs vx%,$(target_cpu) $(target_vend LIBGNAT_TARGET_PAIRS = \ a-intnam.ads<libgnarl/a-intnam__vxworks.ads \ - a-numaux.ads<libgnat/a-numaux__vxworks.ads \ + a-naliop.ads<libgnat/a-naliop__nolibm.ads \ s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \ s-interr.adb<libgnarl/s-interr__vxworks.adb \ s-intman.ads<libgnarl/s-intman__vxworks.ads \ @@ -1648,8 +1653,6 @@ endif ifeq ($(strip $(filter-out x86_64 kfreebsd%,$(target_cpu) $(target_os))),) LIBGNAT_TARGET_PAIRS = \ a-intnam.ads<libgnarl/a-intnam__freebsd.ads \ - a-numaux.ads<libgnat/a-numaux__libc-x86.ads \ - a-numaux.adb<libgnat/a-numaux__dummy.adb \ s-inmaop.adb<libgnarl/s-inmaop__posix.adb \ s-intman.adb<libgnarl/s-intman__posix.adb \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ @@ -2302,7 +2305,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(target_cpu) $(target_os))),) a-exetim.adb<libgnarl/a-exetim__posix.adb \ a-exetim.ads<libgnarl/a-exetim__default.ads \ a-intnam.ads<libgnarl/a-intnam__linux.ads \ - a-numaux.ads<libgnat/a-numaux__libc-x86.ads \ + a-nuauco.ads<libgnat/a-nuauco__x86.ads \ a-synbar.adb<libgnarl/a-synbar__posix.adb \ a-synbar.ads<libgnarl/a-synbar__posix.ads \ s-inmaop.adb<libgnarl/s-inmaop__posix.adb \ @@ -2550,8 +2553,6 @@ ifeq ($(strip $(filter-out darwin%,$(target_os))),) LIBGNAT_TARGET_PAIRS += \ s-intman.adb<libgnarl/s-intman__posix.adb \ s-osprim.adb<libgnat/s-osprim__posix.adb \ - a-numaux.ads<libgnat/a-numaux__darwin.ads \ - a-numaux.adb<libgnat/a-numaux__darwin.adb \ $(ATOMICS_TARGET_PAIRS) \ $(ATOMICS_BUILTINS_TARGET_PAIRS) \ system.ads<libgnat/system-darwin-ppc.ads diff --git a/gcc/ada/libgnat/a-nagefl.ads b/gcc/ada/libgnat/a-nagefl.ads new file mode 100644 index 0000000..9260391 --- /dev/null +++ b/gcc/ada/libgnat/a-nagefl.ads @@ -0,0 +1,171 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X _ G E N E R I C _ F L O A T -- +-- -- +-- S p e c -- +-- (Generic Wrapper) -- +-- -- +-- 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 -- +-- <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. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 0000000..81de811 --- /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 -- +-- <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. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 0000000..dc1969a --- /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 -- +-- <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. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 index 410655d..ca998fa 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 index add87a4..4cdf2f4 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 0000000..eaee862 --- /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 -- +-- <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. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 46af6f8..d47a14f 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 6785ccf..b369dfc 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 7e7c662..3f7c3d1 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 0000000..7fd49a8 --- /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 -- +-- <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. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 index f5d72ec..f1fbb31 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 index f6deebe..16a34ae 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 4154e1a..42ed336 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 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; |