[Ada] Implement tiered support for floating-point exponentiation
gcc/ada/ * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add s-exponr, s-exnflt and s-exnlfl. * exp_ch4.adb (Expand_N_Op_Expon): Use RE_Exn_Float for Short_Float. * rtsfind.ads (RTU_Id): Add System_Exn_Flt and System_Exn_LFlt. (RE_Id): Adjust entries for RE_Exn_Float and RE_Exn_Long_Float. (RE_Unit_Table): Likewise. * libgnat/s-exnflt.ads: New file. * libgnat/s-exnlfl.ads: Likewise. * libgnat/s-exnllf.ads: Change to mere instantiation. * libgnat/s-exnllf.adb: Move implementation to... * libgnat/s-exponr.ads: New generic unit. * libgnat/s-exponr.adb: ...here and also make it generic. (Expon): Do the computation in double precision internally.
This commit is contained in:
Eric Botcazou
Pierre-Marie de Rodat
parent
bed6d583e3
commit
cd4fb7180e
9 changed files with 267 additions and 173 deletions
|
|
@ -583,6 +583,8 @@ GNATRTL_NONTASKING_OBJS= \
|
|||
s-exctab$(objext) \
|
||||
s-exctra$(objext) \
|
||||
s-exnint$(objext) \
|
||||
s-exnflt$(objext) \
|
||||
s-exnlfl$(objext) \
|
||||
s-exnllf$(objext) \
|
||||
s-exnlli$(objext) \
|
||||
s-expint$(objext) \
|
||||
|
|
@ -590,6 +592,7 @@ GNATRTL_NONTASKING_OBJS= \
|
|||
s-expllu$(objext) \
|
||||
s-expmod$(objext) \
|
||||
s-exponn$(objext) \
|
||||
s-exponr$(objext) \
|
||||
s-expont$(objext) \
|
||||
s-exponu$(objext) \
|
||||
s-expuns$(objext) \
|
||||
|
|
|
|||
|
|
@ -9081,15 +9081,12 @@ package body Exp_Ch4 is
|
|||
-- overflow), and if there is an infinity generated and a range check
|
||||
-- is required, the check will fail anyway.
|
||||
|
||||
-- Historical note: we used to convert everything to Long_Long_Float
|
||||
-- and call a single common routine, but this had the undesirable effect
|
||||
-- of giving different results for small static exponent values and the
|
||||
-- same dynamic values.
|
||||
|
||||
else
|
||||
pragma Assert (Is_Floating_Point_Type (Rtyp));
|
||||
|
||||
if Rtyp = Standard_Float then
|
||||
-- Short_Float and Float are the same type for GNAT
|
||||
|
||||
if Rtyp = Standard_Short_Float or else Rtyp = Standard_Float then
|
||||
Etyp := Standard_Float;
|
||||
Rent := RE_Exn_Float;
|
||||
|
||||
|
|
|
|||
41
gcc/ada/libgnat/s-exnflt.ads
Normal file
41
gcc/ada/libgnat/s-exnflt.ads
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E X N _ F L T --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2021, 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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Float exponentiation (checks off)
|
||||
|
||||
with System.Exponr;
|
||||
|
||||
package System.Exn_Flt is
|
||||
|
||||
function Exn_Float is new Exponr (Float);
|
||||
pragma Pure_Function (Exn_Float);
|
||||
|
||||
end System.Exn_Flt;
|
||||
41
gcc/ada/libgnat/s-exnlfl.ads
Normal file
41
gcc/ada/libgnat/s-exnlfl.ads
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E X N _ L F L T --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2021, 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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Long_Float exponentiation (checks off)
|
||||
|
||||
with System.Exponr;
|
||||
|
||||
package System.Exn_LFlt is
|
||||
|
||||
function Exn_Long_Float is new Exponr (Long_Float);
|
||||
pragma Pure_Function (Exn_Long_Float);
|
||||
|
||||
end System.Exn_LFlt;
|
||||
|
|
@ -29,154 +29,8 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Note: the reason for treating exponents in the range 0 .. 4 specially is
|
||||
-- to ensure identical results to the static inline expansion in the case of
|
||||
-- a compile time known exponent in this range. The use of Float'Machine and
|
||||
-- Long_Float'Machine is to avoid unwanted extra precision in the results.
|
||||
-- This package does not require a body, since it is an instantiation. We
|
||||
-- provide a dummy file containing a No_Body pragma so that previous versions
|
||||
-- of the body (which did exist) will not interfere.
|
||||
|
||||
-- Note that for a negative exponent in Left ** Right, we compute the result
|
||||
-- as:
|
||||
|
||||
-- 1.0 / (Left ** (-Right))
|
||||
|
||||
-- Note that the case of Left being zero is not special, it will simply result
|
||||
-- in a division by zero at the end, yielding a correctly signed infinity, or
|
||||
-- possibly generating an overflow.
|
||||
|
||||
-- Note on overflow: This coding assumes that the target generates infinities
|
||||
-- with standard IEEE semantics. If this is not the case, then the code
|
||||
-- for negative exponent may raise Constraint_Error. This follows the
|
||||
-- implementation permission given in RM 4.5.6(12).
|
||||
|
||||
package body System.Exn_LLF is
|
||||
|
||||
subtype Negative is Integer range Integer'First .. -1;
|
||||
|
||||
function Exp
|
||||
(Left : Long_Long_Float;
|
||||
Right : Natural) return Long_Long_Float;
|
||||
-- Common routine used if Right is greater or equal to 5
|
||||
|
||||
---------------
|
||||
-- Exn_Float --
|
||||
---------------
|
||||
|
||||
function Exn_Float
|
||||
(Left : Float;
|
||||
Right : Integer) return Float
|
||||
is
|
||||
Temp : Float;
|
||||
begin
|
||||
case Right is
|
||||
when 0 =>
|
||||
return 1.0;
|
||||
when 1 =>
|
||||
return Left;
|
||||
when 2 =>
|
||||
return Float'Machine (Left * Left);
|
||||
when 3 =>
|
||||
return Float'Machine (Left * Left * Left);
|
||||
when 4 =>
|
||||
Temp := Float'Machine (Left * Left);
|
||||
return Float'Machine (Temp * Temp);
|
||||
when Negative =>
|
||||
return Float'Machine (1.0 / Exn_Float (Left, -Right));
|
||||
when others =>
|
||||
return
|
||||
Float'Machine
|
||||
(Float (Exp (Long_Long_Float (Left), Right)));
|
||||
end case;
|
||||
end Exn_Float;
|
||||
|
||||
--------------------
|
||||
-- Exn_Long_Float --
|
||||
--------------------
|
||||
|
||||
function Exn_Long_Float
|
||||
(Left : Long_Float;
|
||||
Right : Integer) return Long_Float
|
||||
is
|
||||
Temp : Long_Float;
|
||||
begin
|
||||
case Right is
|
||||
when 0 =>
|
||||
return 1.0;
|
||||
when 1 =>
|
||||
return Left;
|
||||
when 2 =>
|
||||
return Long_Float'Machine (Left * Left);
|
||||
when 3 =>
|
||||
return Long_Float'Machine (Left * Left * Left);
|
||||
when 4 =>
|
||||
Temp := Long_Float'Machine (Left * Left);
|
||||
return Long_Float'Machine (Temp * Temp);
|
||||
when Negative =>
|
||||
return Long_Float'Machine (1.0 / Exn_Long_Float (Left, -Right));
|
||||
when others =>
|
||||
return
|
||||
Long_Float'Machine
|
||||
(Long_Float (Exp (Long_Long_Float (Left), Right)));
|
||||
end case;
|
||||
end Exn_Long_Float;
|
||||
|
||||
-------------------------
|
||||
-- Exn_Long_Long_Float --
|
||||
-------------------------
|
||||
|
||||
function Exn_Long_Long_Float
|
||||
(Left : Long_Long_Float;
|
||||
Right : Integer) return Long_Long_Float
|
||||
is
|
||||
Temp : Long_Long_Float;
|
||||
begin
|
||||
case Right is
|
||||
when 0 =>
|
||||
return 1.0;
|
||||
when 1 =>
|
||||
return Left;
|
||||
when 2 =>
|
||||
return Left * Left;
|
||||
when 3 =>
|
||||
return Left * Left * Left;
|
||||
when 4 =>
|
||||
Temp := Left * Left;
|
||||
return Temp * Temp;
|
||||
when Negative =>
|
||||
return 1.0 / Exn_Long_Long_Float (Left, -Right);
|
||||
when others =>
|
||||
return Exp (Left, Right);
|
||||
end case;
|
||||
end Exn_Long_Long_Float;
|
||||
|
||||
---------
|
||||
-- Exp --
|
||||
---------
|
||||
|
||||
function Exp
|
||||
(Left : Long_Long_Float;
|
||||
Right : Natural) return Long_Long_Float
|
||||
is
|
||||
Result : Long_Long_Float := 1.0;
|
||||
Factor : Long_Long_Float := Left;
|
||||
Exp : Natural := Right;
|
||||
|
||||
begin
|
||||
-- We use the standard logarithmic approach, Exp gets shifted right
|
||||
-- testing successive low order bits and Factor is the value of the
|
||||
-- base raised to the next power of 2. If the low order bit or Exp is
|
||||
-- set, multiply the result by this factor.
|
||||
|
||||
loop
|
||||
if Exp rem 2 /= 0 then
|
||||
Result := Result * Factor;
|
||||
end if;
|
||||
|
||||
Exp := Exp / 2;
|
||||
exit when Exp = 0;
|
||||
Factor := Factor * Factor;
|
||||
end loop;
|
||||
|
||||
return Result;
|
||||
end Exp;
|
||||
|
||||
end System.Exn_LLF;
|
||||
pragma No_Body;
|
||||
|
|
|
|||
|
|
@ -29,21 +29,13 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- [Long_[Long_]]Float exponentiation (checks off)
|
||||
-- Long_Long_Float exponentiation (checks off)
|
||||
|
||||
with System.Exponr;
|
||||
|
||||
package System.Exn_LLF is
|
||||
pragma Pure;
|
||||
|
||||
function Exn_Float
|
||||
(Left : Float;
|
||||
Right : Integer) return Float;
|
||||
|
||||
function Exn_Long_Float
|
||||
(Left : Long_Float;
|
||||
Right : Integer) return Long_Float;
|
||||
|
||||
function Exn_Long_Long_Float
|
||||
(Left : Long_Long_Float;
|
||||
Right : Integer) return Long_Long_Float;
|
||||
function Exn_Long_Long_Float is new Exponr (Long_Long_Float);
|
||||
pragma Pure_Function (Exn_Long_Long_Float);
|
||||
|
||||
end System.Exn_LLF;
|
||||
|
|
|
|||
122
gcc/ada/libgnat/s-exponr.adb
Normal file
122
gcc/ada/libgnat/s-exponr.adb
Normal file
|
|
@ -0,0 +1,122 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E X P O N R --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2021, 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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Note that the reason for treating exponents in the range 0 .. 4 specially
|
||||
-- is to ensure identical results with the static expansion in the case of a
|
||||
-- compile-time known exponent in this range; similarly, the use 'Machine is
|
||||
-- to avoid unwanted extra precision in the results.
|
||||
|
||||
-- For a negative exponent, we compute the result as per RM 4.5.6(11/3):
|
||||
|
||||
-- Left ** Right = 1.0 / (Left ** (-Right))
|
||||
|
||||
-- Note that the case of Left being zero is not special, it will simply result
|
||||
-- in a division by zero at the end, yielding a correctly signed infinity, or
|
||||
-- possibly raising an overflow exception.
|
||||
|
||||
-- Note on overflow: this coding assumes that the target generates infinities
|
||||
-- with standard IEEE semantics. If this is not the case, then the code for
|
||||
-- negative exponents may raise Constraint_Error, which is in keeping with the
|
||||
-- implementation permission given in RM 4.5.6(12).
|
||||
|
||||
with System.Double_Real;
|
||||
|
||||
function System.Exponr (Left : Num; Right : Integer) return Num is
|
||||
|
||||
package Double_Real is new System.Double_Real (Num);
|
||||
use type Double_Real.Double_T;
|
||||
|
||||
subtype Double_T is Double_Real.Double_T;
|
||||
-- The double floating-point type
|
||||
|
||||
subtype Negative is Integer range Integer'First .. -1;
|
||||
-- The range of negative exponents
|
||||
|
||||
function Expon (Left : Num; Right : Natural) return Num;
|
||||
-- Routine used if Right is greater than 4
|
||||
|
||||
-----------
|
||||
-- Expon --
|
||||
-----------
|
||||
|
||||
function Expon (Left : Num; Right : Natural) return Num is
|
||||
Result : Double_T := Double_Real.To_Double (1.0);
|
||||
Factor : Double_T := Double_Real.To_Double (Left);
|
||||
Exp : Natural := Right;
|
||||
|
||||
begin
|
||||
-- We use the standard logarithmic approach, Exp gets shifted right
|
||||
-- testing successive low order bits and Factor is the value of the
|
||||
-- base raised to the next power of 2. If the low order bit or Exp
|
||||
-- is set, multiply the result by this factor.
|
||||
|
||||
loop
|
||||
if Exp rem 2 /= 0 then
|
||||
Result := Result * Factor;
|
||||
exit when Exp = 1;
|
||||
end if;
|
||||
|
||||
Exp := Exp / 2;
|
||||
Factor := Double_Real.Sqr (Factor);
|
||||
end loop;
|
||||
|
||||
return Double_Real.To_Single (Result);
|
||||
end Expon;
|
||||
|
||||
begin
|
||||
case Right is
|
||||
when 0 =>
|
||||
return 1.0;
|
||||
|
||||
when 1 =>
|
||||
return Left;
|
||||
|
||||
when 2 =>
|
||||
return Num'Machine (Left * Left);
|
||||
|
||||
when 3 =>
|
||||
return Num'Machine (Left * Left * Left);
|
||||
|
||||
when 4 =>
|
||||
declare
|
||||
Sqr : constant Num := Num'Machine (Left * Left);
|
||||
|
||||
begin
|
||||
return Num'Machine (Sqr * Sqr);
|
||||
end;
|
||||
|
||||
when Negative =>
|
||||
return Num'Machine (1.0 / Exponr (Left, -Right));
|
||||
|
||||
when others =>
|
||||
return Num'Machine (Expon (Left, Right));
|
||||
end case;
|
||||
end System.Exponr;
|
||||
38
gcc/ada/libgnat/s-exponr.ads
Normal file
38
gcc/ada/libgnat/s-exponr.ads
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E X P O N R --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2021, 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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Real exponentiation (checks off)
|
||||
|
||||
generic
|
||||
|
||||
type Num is digits <>;
|
||||
|
||||
function System.Exponr (Left : Num; Right : Integer) return Num;
|
||||
|
|
@ -228,6 +228,8 @@ package Rtsfind is
|
|||
System_Exception_Table,
|
||||
System_Exceptions_Debug,
|
||||
System_Exn_Int,
|
||||
System_Exn_Flt,
|
||||
System_Exn_LFlt,
|
||||
System_Exn_LLF,
|
||||
System_Exn_LLI,
|
||||
System_Exn_LLLI,
|
||||
|
|
@ -906,8 +908,10 @@ package Rtsfind is
|
|||
|
||||
RE_Exn_Integer, -- System.Exn_Int
|
||||
|
||||
RE_Exn_Float, -- System.Exn_LLF
|
||||
RE_Exn_Long_Float, -- System.Exn_LLF
|
||||
RE_Exn_Float, -- System.Exn_Flt
|
||||
|
||||
RE_Exn_Long_Float, -- System.Exn_LFlt
|
||||
|
||||
RE_Exn_Long_Long_Float, -- System.Exn_LLF
|
||||
|
||||
RE_Exn_Long_Long_Integer, -- System.Exn_LLI
|
||||
|
|
@ -2592,8 +2596,10 @@ package Rtsfind is
|
|||
|
||||
RE_Exn_Integer => System_Exn_Int,
|
||||
|
||||
RE_Exn_Float => System_Exn_LLF,
|
||||
RE_Exn_Long_Float => System_Exn_LLF,
|
||||
RE_Exn_Float => System_Exn_Flt,
|
||||
|
||||
RE_Exn_Long_Float => System_Exn_LFlt,
|
||||
|
||||
RE_Exn_Long_Long_Float => System_Exn_LLF,
|
||||
|
||||
RE_Exn_Long_Long_Integer => System_Exn_LLI,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue