path: root/gcc/ada/libgnat/s-valrea.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                      S Y S T E M . V A L _ R E A L                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2023, 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.      --
--                                                                          --
------------------------------------------------------------------------------

with System.Double_Real;
with System.Float_Control;
with System.Unsigned_Types; use System.Unsigned_Types;
with System.Val_Util;       use System.Val_Util;
with System.Value_R;

pragma Warnings (Off, "non-static constant in preelaborated unit");
--  Every constant is static given our instantiation model

package body System.Val_Real is

   pragma Assert (Num'Machine_Mantissa <= Uns'Size);
   --  We need an unsigned type large enough to represent the mantissa

   Is_Large_Type : constant Boolean := Num'Machine_Mantissa >= 53;
   --  True if the floating-point type is at least IEEE Double

   Precision_Limit : constant Uns := 2**Num'Machine_Mantissa - 1;
   --  See below for the rationale

   package Impl is new Value_R (Uns, 2, Precision_Limit, Round => False);

   subtype Base_T is Unsigned range 2 .. 16;

   --  The following tables compute the maximum exponent of the base that can
   --  fit in the given floating-point format, that is to say the element at
   --  index N is the largest K such that N**K <= Num'Last.

   Maxexp32 : constant array (Base_T) of Positive :=
     [2  => 127, 3 => 80,  4 => 63,  5 => 55,  6 => 49,
      7  => 45,  8 => 42,  9 => 40, 10 => 55, 11 => 37,
      12 => 35, 13 => 34, 14 => 33, 15 => 32, 16 => 31];
   --  The actual value for 10 is 38 but we also use scaling for 10

   Maxexp64 : constant array (Base_T) of Positive :=
     [2  => 1023, 3 => 646,  4 => 511,  5 => 441,  6 => 396,
      7  => 364,  8 => 341,  9 => 323, 10 => 441, 11 => 296,
      12 => 285, 13 => 276, 14 => 268, 15 => 262, 16 => 255];
   --  The actual value for 10 is 308 but we also use scaling for 10

   Maxexp80 : constant array (Base_T) of Positive :=
     [2  => 16383, 3 => 10337, 4 => 8191,  5 => 7056,  6 => 6338,
      7  => 5836,  8 => 5461,  9 => 5168, 10 => 7056, 11 => 4736,
      12 => 4570, 13 => 4427, 14 => 4303, 15 => 4193, 16 => 4095];
   --  The actual value for 10 is 4932 but we also use scaling for 10

   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

   function Exact_Log2 (N : Unsigned) return Positive is
     (case N is
        when  2     => 1,
        when  4     => 2,
        when  8     => 3,
        when 16     => 4,
        when others => raise Program_Error);
   --  Return the exponent of a power of 2

   function Integer_to_Real
     (Str   : String;
      Val   : Impl.Value_Array;
      Base  : Unsigned;
      Scale : Impl.Scale_Array;
      Minus : Boolean) return Num;
   --  Convert the real value from integer to real representation

   function Large_Powfive (Exp : Natural) return Double_T;
   --  Return 5.0**Exp as a double number, where Exp > Maxpow

   function Large_Powfive (Exp : Natural; S : out Natural) return Double_T;
   --  Return Num'Scaling (5.0**Exp, -S) as a double number where Exp > Maxexp

   ---------------------
   -- Integer_to_Real --
   ---------------------

   function Integer_to_Real
     (Str   : String;
      Val   : Impl.Value_Array;
      Base  : Unsigned;
      Scale : Impl.Scale_Array;
      Minus : Boolean) return Num
   is
      pragma Assert (Base in 2 .. 16);

      pragma Assert (Num'Machine_Radix = 2);

      pragma Unsuppress (Range_Check);

      Maxexp : constant Positive :=
                 (if    Num'Size = 32             then Maxexp32 (Base)
                  elsif Num'Size = 64             then Maxexp64 (Base)
                  elsif Num'Machine_Mantissa = 64 then Maxexp80 (Base)
                  else  raise Program_Error);
      --  Maximum exponent of the base that can fit in Num

      D_Val : Double_T;
      R_Val : Num;
      S     : Integer;

   begin
      --  We call the floating-point processor reset routine so we can be sure
      --  that the x87 FPU is properly set for conversions. This is especially
      --  needed on Windows, where calls to the operating system randomly reset
      --  the processor into 64-bit mode.

      if Num'Machine_Mantissa = 64 then
         System.Float_Control.Reset;
      end if;

      --  First convert the integer mantissa into a double real. The conversion
      --  of each part is exact, given the precision limit we used above. Then,
      --  if the contribution of the low part might be nonnull, scale the high
      --  part appropriately and add the low part to the result.

      if Val (2) = 0 then
         D_Val := Double_Real.To_Double (Num (Val (1)));
         S := Scale (1);

      else
         declare
            V1 : constant Num := Num (Val (1));
            V2 : constant Num := Num (Val (2));

            DS : Positive;

         begin
            DS := Scale (1) - Scale (2);

            case Base is
               --  If the base is a power of two, we use the efficient Scaling
               --  attribute up to an amount worth a double mantissa.

               when 2 | 4 | 8 | 16 =>
                  declare
                     L : constant Positive := Exact_Log2 (Base);

                  begin
                     if DS <= 2 * Num'Machine_Mantissa / L then
                        DS := DS * L;
                        D_Val :=
                          Double_Real.Quick_Two_Sum (Num'Scaling (V1, DS), V2);
                        S := Scale (2);

                     else
                        D_Val := Double_Real.To_Double (V1);
                        S := Scale (1);
                     end if;
                  end;

               --  If the base is 10, we also scale up to an amount worth a
               --  double mantissa.

               when 10 =>
                  declare
                     Powfive : constant array (0 .. Maxpow) of Double_T;
                     pragma Import (Ada, Powfive);
                     for Powfive'Address use Powfive_Address;

                  begin
                     if DS <= Maxpow then
                        D_Val := Powfive (DS) * Num'Scaling (V1, DS) + V2;
                        S := Scale (2);

                     else
                        D_Val := Double_Real.To_Double (V1);
                        S := Scale (1);
                     end if;
                  end;

               --  Inaccurate implementation for other bases

               when others =>
                  D_Val := Double_Real.To_Double (V1);
                  S := Scale (1);
            end case;
         end;
      end if;

      --  Compute the final value by applying the scaling, if any

      if (Val (1) = 0 and then Val (2) = 0) or else S = 0 then
         R_Val := Double_Real.To_Single (D_Val);

      else
         case Base is
            --  If the base is a power of two, we use the efficient Scaling
            --  attribute with an overflow check, if it is not 2, to catch
            --  ludicrous exponents that would result in an infinity or zero.

            when 2 | 4 | 8 | 16 =>
               declare
                  L : constant Positive := Exact_Log2 (Base);

               begin
                  if Integer'First / L <= S and then S <= Integer'Last / L then
                     S := S * L;
                  end if;

                  R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
               end;

            --  If the base is 10, we use a double implementation for the sake
            --  of accuracy combining powers of 5 and scaling attribute. Using
            --  this combination is better than using powers of 10 only because
            --  the Large_Powfive function may overflow only if the final value
            --  will also either overflow or underflow, thus making it possible
            --  to use a single division for the case of negative powers of 10.

            when 10 =>
               declare
                  Powfive : constant array (0 .. Maxpow) of Double_T;
                  pragma Import (Ada, Powfive);
                  for Powfive'Address use Powfive_Address;

                  RS : Natural;

               begin
                  if S > 0 then
                     if S <= Maxpow then
                        D_Val := D_Val * Powfive (S);
                     else
                        D_Val := D_Val * Large_Powfive (S);
                     end if;

                  else
                     if S >= -Maxpow then
                        D_Val := D_Val / Powfive (-S);

                     --  For small types, typically IEEE Single, the trick
                     --  described above does not fully work.

                     elsif not Is_Large_Type and then S < -Maxexp then
                        D_Val := D_Val / Large_Powfive (-S, RS);
                        S := S - RS;

                     else
                        D_Val := D_Val / Large_Powfive (-S);
                     end if;
                  end if;

                  R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
               end;

            --  Implementation for other bases with exponentiation

            --  When the exponent is positive, we can do the computation
            --  directly because, if the exponentiation overflows, then
            --  the final value overflows as well. But when the exponent
            --  is negative, we may need to do it in two steps to avoid
            --  an artificial underflow.

            when others =>
               declare
                  B : constant Num := Num (Base);

               begin
                  R_Val := Double_Real.To_Single (D_Val);

                  if S > 0 then
                     R_Val := R_Val * B ** S;

                  else
                     if S < -Maxexp then
                        R_Val := R_Val / B ** Maxexp;
                        S := S + Maxexp;
                     end if;

                     R_Val := R_Val / B ** (-S);
                  end if;
               end;
         end case;
      end if;

      --  Finally deal with initial minus sign, note that this processing is
      --  done even if Uval is zero, so that -0.0 is correctly interpreted.

      return (if Minus then -R_Val else R_Val);

   exception
      when Constraint_Error => Bad_Value (Str);
   end Integer_to_Real;

   -------------------
   -- Large_Powfive --
   -------------------

   function Large_Powfive (Exp : Natural) return Double_T is
      Powfive : constant array (0 .. Maxpow) of Double_T;
      pragma Import (Ada, Powfive);
      for Powfive'Address use Powfive_Address;

      Powfive_100 : constant Double_T;
      pragma Import (Ada, Powfive_100);
      for Powfive_100'Address use Powfive_100_Address;

      Powfive_200 : constant Double_T;
      pragma Import (Ada, Powfive_200);
      for Powfive_200'Address use Powfive_200_Address;

      Powfive_300 : constant Double_T;
      pragma Import (Ada, Powfive_300);
      for Powfive_300'Address use Powfive_300_Address;

      R : Double_T;
      E : Natural;

   begin
      pragma Assert (Exp > Maxpow);

      if Is_Large_Type and then Exp >= 300 then
         R := Powfive_300;
         E := Exp - 300;

      elsif Is_Large_Type and then Exp >= 200 then
         R := Powfive_200;
         E := Exp - 200;

      elsif Is_Large_Type and then Exp >= 100 then
         R := Powfive_100;
         E := Exp - 100;

      else
         R := Powfive (Maxpow);
         E := Exp - Maxpow;
      end if;

      while E > Maxpow loop
         R := R * Powfive (Maxpow);
         E := E - Maxpow;
      end loop;

      R := R * Powfive (E);

      return R;
   end Large_Powfive;

   function Large_Powfive (Exp : Natural; S : out Natural) return Double_T is
      Maxexp : constant Positive :=
        (if    Num'Size = 32             then Maxexp32 (5)
         elsif Num'Size = 64             then Maxexp64 (5)
         elsif Num'Machine_Mantissa = 64 then Maxexp80 (5)
         else  raise Program_Error);
      --  Maximum exponent of 5 that can fit in Num

      Powfive : constant array (0 .. Maxpow) of Double_T;
      pragma Import (Ada, Powfive);
      for Powfive'Address use Powfive_Address;

      R : Double_T;
      E : Natural;

   begin
      pragma Assert (Exp > Maxexp);

      pragma Warnings (Off, "-gnatw.a");
      pragma Assert (not Is_Large_Type);
      pragma Warnings (On, "-gnatw.a");

      R := Powfive (Maxpow);
      E := Exp - Maxpow;

      --  If the exponent is not too large, then scale down the result so that
      --  its final value does not overflow but, if it's too large, then do not
      --  bother doing it since overflow is just fine. The scaling factor is -3
      --  for every power of 5 above the maximum, in other words division by 8.

      if Exp - Maxexp <= Maxpow then
         S := 3 * (Exp - Maxexp);
         R.Hi := Num'Scaling (R.Hi, -S);
         R.Lo := Num'Scaling (R.Lo, -S);
      else
         S := 0;
      end if;

      while E > Maxpow loop
         R := R * Powfive (Maxpow);
         E := E - Maxpow;
      end loop;

      R := R * Powfive (E);

      return R;
   end Large_Powfive;

   ---------------
   -- Scan_Real --
   ---------------

   function Scan_Real
     (Str : String;
      Ptr : not null access Integer;
      Max : Integer) return Num
   is
      Base  : Unsigned;
      Scale : Impl.Scale_Array;
      Extra : Unsigned;
      Minus : Boolean;
      Val   : Impl.Value_Array;

   begin
      Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus);

      return Integer_to_Real (Str, Val, Base, Scale, Minus);
   end Scan_Real;

   ----------------
   -- Value_Real --
   ----------------

   function Value_Real (Str : String) return Num is
      Base  : Unsigned;
      Scale : Impl.Scale_Array;
      Extra : Unsigned;
      Minus : Boolean;
      Val   : Impl.Value_Array;

   begin
      Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus);

      return Integer_to_Real (Str, Val, Base, Scale, Minus);
   end Value_Real;

end System.Val_Real;