eval_fat.adb (Decompose_Int): Handle argument of zero.

2007-12-06  Geert Bosch  <bosch@adacore.com>

	* eval_fat.adb (Decompose_Int): Handle argument of zero.
	(Compose): Remove special casing of zero.
	(Exponent): Likewise.
	(Fraction): Likewise.
	(Machine): Likewise.
	(Decompose): Update comment.

From-SVN: r130827

1 files changed, 128 insertions, 147 deletions

diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb
index ab5e49f..78dcea6 100644
--- a/gcc/ada/eval_fat.adb
+++ b/gcc/ada/eval_fat.adb
@@ -32,13 +32,13 @@ with Targparm; use Targparm;
 package body Eval_Fat is
 
    Radix : constant Int := 2;
-   --  This code is currently only correct for the radix 2 case. We use
-   --  the symbolic value Radix where possible to help in the unlikely
-   --  case of anyone ever having to adjust this code for another value,
-   --  and for documentation purposes.
+   --  This code is currently only correct for the radix 2 case. We use the
+   --  symbolic value Radix where possible to help in the unlikely case of
+   --  anyone ever having to adjust this code for another value, and for
+   --  documentation purposes.
 
-   --  Another assumption is that the range of the floating-point type
-   --  is symmetric around zero.
+   --  Another assumption is that the range of the floating-point type is
+   --  symmetric around zero.
 
    type Radix_Power_Table is array (Int range 1 .. 4) of Int;
 
@@ -55,10 +55,9 @@ package body Eval_Fat is
       Fraction : out T;
       Exponent : out UI;
       Mode     : Rounding_Mode := Round);
