eval_fat.adb: (Eps_Model,Eps_Denorm): Remove, no longer used.

	* eval_fat.adb: (Eps_Model,Eps_Denorm): Remove, no longer used.
	(Succ): Re-implement using Scaling, Exponent and Ceiling attributes.
	(Pred): Implement in terms of Succ.

	* trans.c (convert_with_check): Reimplement conversion of float to
	integer.

From-SVN: r92834

2 files changed, 87 insertions, 107 deletions

diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb
index 00a131d..9221e91 100644
--- a/gcc/ada/eval_fat.adb
+++ b/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,12 +74,6 @@ 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
 
@@ -91,10 +85,8 @@ 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;
@@ -106,14 +98,11 @@ 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;
@@ -382,10 +371,10 @@ package body Eval_Fat is
       Calculate_Fraction_And_Exponent : begin
          Uintp_Mark := Mark;
 
-         --  Determine correct rounding based on the remainder
-         --  which is in N and the divisor D. The rounding is
-         --  performed on the absolute value of X, so Ceiling
-         --  and Floor need to check for the sign of X explicitly.
+         --  Determine correct rounding based on the remainder which is in
+         --  N and the divisor D. The rounding is performed on the absolute
+         --  value of X, so Ceiling and Floor need to check for the sign of
+         --  X explicitly.
 
          case Mode is
             when Round_Even =>
@@ -440,25 +429,6 @@ 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 --
    --------------
@@ -735,37 +705,8 @@ package body Eval_Fat is
    ----------
 
    function Pred (RT : R; X : T) return T is
-      Result_F : UI;
-      Result_X : UI;
-
    begin
-      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;
+      return -Succ (RT, -X);
    end Pred;
 
    ---------------
@@ -892,35 +833,38 @@ package body Eval_Fat is
    ----------
 
    function Succ (RT : R; X : T) return T is
-      Result_F : UI;
-      Result_X : UI;
+      Emin     : constant UI := UI_From_Int (Machine_Emin (RT));
+      Mantissa : constant UI := UI_From_Int (Machine_Mantissa (RT));
+      Exp      : UI := UI_Max (Emin, Exponent (RT, X));
+      Frac     : T;
+      New_Frac : T;
 
    begin
-      if abs X < Eps_Model (RT) then
-         if Denorm_On_Target then
-            return X + Eps_Denorm (RT);
+      if UR_Is_Zero (X) then
+         Exp := Emin;
+      end if;
 
-         elsif X < Ureal_0 then
-            --  Target does not support denorms, so successor is 0.0
-            return Ureal_0;
+      --  Set exponent such that the radix point will be directly
+      --  following the mantissa after scaling
 
-         else
-            --  Target does not support denorms, and X is 0.0
-            --  or at least smaller than Eps_Model (RT)
+      if Denorm_On_Target or Exp /= Emin then
+         Exp := Exp - Mantissa;
+      else
+         Exp := Exp - 1;
+      end if;
 
-            return Eps_Model (RT);
-         end if;
+      Frac := Scaling (RT, X, -Exp);
+      New_Frac := Ceiling (RT, Frac);
 
-      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.
+      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;
+         end if;
       end if;
+
+      return Scaling (RT, New_Frac, Exp);
    end Succ;
 
    ----------------
@@ -929,7 +873,6 @@ 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;
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index a005fed..94aa9dc 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -165,9 +165,6 @@ static tree maybe_implicit_deref (tree);
 static tree gnat_stabilize_reference_1 (tree, bool);
 static void annotate_with_node (tree, Node_Id);
 
-/* Constants for +0.5 and -0.5 for float-to-integer rounding.  */
-static REAL_VALUE_TYPE dconstp5;
-static REAL_VALUE_TYPE dconstmp5;
 
 /* This is the main program of the back-end.  It sets up all the table
    structures and then generates code.  */
@@ -288,9 +285,6 @@ gnat_init_stmt_group ()
     set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
 
   gcc_assert (Exception_Mechanism != Front_End_ZCX);
