mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-06 23:51:26 +08:00
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.
This commit is contained in:
Alexandre Oliva
Alexandre Oliva
parent
476036b35c
commit
1e70b1a358
@ -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
|
||||
|
||||
171
gcc/ada/libgnat/a-nagefl.ads
Normal file
171
gcc/ada/libgnat/a-nagefl.ads
Normal file
@ -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;
|
||||
45
gcc/ada/libgnat/a-naliop.ads
Normal file
45
gcc/ada/libgnat/a-naliop.ads
Normal file
@ -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;
|
||||
43
gcc/ada/libgnat/a-naliop__nolibm.ads
Normal file
43
gcc/ada/libgnat/a-naliop__nolibm.ads
Normal file
@ -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;
|
||||
@ -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;
|
||||
@ -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
|
||||
with Ada.Numerics.Aux_Linker_Options;
|
||||
pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options);
|
||||
|
||||
package Ada.Numerics.Aux_Long_Float is
|
||||
pragma Pure;
|
||||
|
||||
pragma Linker_Options ("-lm");
|
||||
|
||||
type Double is new Long_Float;
|
||||
-- Type Double is the type used to call the C routines
|
||||
|
||||
-- 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);
|
||||
|
||||
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 Exp (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Exp, "exp");
|
||||
pragma Pure_Function (Exp);
|
||||
function Cos (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "cos";
|
||||
|
||||
function Sqrt (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Sqrt, "sqrt");
|
||||
pragma Pure_Function (Sqrt);
|
||||
function Tan (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "tan";
|
||||
|
||||
function Log (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Log, "log");
|
||||
pragma Pure_Function (Log);
|
||||
function Exp (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "exp";
|
||||
|
||||
function Acos (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Acos, "acos");
|
||||
pragma Pure_Function (Acos);
|
||||
function Sqrt (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "sqrt";
|
||||
|
||||
function Asin (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Asin, "asin");
|
||||
pragma Pure_Function (Asin);
|
||||
function Log (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "log";
|
||||
|
||||
function Atan (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Atan, "atan");
|
||||
pragma Pure_Function (Atan);
|
||||
function Acos (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "acos";
|
||||
|
||||
function Sinh (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Sinh, "sinh");
|
||||
pragma Pure_Function (Sinh);
|
||||
function Asin (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "asin";
|
||||
|
||||
function Cosh (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Cosh, "cosh");
|
||||
pragma Pure_Function (Cosh);
|
||||
function Atan (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "atan";
|
||||
|
||||
function Tanh (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Tanh, "tanh");
|
||||
pragma Pure_Function (Tanh);
|
||||
function Sinh (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "sinh";
|
||||
|
||||
function Pow (X, Y : Double) return Double;
|
||||
pragma Import (Intrinsic, Pow, "pow");
|
||||
pragma Pure_Function (Pow);
|
||||
function Cosh (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "cosh";
|
||||
|
||||
end Ada.Numerics.Aux;
|
||||
function Tanh (X : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "tanh";
|
||||
|
||||
function Pow (X, Y : T) return T with
|
||||
Import, Convention => Intrinsic, External_Name => "pow";
|
||||
|
||||
end Ada.Numerics.Aux_Long_Float;
|
||||
87
gcc/ada/libgnat/a-nashfl.ads
Normal file
87
gcc/ada/libgnat/a-nashfl.ads
Normal file
@ -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;
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
40
gcc/ada/libgnat/a-nuauco.ads
Normal file
40
gcc/ada/libgnat/a-nuauco.ads
Normal file
@ -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;
|
||||
@ -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;
|
||||
@ -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
|
||||
with Ada.Numerics.Aux_Linker_Options;
|
||||
pragma Warnings (Off, Ada.Numerics.Aux_Linker_Options);
|
||||
|
||||
package Ada.Numerics.Aux_Float is
|
||||
pragma Pure;
|
||||
|
||||
pragma Linker_Options ("-lm");
|
||||
|
||||
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;
|
||||
@ -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 Long_Float;
|
||||
-- Type Double is the type used to call the C routines
|
||||
type Double is new 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.
|
||||
subtype T is Double;
|
||||
subtype W is Aux.T;
|
||||
|
||||
function Sin (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Sin, "sin");
|
||||
pragma Pure_Function (Sin);
|
||||
-- Use the Aux implementation.
|
||||
|
||||
function Cos (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Cos, "cos");
|
||||
pragma Pure_Function (Cos);
|
||||
function Sin (X : T) return T
|
||||
is (T (Aux.Sin (W (X))));
|
||||
|
||||
function Tan (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Tan, "tan");
|
||||
pragma Pure_Function (Tan);
|
||||
function Cos (X : T) return T
|
||||
is (T (Aux.Cos (W (X))));
|
||||
|
||||
function Exp (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Exp, "exp");
|
||||
pragma Pure_Function (Exp);
|
||||
function Tan (X : T) return T
|
||||
is (T (Aux.Tan (W (X))));
|
||||
|
||||
function Sqrt (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Sqrt, "sqrt");
|
||||
pragma Pure_Function (Sqrt);
|
||||
function Exp (X : T) return T
|
||||
is (T (Aux.Exp (W (X))));
|
||||
|
||||
function Log (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Log, "log");
|
||||
pragma Pure_Function (Log);
|
||||
function Sqrt (X : T) return T
|
||||
is (T (Aux.Sqrt (W (X))));
|
||||
|
||||
function Acos (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Acos, "acos");
|
||||
pragma Pure_Function (Acos);
|
||||
function Log (X : T) return T
|
||||
is (T (Aux.Log (W (X))));
|
||||
|
||||
function Asin (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Asin, "asin");
|
||||
pragma Pure_Function (Asin);
|
||||
function Acos (X : T) return T
|
||||
is (T (Aux.Acos (W (X))));
|
||||
|
||||
function Atan (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Atan, "atan");
|
||||
pragma Pure_Function (Atan);
|
||||
function Asin (X : T) return T
|
||||
is (T (Aux.Asin (W (X))));
|
||||
|
||||
function Sinh (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Sinh, "sinh");
|
||||
pragma Pure_Function (Sinh);
|
||||
function Atan (X : T) return T
|
||||
is (T (Aux.Atan (W (X))));
|
||||
|
||||
function Cosh (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Cosh, "cosh");
|
||||
pragma Pure_Function (Cosh);
|
||||
function Sinh (X : T) return T
|
||||
is (T (Aux.Sinh (W (X))));
|
||||
|
||||
function Tanh (X : Double) return Double;
|
||||
pragma Import (Intrinsic, Tanh, "tanh");
|
||||
pragma Pure_Function (Tanh);
|
||||
function Cosh (X : T) return T
|
||||
is (T (Aux.Cosh (W (X))));
|
||||
|
||||
function Pow (X, Y : Double) return Double;
|
||||
pragma Import (Intrinsic, Pow, "pow");
|
||||
pragma Pure_Function (Pow);
|
||||
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;
|
||||
|
||||
@ -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;
|
||||
Loading…
x
Reference in New Issue
Block a user