[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.

1 files changed, 122 insertions, 0 deletions

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    --
+-- <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;