From 32543637450cd686a193fafc681501e930b66088 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 18 Nov 2020 21:42:18 +0100 Subject: [PATCH] [Ada] Fix couple of bugs in the implementation of Round attribute gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference) : Adjust commentary and set the Rounded_Result flag on the type conversion node when the node is needed. * exp_ch4.adb (Expand_N_Type_Conversion): Minor tweak. (Fixup_Universal_Fixed_Operation): Look through the type conversion only when it is to Universal_Real. * exp_fixd.adb: Remove with and use clauses for Snames. (Build_Divide): Remove redundant test. (Expand_Convert_Float_To_Fixed): Use Rounded_Result flag on the node to set the truncation parameter. --- gcc/ada/exp_attr.adb | 38 ++++++++++++++++++++------------------ gcc/ada/exp_ch4.adb | 5 +++-- gcc/ada/exp_fixd.adb | 23 ++++------------------- 3 files changed, 27 insertions(+), 39 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b21592c78b2..ff3d54f7880 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6196,20 +6196,19 @@ package body Exp_Attr is -- Round -- ----------- - -- The handling of the Round attribute is quite delicate. The processing - -- in Sem_Attr introduced a conversion to universal real, reflecting the - -- semantics of Round, but we do not want anything to do with universal - -- real at runtime, since this corresponds to using floating-point - -- arithmetic. + -- The handling of the Round attribute is delicate when the operand is + -- universal fixed. In this case, the processing in Sem_Attr introduced + -- a conversion to universal real, reflecting the semantics of Round, + -- but we do not want anything to do with universal real at run time, + -- since this corresponds to using floating-point arithmetic. -- What we have now is that the Etype of the Round attribute correctly -- indicates the final result type. The operand of the Round is the -- conversion to universal real, described above, and the operand of -- this conversion is the actual operand of Round, which may be the - -- special case of a fixed point multiplication or division (Etype = - -- universal fixed) + -- special case of a fixed point multiplication or division. - -- The exapander will expand first the operand of the conversion, then + -- The expander will expand first the operand of the conversion, then -- the conversion, and finally the round attribute itself, since we -- always work inside out. But we cannot simply process naively in this -- order. In the semantic world where universal fixed and real really @@ -6217,14 +6216,13 @@ package body Exp_Attr is -- implementation world, where universal real is a floating-point type, -- we would get the wrong result. - -- So the approach is as follows. First, when expanding a multiply or - -- divide whose type is universal fixed, we do nothing at all, instead - -- deferring the operation till later. - - -- The actual processing is done in Expand_N_Type_Conversion which - -- handles the special case of Round by looking at its parent to see if - -- it is a Round attribute, and if it is, handling the conversion (or - -- its fixed multiply/divide child) in an appropriate manner. + -- So the approach is as follows. When expanding a multiply or divide + -- whose type is universal fixed, Fixup_Universal_Fixed_Operation will + -- look up and skip the conversion to universal real if its parent is + -- a Round attribute, taking information from this attribute node. In + -- the other cases, Expand_N_Type_Conversion does the same by looking + -- at its parent to see if it is a Round attribute, before calling the + -- fixed-point expansion routine. -- This means that by the time we get to expanding the Round attribute -- itself, the Round is nothing more than a type conversion (and will @@ -6232,8 +6230,12 @@ package body Exp_Attr is -- appropriate conversion operation. when Attribute_Round => - Rewrite (N, - Convert_To (Etype (N), Relocate_Node (First (Exprs)))); + if Etype (First (Exprs)) = Etype (N) then + Rewrite (N, Relocate_Node (First (Exprs))); + else + Rewrite (N, Convert_To (Etype (N), First (Exprs))); + Set_Rounded_Result (N); + end if; Analyze_And_Resolve (N); -------------- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index ecaeeb27ff6..91ae71efd21 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12556,9 +12556,9 @@ package body Exp_Ch4 is and then Nkind (Parent (N)) = N_Attribute_Reference and then Attribute_Name (Parent (N)) = Name_Round then - Set_Rounded_Result (N); Set_Etype (N, Etype (Parent (N))); Target_Type := Etype (N); + Set_Rounded_Result (N); end if; if Is_Fixed_Point_Type (Target_Type) then @@ -13375,7 +13375,8 @@ package body Exp_Ch4 is -- will be to universal real, and our real type comes from the Round -- attribute (as well as an indication that we must round the result) - if Nkind (Parent (Conv)) = N_Attribute_Reference + if Etype (Conv) = Universal_Real + and then Nkind (Parent (Conv)) = N_Attribute_Reference and then Attribute_Name (Parent (Conv)) = Name_Round then Set_Etype (N, Base_Type (Etype (Parent (Conv)))); diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index 3bb7207bf00..8edca447173 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -37,7 +37,6 @@ with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; -with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; with Ttypes; use Ttypes; @@ -417,13 +416,9 @@ package body Exp_Fixd is -- The result is rounded if the target of the operation is decimal -- and Rounded_Result is set, or if the target of the operation - -- is an integer type. + -- is an integer type, as determined by Rounded_Result_Set. - if Is_Integer_Type (Etype (N)) - or else Rounded_Result_Set (N) - then - Set_Rounded_Result (Rnode); - end if; + Set_Rounded_Result (Rnode, Rounded_Result_Set (N)); -- One more check. We did the divide operation using the longer of -- the two sizes, which is reasonable. However, in the case where the @@ -1792,11 +1787,9 @@ package body Exp_Fixd is procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is Expr : constant Node_Id := Expression (N); - Orig_N : constant Node_Id := Original_Node (N); Result_Type : constant Entity_Id := Etype (N); Rng_Check : constant Boolean := Do_Range_Check (N); Small : constant Ureal := Small_Value (Result_Type); - Truncate : Boolean; begin -- Optimize small = 1, where we can avoid the multiply completely @@ -1811,15 +1804,6 @@ package body Exp_Fixd is -- round. else - if Is_Decimal_Fixed_Point_Type (Result_Type) then - Truncate := - Nkind (Orig_N) /= N_Attribute_Reference - or else Get_Attribute_Id - (Attribute_Name (Orig_N)) /= Attribute_Round; - else - Truncate := False; - end if; - Set_Result (N => N, Expr => @@ -1828,7 +1812,8 @@ package body Exp_Fixd is L => Fpt_Value (Expr), R => Real_Literal (N, Ureal_1 / Small)), Rchk => Rng_Check, - Trunc => Truncate); + Trunc => Is_Decimal_Fixed_Point_Type (Result_Type) + and not Rounded_Result (N)); end if; end Expand_Convert_Float_To_Fixed; -- 2.30.2