[Ada] Implement tiered support for floating-point exponentiation
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 14 Jan 2021 12:16:16 +0000 (13:16 +0100)
committerPierre-Marie de Rodat <derodat@adacore.com>
Thu, 6 May 2021 07:51:23 +0000 (03:51 -0400)
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
gcc/ada/exp_ch4.adb
gcc/ada/libgnat/s-exnflt.ads [new file with mode: 0644]
gcc/ada/libgnat/s-exnlfl.ads [new file with mode: 0644]
gcc/ada/libgnat/s-exnllf.adb
gcc/ada/libgnat/s-exnllf.ads
gcc/ada/libgnat/s-exponr.adb [new file with mode: 0644]
gcc/ada/libgnat/s-exponr.ads [new file with mode: 0644]
gcc/ada/rtsfind.ads

index 32081c9..7f075c7 100644 (file)
@@ -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) \
index 5093bb1..c88f791 100644 (file)
@@ -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 (file)
index 0000000..13079fc
--- /dev/null
@@ -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;
diff --git a/gcc/ada/libgnat/s-exnlfl.ads b/gcc/ada/libgnat/s-exnlfl.ads
new file mode 100644 (file)
index 0000000..58d4a4c
--- /dev/null
@@ -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;
index 2a2159f..2186c6d 100644 (file)
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  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;
index e1fe45f..2b02a65 100644 (file)
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  [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 (file)
index 0000000..ece53b5
--- /dev/null
@@ -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;
diff --git a/gcc/ada/libgnat/s-exponr.ads b/gcc/ada/libgnat/s-exponr.ads
new file mode 100644 (file)
index 0000000..e5bdec7
--- /dev/null
@@ -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;
index 09d6b45..39e4fb2 100644 (file)
@@ -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,