-- 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 --
-----------------------
-- 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
begin
if Towards = X then
return X;
-
elsif Towards > X then
return Succ (RT, X);
-
else
return Pred (RT, X);
end if;
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;
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 =>
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 --
--------------
----------
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;
---------------
----------
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;
----------------
function Truncation (RT : R; X : T) return T is
pragma Warnings (Off, RT);
-
begin
return UR_From_Uint (UR_Trunc (X));
end Truncation;
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;
\f
/* This is the main program of the back-end. It sets up all the table
structures and then generates code. */
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);
}
\f
/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
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
OSDN Git Service
