Skip to content

R
riscv-gcc-1
Commit 050d31e8 by Arnaud Charlet
Options

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
parent c5e12904
Showing with 84 additions and 104 deletions
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
if Denorm_On_Target or Exp /= Emin then
Exp := Exp - Mantissa;
else
-- Target does not support denorms, and X is 0.0
-- or at least smaller than Eps_Model (RT)
return Eps_Model (RT);
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
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.
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;
......
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,
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);
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);
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment