OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
* 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
This commit is contained in:
Arnaud Charlet 2005-01-03 16:36:06 +01:00
parent c5e12904bc
commit 050d31e815
2 changed files with 90 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
gcc/ada/eval_fat.adb
View File

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

69
gcc/ada/trans.c
View File

@ -165,9 +165,6 @@ static tree maybe_implicit_deref (tree);
static tree gnat_stabilize_reference_1 (tree, bool); static tree gnat_stabilize_reference_1 (tree, bool);
static void annotate_with_node (tree, Node_Id); 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 /* This is the main program of the back-end. It sets up all the table
structures and then generates code. */ 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")); set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
gcc_assert (Exception_Mechanism != Front_End_ZCX); 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, /* 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) if (INTEGRAL_TYPE_P (gnu_ada_base_type) && FLOAT_TYPE_P (gnu_in_basetype)
&& !truncatep) && !truncatep)
{ {
tree gnu_point_5 = build_real (gnu_in_basetype, dconstp5); REAL_VALUE_TYPE half_minus_pred_half, pred_half;
tree gnu_minus_point_5 = build_real (gnu_in_basetype, dconstmp5); tree gnu_conv, gnu_zero, gnu_comp, gnu_saved_result, calc_type;
tree gnu_zero = convert (gnu_in_basetype, integer_zero_node); tree gnu_pred_half, gnu_add_pred_half, gnu_subtract_pred_half;
tree gnu_saved_result = save_expr (gnu_result); const struct real_format *fmt;
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 /* The following calculations depend on proper rounding to even
= build2 (PLUS_EXPR, gnu_in_basetype, gnu_saved_result, gnu_adjust); 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 if (TREE_CODE (gnu_ada_base_type) == INTEGER_TYPE