* eval_fat.adb: Revert previous change.

From-SVN: r91880

gcc/ada/eval_fat.adb

@@ -38,14 +38,14 @@ package body Eval_Fat is
    --  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.
-
    type Radix_Power_Table is array (Int range 1 .. 4) of Int;
 
    Radix_Powers : constant Radix_Power_Table :=
                     (Radix ** 1, Radix ** 2, Radix ** 3, Radix ** 4);
 
+   function Float_Radix return T renames Ureal_2;
+   --  Radix expressed in real form
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -74,6 +74,12 @@ package body Eval_Fat is
    --  even, a floor operation or a ceiling operation depending on the setting
    --  of Mode (see corresponding descriptions in Urealp).
 
+   function Eps_Model (RT : R) return T;
+   --  Return the smallest model number of R.
+
+   function Eps_Denorm (RT : R) return T;
+   --  Return the smallest denormal of type R.
+
    function Machine_Emin (RT : R) return Int;
    --  Return value of the Machine_Emin attribute
 
@@ -85,8 +91,10 @@ package body Eval_Fat is
    begin
       if Towards = X then
          return X;
+
       elsif Towards > X then
          return Succ (RT, X);
+
       else
          return Pred (RT, X);
       end if;
@@ -98,11 +106,14 @@ package body Eval_Fat is
 
    function Ceiling (RT : R; X : T) return T is
       XT : constant T := Truncation (RT, X);
+
    begin
       if UR_Is_Negative (X) then
          return XT;
+
       elsif X = XT then
          return X;
+
       else
          return XT + Ureal_1;
       end if;
@@ -371,10 +382,10 @@ package body Eval_Fat is
       Calculate_Fraction_And_Exponent : begin
          Uintp_Mark := Mark;
 
-         --  Determine correct rounding based on the remainder which is in
+         --  Determine correct rounding based on the remainder
-         --  N and the divisor D. The rounding is performed on the absolute
+         --  which is in N and the divisor D. The rounding is
-         --  value of X, so Ceiling and Floor need to check for the sign of
+         --  performed on the absolute value of X, so Ceiling
-         --  X explicitly.
+         --  and Floor need to check for the sign of X explicitly.
 
          case Mode is
             when Round_Even =>
@@ -429,6 +440,25 @@ package body Eval_Fat is
       end Calculate_Fraction_And_Exponent;
    end Decompose_Int;
 
+   ----------------
+   -- Eps_Denorm --
+   ----------------
+
+   function Eps_Denorm (RT : R) return T is
+   begin
+      return Float_Radix ** UI_From_Int
+                                  (Machine_Emin (RT) - Machine_Mantissa (RT));
+   end Eps_Denorm;
+
+   ---------------
+   -- Eps_Model --
+   ---------------
+
+   function Eps_Model (RT : R) return T is
+   begin
+      return Float_Radix ** UI_From_Int (Machine_Emin (RT));
+   end Eps_Model;
+
    --------------
    -- Exponent --
    --------------
@@ -705,8 +735,37 @@ package body Eval_Fat is
    ----------
 
    function Pred (RT : R; X : T) return T is
+      Result_F : UI;
+      Result_X : UI;
+
    begin
-      return -Succ (RT, -X);
+      if abs X < Eps_Model (RT) then
+         if Denorm_On_Target then
+            return X - Eps_Denorm (RT);
+
+         elsif X > Ureal_0 then
+
+            --  Target does not support denorms, so predecessor is 0.0
+
+            return Ureal_0;
+
+         else
+            --  Target does not support denorms, and X is 0.0
+            --  or at least bigger than -Eps_Model (RT)
+
+            return -Eps_Model (RT);
+         end if;
+
+      else
+         Decompose_Int (RT, X, Result_F,  Result_X, Ceiling);
+         return UR_From_Components
+           (Num      => Result_F - 1,
+            Den      => Machine_Mantissa (RT) - Result_X,
+            Rbase    => Radix,
+            Negative => False);
+         --  Result_F may be false, but this is OK as UR_From_Components
+         --  handles that situation.
+      end if;
    end Pred;
 
    ---------------
@@ -833,38 +892,35 @@ package body Eval_Fat is
    ----------
 
    function Succ (RT : R; X : T) return T is
-      Emin     : constant UI := UI_From_Int (Machine_Emin (RT));
+      Result_F : UI;
-      Mantissa : constant UI := UI_From_Int (Machine_Mantissa (RT));
+      Result_X : UI;
-      Exp      : UI := UI_Max (Emin, Exponent (RT, X));
-      Frac     : T;
-      New_Frac : T;
 
    begin
-      if UR_Is_Zero (X) then
+      if abs X < Eps_Model (RT) then
-         Exp := Emin;
+         if Denorm_On_Target then
-      end if;
+            return X + Eps_Denorm (RT);
 
-      --  Set exponent such that the radix point will be directly
+         elsif X < Ureal_0 then
-      --  following the mantissa after scaling
+            --  Target does not support denorms, so successor is 0.0
+            return Ureal_0;
 
-      if Denorm_On_Target or Exp /= Emin then
-         Exp := Exp - Mantissa;
-      else
-         Exp := Exp - 1;
-      end if;
-
-      Frac := Scaling (RT, X, -Exp);
-      New_Frac := Ceiling (RT, Frac);
-
-      if New_Frac = Frac then
-         if New_Frac = Scaling (RT, -Ureal_1, Mantissa - 1) then
-            New_Frac := New_Frac + Scaling (RT, Ureal_1, Uint_Minus_1);
          else
-            New_Frac := New_Frac + Ureal_1;
+            --  Target does not support denorms, and X is 0.0
-         end if;
+            --  or at least smaller than Eps_Model (RT)
-      end if;
 
-      return Scaling (RT, New_Frac, Exp);
+            return Eps_Model (RT);
+         end if;
+
+      else
+         Decompose_Int (RT, X, Result_F, Result_X, Floor);
+         return UR_From_Components
+           (Num      => Result_F + 1,
+            Den      => Machine_Mantissa (RT) - Result_X,
+            Rbase    => Radix,
+            Negative => False);
+         --  Result_F may be false, but this is OK as UR_From_Components
+         --  handles that situation.
+      end if;
    end Succ;
 
    ----------------
@@ -873,6 +929,7 @@ package body Eval_Fat is
 
    function Truncation (RT : R; X : T) return T is
       pragma Warnings (Off, RT);
+
    begin
       return UR_From_Uint (UR_Trunc (X));
    end Truncation;