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) \
# 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
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 \
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 \
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 \
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 \
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 \
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 \
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
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- --
-- 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. --
-- --
-- --
------------------------------------------------------------------------------
--- 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;
-- --
-- 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. --
-- --
-- --
------------------------------------------------------------------------------
--- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
---------
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
-- --
------------------------------------------------------------------------------
-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;
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
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;
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;
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
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
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;
-- 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;
-- 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;
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;
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;
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;
return Pi;
end if;
- Temp := Float_Type'Base (Aux.Acos (Double (X)));
+ Temp := Aux.Acos (X);
if Temp < 0.0 then
Temp := Pi + Temp;
return -(Pi / 2.0);
end if;
- return Float_Type'Base (Aux.Asin (Double (X)));
+ return Aux.Asin (X);
end Arcsin;
-- Arbitrary cycle
return 1.0;
end if;
- return Float_Type'Base (Aux.Cos (Double (X)));
+ return Aux.Cos (X);
end Cos;
-- Arbitrary cycle
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
return 1.0 / X;
end if;
- return 1.0 / Float_Type'Base (Aux.Tanh (Double (X)));
+ return 1.0 / Aux.Tanh (X);
end Coth;
---------
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
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;
return 0.0;
end if;
- return Float_Type'Base (Aux.Log (Double (X)));
+ return Aux.Log (X);
end Log;
-- Arbitrary base
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;
---------
return X;
end if;
- return Float_Type'Base (Aux.Sin (Double (X)));
+ return Aux.Sin (X);
end Sin;
-- Arbitrary cycle
-- 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;
----------
return X;
end if;
- return Float_Type'Base (Aux.Sqrt (Double (X)));
+ return Aux.Sqrt (X);
end Sqrt;
---------
-- 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
return X + X * R;
else
- return Float_Type'Base (Aux.Tanh (Double (X)));
+ return Aux.Tanh (X);
end if;
end Tanh;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
------------------------------------------------------------------------------
-- --
--- 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- --
-- --
------------------------------------------------------------------------------
-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;
-- --
-- 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. --
-- --
-- --
------------------------------------------------------------------------------
--- 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;
-- 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. --
-- --
-- --
------------------------------------------------------------------------------
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
projects / thirdparty / gcc.git / commitdiff