-
-  REAL_ARITHMETIC (dconstp5, RDIV_EXPR, dconst1, dconst2);
-  REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2);
 }
 
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
@@ -5195,17 +5189,60 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
   if (INTEGRAL_TYPE_P (gnu_ada_base_type) && FLOAT_TYPE_P (gnu_in_basetype)
       && !truncatep)
     {
-      tree gnu_point_5 = build_real (gnu_in_basetype, dconstp5);
-      tree gnu_minus_point_5 = build_real (gnu_in_basetype, dconstmp5);
-      tree gnu_zero = convert (gnu_in_basetype, integer_zero_node);
-      tree gnu_saved_result = save_expr (gnu_result);
-      tree gnu_comp = build2 (GE_EXPR, integer_type_node,
-			      gnu_saved_result, gnu_zero);
-      tree gnu_adjust = build3 (COND_EXPR, gnu_in_basetype, gnu_comp,
-				gnu_point_5, gnu_minus_point_5);
-
-      gnu_result
-	= build2 (PLUS_EXPR, gnu_in_basetype, gnu_saved_result, gnu_adjust);
+      REAL_VALUE_TYPE half_minus_pred_half, pred_half;
+      tree gnu_conv, gnu_zero, gnu_comp, gnu_saved_result, calc_type;
+      tree gnu_pred_half, gnu_add_pred_half, gnu_subtract_pred_half;
+      const struct real_format *fmt;
+
+      /* The following calculations depend on proper rounding to even
+         of each arithmetic operation. In order to prevent excess
+         precision from spoiling this property, use the widest hardware
+         floating-point type.
+
+         FIXME: For maximum efficiency, this should only be done for machines
+         and types where intermediates may have extra precision.  */
+
+      calc_type = longest_float_type_node;
+      /* FIXME: Should not have padding in the first place */
+      if (TREE_CODE (calc_type) == RECORD_TYPE
+              && TYPE_IS_PADDING_P (calc_type))
+        calc_type = TREE_TYPE (TYPE_FIELDS (calc_type));
+
+      /* Compute the exact value calc_type'Pred (0.5) at compile time. */
+      fmt = REAL_MODE_FORMAT (TYPE_MODE (calc_type));
+      real_2expN (&half_minus_pred_half, -(fmt->p) - 1);
+      REAL_ARITHMETIC (pred_half, MINUS_EXPR, dconsthalf,
+                       half_minus_pred_half);
+      gnu_pred_half = build_real (calc_type, pred_half);
+
+      /* If the input is strictly negative, subtract this value
+         and otherwise add it from the input. For 0.5, the result
+         is exactly between 1.0 and the machine number preceding 1.0
+         (for calc_type). Since the last bit of 1.0 is even, this 0.5
+         will round to 1.0, while all other number with an absolute
+         value less than 0.5 round to 0.0. For larger numbers exactly
+         halfway between integers, rounding will always be correct as
+         the true mathematical result will be closer to the higher
+         integer compared to the lower one. So, this constant works
+         for all floating-point numbers.
+
+         The reason to use the same constant with subtract/add instead
+         of a positive and negative constant is to allow the comparison
+         to be scheduled in parallel with retrieval of the constant and
+         conversion of the input to the calc_type (if necessary).
+      */
+
+      gnu_zero = convert (gnu_in_basetype, integer_zero_node);
+      gnu_saved_result = save_expr (gnu_result);
+      gnu_conv = convert (calc_type, gnu_saved_result);
+      gnu_comp = build2 (GE_EXPR, integer_type_node,
+	                gnu_saved_result, gnu_zero);
+      gnu_add_pred_half
+        = build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+      gnu_subtract_pred_half
+        = build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+      gnu_result = build3 (COND_EXPR, calc_type, gnu_comp,
+			   gnu_add_pred_half, gnu_subtract_pred_half);
     }
 
   if (TREE_CODE (gnu_ada_base_type) == INTEGER_TYPE