public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-4549] [Ada] Factor out machine rounding operations
@ 2021-10-20 10:18 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-20 10:18 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:60440d3cf51acb9cb63543d5bb71fd50cfdd9470
commit r12-4549-g60440d3cf51acb9cb63543d5bb71fd50cfdd9470
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Wed Oct 13 20:50:28 2021 +0200
[Ada] Factor out machine rounding operations
gcc/ada/
* sem_eval.ads (Machine_Number): New inline function.
* sem_eval.adb (Machine_Number): New function body implementing
the machine rounding operation specified by RM 4.9(38/2).
(Check_Non_Static_Context): Call Machine_Number and set the
Is_Machine_Number flag consistently on the resulting node.
* sem_attr.adb (Eval_Attribute) <Attribute_Machine>: Likewise.
* checks.adb (Apply_Float_Conversion_Check): Call Machine_Number.
(Round_Machine): Likewise.
Diff:
---
gcc/ada/checks.adb | 8 ++++----
gcc/ada/sem_attr.adb | 8 +++-----
gcc/ada/sem_eval.adb | 38 ++++++++++++++++++++++++--------------
gcc/ada/sem_eval.ads | 8 ++++++++
4 files changed, 39 insertions(+), 23 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index c06012b57a7..c85cba9a5aa 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -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
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 32c5d3785a6..f2bb12dae5f 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -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 --
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 954a4a63689..e3308efbf25 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -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 --
--------------------
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index c93d97d8822..c2e08b665a9 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-20 10:18 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-20 10:18 [gcc r12-4549] [Ada] Factor out machine rounding operations Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).