From cd4fb7180e416dc6d490c1cfc360800257cfc8a8 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 14 Jan 2021 13:16:16 +0100 Subject: [PATCH] [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. --- gcc/ada/Makefile.rtl | 3 + gcc/ada/exp_ch4.adb | 9 +-- gcc/ada/libgnat/s-exnflt.ads | 41 ++++++++++++ gcc/ada/libgnat/s-exnlfl.ads | 41 ++++++++++++ gcc/ada/libgnat/s-exnllf.adb | 154 ++----------------------------------------- gcc/ada/libgnat/s-exnllf.ads | 18 ++--- gcc/ada/libgnat/s-exponr.adb | 122 ++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/s-exponr.ads | 38 +++++++++++ gcc/ada/rtsfind.ads | 14 ++-- 9 files changed, 267 insertions(+), 173 deletions(-) create mode 100644 gcc/ada/libgnat/s-exnflt.ads create mode 100644 gcc/ada/libgnat/s-exnlfl.ads create mode 100644 gcc/ada/libgnat/s-exponr.adb create mode 100644 gcc/ada/libgnat/s-exponr.ads diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 32081c9..7f075c7 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -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) \ diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 5093bb1..c88f791 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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; diff --git a/gcc/ada/libgnat/s-exnflt.ads b/gcc/ada/libgnat/s-exnflt.ads new file mode 100644 index 0000000..13079fc --- /dev/null +++ b/gcc/ada/libgnat/s-exnflt.ads @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exnlfl.ads b/gcc/ada/libgnat/s-exnlfl.ads new file mode 100644 index 0000000..58d4a4c --- /dev/null +++ b/gcc/ada/libgnat/s-exnlfl.ads @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exnllf.adb b/gcc/ada/libgnat/s-exnllf.adb index 2a2159f..2186c6d 100644 --- a/gcc/ada/libgnat/s-exnllf.adb +++ b/gcc/ada/libgnat/s-exnllf.adb @@ -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; diff --git a/gcc/ada/libgnat/s-exnllf.ads b/gcc/ada/libgnat/s-exnllf.ads index e1fe45f..2b02a65 100644 --- a/gcc/ada/libgnat/s-exnllf.ads +++ b/gcc/ada/libgnat/s-exnllf.ads @@ -29,21 +29,13 @@ -- -- ------------------------------------------------------------------------------ --- [Long_[Long_]]Float exponentiation (checks off) +-- Long_Long_Float exponentiation (checks off) -package System.Exn_LLF is - pragma Pure; - - function Exn_Float - (Left : Float; - Right : Integer) return Float; +with System.Exponr; - function Exn_Long_Float - (Left : Long_Float; - Right : Integer) return Long_Float; +package System.Exn_LLF is - 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; diff --git a/gcc/ada/libgnat/s-exponr.adb b/gcc/ada/libgnat/s-exponr.adb new file mode 100644 index 0000000..ece53b5 --- /dev/null +++ b/gcc/ada/libgnat/s-exponr.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/libgnat/s-exponr.ads b/gcc/ada/libgnat/s-exponr.ads new file mode 100644 index 0000000..e5bdec7 --- /dev/null +++ b/gcc/ada/libgnat/s-exponr.ads @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 09d6b45..39e4fb2 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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, -- 2.7.4