@@ -2171,7 +2171,7 @@ package body Checks is
Lo_OK := (Ifirst > 0);
else
- Lo := Machine (Expr_Type, UR_From_Uint (Ifirst), Round_Even, Expr);
+ Lo := Machine_Number (Expr_Type, UR_From_Uint (Ifirst), Expr);
Lo_OK := (Lo >= UR_From_Uint (Ifirst));
end if;
@@ -2214,7 +2214,7 @@ package body Checks is
Hi := UR_From_Uint (Ilast) + Ureal_Half;
Hi_OK := (Ilast < 0);
else
- Hi := Machine (Expr_Type, UR_From_Uint (Ilast), Round_Even, Expr);
+ Hi := Machine_Number (Expr_Type, UR_From_Uint (Ilast), Expr);
Hi_OK := (Hi <= UR_From_Uint (Ilast));
end if;
@@ -5563,7 +5563,7 @@ package body Checks is
-- the results in Lo_Right, Hi_Right, Lo_Left, Hi_Left.
function Round_Machine (B : Ureal) return Ureal;
- -- B is a real bound. Round it using mode Round_Even.
+ -- B is a real bound. Round it to the nearest machine number.
-----------------
-- OK_Operands --
@@ -5589,7 +5589,7 @@ package body Checks is
function Round_Machine (B : Ureal) return Ureal is
begin
- return Machine (Typ, B, Round_Even, N);
+ return Machine_Number (Typ, B, N);
end Round_Machine;
-- Start of processing for Determine_Range_R
@@ -9251,14 +9251,12 @@ package body Sem_Attr is
-- Machine --
-------------
- -- We use the same rounding mode as the one used for RM 4.9(38)
+ -- We use the same rounding as the one used for RM 4.9(38/2)
when Attribute_Machine =>
Fold_Ureal
- (N,
- Eval_Fat.Machine
- (P_Base_Type, Expr_Value_R (E1), Eval_Fat.Round_Even, N),
- Static);
+ (N, Machine_Number (P_Base_Type, Expr_Value_R (E1), N), Static);
+ Set_Is_Machine_Number (N);
------------------
-- Machine_Emax --
@@ -523,8 +523,8 @@ package body Sem_Eval is
and then Nkind (Parent (N)) in N_Subexpr
then
Rewrite (N, New_Copy (N));
- Set_Realval
- (N, Machine (Base_Type (T), Realval (N), Round_Even, N));
+ Set_Realval (N, Machine_Number (Base_Type (T), Realval (N), N));
+ Set_Is_Machine_Number (N);
end if;
end if;
@@ -575,18 +575,7 @@ package body Sem_Eval is
(N, Corresponding_Integer_Value (N) * Small_Value (T));
elsif not UR_Is_Zero (Realval (N)) then
-
- -- Note: even though RM 4.9(38) specifies biased rounding, this
- -- has been modified by AI-100 in order to prevent confusing
- -- differences in rounding between static and non-static
- -- expressions. AI-100 specifies that the effect of such rounding
- -- is implementation dependent, and in GNAT we round to nearest
- -- even to match the run-time behavior. Note that this applies
- -- to floating point literals, not fixed points ones, even though
- -- their compiler representation is also as a universal real.
-
- Set_Realval
- (N, Machine (Base_Type (T), Realval (N), Round_Even, N));
+ Set_Realval (N, Machine_Number (Base_Type (T), Realval (N), N));
Set_Is_Machine_Number (N);
end if;
@@ -6045,6 +6034,27 @@ package body Sem_Eval is
return False;
end Is_Statically_Unevaluated;
+ --------------------
+ -- Machine_Number --
+ --------------------
+
+ -- Historical note: RM 4.9(38) originally specified biased rounding but
+ -- this has been modified by AI-268 to prevent confusing differences in
+ -- rounding between static and nonstatic expressions. This AI specifies
+ -- that the effect of such rounding is implementation-dependent instead,
+ -- and in GNAT we round to nearest even to match the run-time behavior.
+ -- Note that this applies to floating-point literals, not fixed-point
+ -- ones, even though their representation is also a universal real.
+
+ function Machine_Number
+ (Typ : Entity_Id;
+ Val : Ureal;
+ N : Node_Id) return Ureal
+ is
+ begin
+ return Machine (Typ, Val, Round_Even, N);
+ end Machine_Number;
+
--------------------
-- Not_Null_Range --
--------------------
@@ -486,6 +486,13 @@ package Sem_Eval is
-- it cannot be determined at compile time. Flag Fixed_Int is used as in
-- routine Is_In_Range above.
+ function Machine_Number
+ (Typ : Entity_Id;
+ Val : Ureal;
+ N : Node_Id) return Ureal;
+ -- Return the machine number of Typ corresponding to the specified Val as
+ -- per RM 4.9(38/2). N is a node only used to post warnings.
+
function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
-- Returns True if it can guarantee that Lo .. Hi is not a null range. If
-- it cannot (because the value of Lo or Hi is not known at compile time)
@@ -574,5 +581,6 @@ private
pragma Inline (Eval_Unchecked_Conversion);
pragma Inline (Is_OK_Static_Expression);
+ pragma Inline (Machine_Number);
end Sem_Eval;