-   --  Decomposes a non-zero floating-point number into fraction and
-   --  exponent parts. The fraction is in the interval 1.0 / Radix ..
-   --  T'Pred (1.0) and uses Rbase = Radix.
-   --  The result is rounded to a nearest machine number.
+   --  Decomposes a non-zero floating-point number into fraction and exponent
+   --  parts. The fraction is in the interval 1.0 / Radix .. T'Pred (1.0) and
+   --  uses Rbase = Radix. The result is rounded to a nearest machine number.
 
    procedure Decompose_Int
      (RT       : R;
@@ -116,12 +115,8 @@ package body Eval_Fat is
       Arg_Exp  : UI;
       pragma Warnings (Off, Arg_Exp);
    begin
-      if UR_Is_Zero (Fraction) then
-         return Fraction;
-      else
-         Decompose (RT, Fraction, Arg_Frac, Arg_Exp);
-         return Scaling (RT, Arg_Frac, Exponent);
-      end if;
+      Decompose (RT, Fraction, Arg_Frac, Arg_Exp);
+      return Scaling (RT, Arg_Frac, Exponent);
    end Compose;
 
    ---------------
@@ -175,10 +170,10 @@ package body Eval_Fat is
    -- Decompose_Int --
    -------------------
 
-   --  This procedure should be modified with care, as there are many
-   --  non-obvious details that may cause problems that are hard to
-   --  detect. The cases of positive and negative zeroes are also
-   --  special and should be verified separately.
+   --  This procedure should be modified with care, as there are many non-
+   --  obvious details that may cause problems that are hard to detect. For
+   --  zero arguments, Fraction and Exponent are set to zero. Note that sign
+   --  of zero cannot be preserved.
 
    procedure Decompose_Int
      (RT       : R;
@@ -204,13 +199,19 @@ package body Eval_Fat is
       --  intermediate values (this routine generates lots of junk!)
 
    begin
+      if N = Uint_0 then
+         Fraction := Uint_0;
+         Exponent := Uint_0;
+         return;
+      end if;
+
       Calculate_D_And_Exponent_1 : begin
          Uintp_Mark := Mark;
          Exponent := Uint_0;
 
-         --  In cases where Base > 1, the actual denominator is
-         --  Base**D. For cases where Base is a power of Radix, use
-         --  the value 1 for the Denominator and adjust the exponent.
+         --  In cases where Base > 1, the actual denominator is Base**D. For
+         --  cases where Base is a power of Radix, use the value 1 for the
+         --  Denominator and adjust the exponent.
 
          --  Note: Exponent has different sign from D, because D is a divisor
 
@@ -230,13 +231,13 @@ package body Eval_Fat is
          Calculate_Exponent : begin
             Uintp_Mark := Mark;
 
-            --  For bases that are a multiple of the Radix, divide
-            --  the base by Radix and adjust the Exponent. This will
-            --  help because D will be much smaller and faster to process.
+            --  For bases that are a multiple of the Radix, divide the base by
+            --  Radix and adjust the Exponent. This will help because D will be
+            --  much smaller and faster to process.
 
-            --  This occurs for decimal bases on a machine with binary
-            --  floating-point for example. When calculating 1E40,
-            --  with Radix = 2, N will be 93 bits instead of 133.
+            --  This occurs for decimal bases on machines with binary floating-
+            --  point for example. When calculating 1E40, with Radix = 2, N
+            --  will be 93 bits instead of 133.
 
             --        N            E
             --      ------  * Radix
@@ -264,11 +265,10 @@ package body Eval_Fat is
             Release_And_Save (Uintp_Mark, Exponent);
          end Calculate_Exponent;
 
-         --  For remaining bases we must actually compute
-         --  the exponentiation.
+         --  For remaining bases we must actually compute the exponentiation
 
-         --  Because the exponentiation can be negative, and D must
-         --  be integer, the numerator is corrected instead.
+         --  Because the exponentiation can be negative, and D must be integer,
+         --  the numerator is corrected instead.
 
          Calculate_N_And_D : begin
             Uintp_Mark := Mark;
@@ -286,29 +286,25 @@ package body Eval_Fat is
          Base := 0;
       end if;
 
-      --  Now scale N and D so that N / D is a value in the
-      --  interval [1.0 / Radix, 1.0) and adjust Exponent accordingly,
-      --  so the value N / D * Radix ** Exponent remains unchanged.
+      --  Now scale N and D so that N / D is a value in the interval [1.0 /
+      --  Radix, 1.0) and adjust Exponent accordingly, so the value N / D *
+      --  Radix ** Exponent remains unchanged.
 
       --  Step 1 - Adjust N so N / D >= 1 / Radix, or N = 0
 
       --  N and D are positive, so N / D >= 1 / Radix implies N * Radix >= D.
-      --  This scaling is not possible for N is Uint_0 as there
-      --  is no way to scale Uint_0 so the first digit is non-zero.
+      --  As this scaling is not possible for N is Uint_0, zero is handled
+      --  explicitly at the start of this subprogram.
 
       Calculate_N_And_Exponent : begin
          Uintp_Mark := Mark;
 
          N_Times_Radix := N * Radix;
-
-         if N /= Uint_0 then
-            while not (N_Times_Radix >= D) loop
-               N := N_Times_Radix;
-               Exponent := Exponent - 1;
-
-               N_Times_Radix := N * Radix;
-            end loop;
-         end if;
+         while not (N_Times_Radix >= D) loop
+            N := N_Times_Radix;
+            Exponent := Exponent - 1;
+            N_Times_Radix := N * Radix;
+         end loop;
 
          Release_And_Save (Uintp_Mark, N, Exponent);
       end Calculate_N_And_Exponent;
@@ -322,8 +318,8 @@ package body Eval_Fat is
 
          while not (N < D) loop
 
-            --  As N / D >= 1, N / (D * Radix) will be at least 1 / Radix,
-            --  so the result of Step 1 stays valid
+            --  As N / D >= 1, N / (D * Radix) will be at least 1 / Radix, so
+            --  the result of Step 1 stays valid
 
             D := D * Radix;
             Exponent := Exponent + 1;
@@ -334,14 +330,14 @@ package body Eval_Fat is
 
       --  Here the value N / D is in the range [1.0 / Radix .. 1.0)
 
-      --  Now find the fraction by doing a very simple-minded
-      --  division until enough digits have been computed.
+      --  Now find the fraction by doing a very simple-minded division until
+      --  enough digits have been computed.
 
-      --  This division works for all radices, but is only efficient for
-      --  a binary radix. It is just like a manual division algorithm,
-      --  but instead of moving the denominator one digit right, we move
-      --  the numerator one digit left so the numerator and denominator
-      --  remain integral.
+      --  This division works for all radices, but is only efficient for a
+      --  binary radix. It is just like a manual division algorithm, but
+      --  instead of moving the denominator one digit right, we move the
+      --  numerator one digit left so the numerator and denominator remain
+      --  integral.
 
       Fraction := Uint_0;
       Even := True;
@@ -380,8 +376,8 @@ package body Eval_Fat is
             when Round_Even =>
 
                --  This rounding mode should not be used for static
-               --  expressions, but only for compile-time evaluation
-               --  of non-static expressions.
+               --  expressions, but only for compile-time evaluation of
+               --  non-static expressions.
 
                if (Even and then N * 2 > D)
                      or else
@@ -392,9 +388,9 @@ package body Eval_Fat is
 
             when Round   =>
 
-               --  Do not round to even as is done with IEEE arithmetic,
-               --  but instead round away from zero when the result is
-               --  exactly between two machine numbers. See RM 4.9(38).
+               --  Do not round to even as is done with IEEE arithmetic, but
+               --  instead round away from zero when the result is exactly
+               --  between two machine numbers. See RM 4.9(38).
 
                if N * 2 >= D then
                   Fraction := Fraction + 1;
@@ -411,8 +407,8 @@ package body Eval_Fat is
                end if;
          end case;
 
-         --  The result must be normalized to [1.0/Radix, 1.0),
-         --  so adjust if the result is 1.0 because of rounding.
+         --  The result must be normalized to [1.0/Radix, 1.0), so adjust if
+         --  the result is 1.0 because of rounding.
 
          if Fraction = Most_Significant_Digit * Radix then
             Fraction := Most_Significant_Digit;
@@ -438,12 +434,8 @@ package body Eval_Fat is
       X_Exp  : UI;
       pragma Warnings (Off, X_Frac);
    begin
-      if UR_Is_Zero (X) then
-         return Uint_0;
-      else
-         Decompose_Int (RT, X, X_Frac, X_Exp, Round_Even);
-         return X_Exp;
-      end if;
+      Decompose_Int (RT, X, X_Frac, X_Exp, Round_Even);
+      return X_Exp;
    end Exponent;
 
    -----------
@@ -474,12 +466,8 @@ package body Eval_Fat is
       X_Exp  : UI;
       pragma Warnings (Off, X_Exp);
    begin
-      if UR_Is_Zero (X) then
-         return X;
-      else
-         Decompose (RT, X, X_Frac, X_Exp);
-         return X_Frac;
-      end if;
+      Decompose (RT, X, X_Frac, X_Exp);
+      return X_Frac;
    end Fraction;
 
    ------------------
@@ -511,81 +499,74 @@ package body Eval_Fat is
       Emin   : constant UI := UI_From_Int (Machine_Emin (RT));
 
    begin
-      if UR_Is_Zero (X) then
-         return X;
+      Decompose (RT, X, X_Frac, X_Exp, Mode);
+
+      --  Case of denormalized number or (gradual) underflow
+
+      --  A denormalized number is one with the minimum exponent Emin, but that
+      --  breaks the assumption that the first digit of the mantissa is a one.
+      --  This allows the first non-zero digit to be in any of the remaining
+      --  Mant - 1 spots. The gap between subsequent denormalized numbers is
+      --  the same as for the smallest normalized numbers. However, the number
+      --  of significant digits left decreases as a result of the mantissa now
+      --  having leading seros.
+
+      if X_Exp < Emin then
+         declare
+            Emin_Den : constant UI :=
+                         UI_From_Int
+                           (Machine_Emin (RT) - Machine_Mantissa (RT) + 1);
+         begin
+            if X_Exp < Emin_Den or not Denorm_On_Target then
+               if UR_Is_Negative (X) then
+                  Error_Msg_N
+                    ("floating-point value underflows to -0.0?", Enode);
+                  return Ureal_M_0;
+
+               else
+                  Error_Msg_N
+                    ("floating-point value underflows to 0.0?", Enode);
+                  return Ureal_0;
+               end if;
 
-      else
-         Decompose (RT, X, X_Frac, X_Exp, Mode);
-
-         --  Case of denormalized number or (gradual) underflow
-
-         --  A denormalized number is one with the minimum exponent Emin, but
-         --  that breaks the assumption that the first digit of the mantissa
-         --  is a one. This allows the first non-zero digit to be in any
-         --  of the remaining Mant - 1 spots. The gap between subsequent
-         --  denormalized numbers is the same as for the smallest normalized
-         --  numbers. However, the number of significant digits left decreases
-         --  as a result of the mantissa now having leading seros.
-
-         if X_Exp < Emin then
-            declare
-               Emin_Den : constant UI :=
-                            UI_From_Int
-                              (Machine_Emin (RT) - Machine_Mantissa (RT) + 1);
-            begin
-               if X_Exp < Emin_Den or not Denorm_On_Target then
-                  if UR_Is_Negative (X) then
-                     Error_Msg_N
-                       ("floating-point value underflows to -0.0?", Enode);
-                     return Ureal_M_0;
+            elsif Denorm_On_Target then
 
-                  else
-                     Error_Msg_N
-                       ("floating-point value underflows to 0.0?", Enode);
-                     return Ureal_0;
-                  end if;
+               --  Emin - Mant <= X_Exp < Emin, so result is denormal. Handle
+               --  gradual underflow by first computing the number of
+               --  significant bits still available for the mantissa and
+               --  then truncating the fraction to this number of bits.
 
-               elsif Denorm_On_Target then
-
-                  --  Emin - Mant <= X_Exp < Emin, so result is denormal.
-                  --  Handle gradual underflow by first computing the
-                  --  number of significant bits still available for the
-                  --  mantissa and then truncating the fraction to this
-                  --  number of bits.
-
-                  --  If this value is different from the original
-                  --  fraction, precision is lost due to gradual underflow.
-
-                  --  We probably should round here and prevent double
-                  --  rounding as a result of first rounding to a model
-                  --  number and then to a machine number. However, this
-                  --  is an extremely rare case that is not worth the extra
-                  --  complexity. In any case, a warning is issued in cases
-                  --  where gradual underflow occurs.
-
-                  declare
-                     Denorm_Sig_Bits : constant UI := X_Exp - Emin_Den + 1;
-
-                     X_Frac_Denorm   : constant T := UR_From_Components
-                       (UR_Trunc (Scaling (RT, abs X_Frac, Denorm_Sig_Bits)),
-                        Denorm_Sig_Bits,
-                        Radix,
-                        UR_Is_Negative (X));
-
-                  begin
-                     if X_Frac_Denorm /= X_Frac then
-                        Error_Msg_N
-                          ("gradual underflow causes loss of precision?",
-                           Enode);
-                        X_Frac := X_Frac_Denorm;
-                     end if;
-                  end;
-               end if;
-            end;
-         end if;
+               --  If this value is different from the original fraction,
+               --  precision is lost due to gradual underflow.
+
+               --  We probably should round here and prevent double rounding as
+               --  a result of first rounding to a model number and then to a
+               --  machine number. However, this is an extremely rare case that
+               --  is not worth the extra complexity. In any case, a warning is
+               --  issued in cases where gradual underflow occurs.
+
+               declare
+                  Denorm_Sig_Bits : constant UI := X_Exp - Emin_Den + 1;
+
+                  X_Frac_Denorm   : constant T := UR_From_Components
+                    (UR_Trunc (Scaling (RT, abs X_Frac, Denorm_Sig_Bits)),
+                     Denorm_Sig_Bits,
+                     Radix,
+                     UR_Is_Negative (X));
 
-         return Scaling (RT, X_Frac, X_Exp);
+               begin
+                  if X_Frac_Denorm /= X_Frac then
+                     Error_Msg_N
+                       ("gradual underflow causes loss of precision?",
+                        Enode);
+                     X_Frac := X_Frac_Denorm;
+                  end if;
+               end;
+            end if;
+         end;
       end if;
+
+      return Scaling (RT, X_Frac, X_Exp);
    end Machine;
 
    ------------------
@@ -848,8 +829,8 @@ package body Eval_Fat is
          Exp := Emin;
       end if;
 
-      --  Set exponent such that the radix point will be directly
-      --  following the mantissa after scaling
+      --  Set exponent such that the radix point will be directly following the
+      --  mantissa after scaling.
 
       if Denorm_On_Target or Exp /= Emin then
          Exp := Exp - Mantissa;