From 8113b0c7385727d9969db2c8420bc0a3d6b8f0ed Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 22 Jul 2019 13:58:19 +0000 Subject: [PATCH] [Ada] Overhaul code implementing conversions involving fixed-point types This ovehauls the code implementing conversions involving fixed-point types in the front-end because it leaks the Do_Range_Check flag in several places to the back-end, which is a violation of the documented interface between front-end and back-end. This also does a bit of housekeeping work throughout it in the process. There should be essentially no functional changes. 2019-07-22 Eric Botcazou gcc/ada/ * checks.adb (Apply_Type_Conversion_Checks): Do not set Do_Range_Check flag on conversions from fixed-point types either. * exp_attr.adb: Add use and with clause for Expander. (Expand_N_Attribute_Reference) : Set the Conversion_OK flag and do not generate overflow/range checks manually. * exp_ch4.adb (Expand_N_Qualified_Expression): Remove superfluous clearing of Do_Range_Check flag. (Discrete_Range_Check): New procedure to generate a range check for discrete types. (Real_Range_Check): Remove redundant local variable and adjust. Remove useless shortcut. Clear Do_Range_Check flag on all paths. (Expand_N_Type_Conversion): Remove redundant test on Conversion_OK. Call Discrete_Range_Check to generate range checks on discrete types. Remove obsolete code for float-to-integer conversions. Add code to generate range checks for conversions involving fixed-point types. From-SVN: r273692 --- gcc/ada/ChangeLog | 22 ++++ gcc/ada/checks.adb | 5 +- gcc/ada/exp_attr.adb | 74 +++---------- gcc/ada/exp_ch4.adb | 251 ++++++++++++++++++------------------------- 4 files changed, 142 insertions(+), 210 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3706cd739e6..8bb8d34f305 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2019-07-22 Eric Botcazou + + * checks.adb (Apply_Type_Conversion_Checks): Do not set + Do_Range_Check flag on conversions from fixed-point types + either. + * exp_attr.adb: Add use and with clause for Expander. + (Expand_N_Attribute_Reference) : Set + the Conversion_OK flag and do not generate overflow/range checks + manually. + * exp_ch4.adb (Expand_N_Qualified_Expression): Remove + superfluous clearing of Do_Range_Check flag. + (Discrete_Range_Check): New procedure to generate a range check + for discrete types. + (Real_Range_Check): Remove redundant local variable and adjust. + Remove useless shortcut. Clear Do_Range_Check flag on all + paths. + (Expand_N_Type_Conversion): Remove redundant test on + Conversion_OK. Call Discrete_Range_Check to generate range + checks on discrete types. Remove obsolete code for + float-to-integer conversions. Add code to generate range checks + for conversions involving fixed-point types. + 2019-07-22 Eric Botcazou * sprint.ads: Fix pasto in comment. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 73f7edc08a9..e1f7f9a5085 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -3622,13 +3622,14 @@ package body Checks is -- will not be generated. if GNATprove_Mode - or else not Is_Fixed_Point_Type (Expr_Type) + or else (not Is_Fixed_Point_Type (Expr_Type) + and then not Is_Fixed_Point_Type (Target_Type)) then Apply_Scalar_Range_Check (Expr, Target_Type, Fixed_Int => Conv_OK); else - Set_Do_Range_Check (Expression (N), False); + Set_Do_Range_Check (Expr, False); end if; -- If the target type has predicates, we need to indicate diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 60102a9d8ac..9d6da3348dc 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -39,6 +39,7 @@ with Exp_Pakd; use Exp_Pakd; with Exp_Strm; use Exp_Strm; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; +with Expander; use Expander; with Freeze; use Freeze; with Gnatvsn; use Gnatvsn; with Itypes; use Itypes; @@ -3540,7 +3541,7 @@ package body Exp_Attr is -- We transform -- fixtype'Fixed_Value (integer-value) - -- inttype'Fixed_Value (fixed-value) + -- inttype'Integer_Value (fixed-value) -- into @@ -3549,75 +3550,30 @@ package body Exp_Attr is -- respectively. - -- We do all the required analysis of the conversion here, because we do - -- not want this to go through the fixed-point conversion circuits. Note - -- that the back end always treats fixed-point as equivalent to the - -- corresponding integer type anyway. - -- However, in order to remove the handling of Do_Range_Check from the - -- backend, we force the generation of a check on the result by - -- setting the result type appropriately. Apply_Conversion_Checks - -- will generate the required expansion. + -- We set Conversion_OK on the conversion because we do not want it + -- to go through the fixed-point conversion circuits. when Attribute_Fixed_Value | Attribute_Integer_Value => - Rewrite (N, - Make_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc), - Expression => Relocate_Node (First (Exprs)))); + Rewrite (N, OK_Convert_To (Entity (Pref), First (Exprs))); - -- Indicate that the result of the conversion may require a - -- range check (see below); - - Set_Etype (N, Base_Type (Entity (Pref))); - Set_Analyzed (N); - - -- Note: it might appear that a properly analyzed unchecked + -- Note that it might appear that a properly analyzed unchecked -- conversion would be just fine here, but that's not the case, - -- since the full range checks performed by the following code + -- since the full range checks performed by the following calls -- are critical. - -- Given that Fixed-point conversions are not further expanded - -- to prevent the involvement of real type operations we have to - -- construct two checks explicitly: one on the operand, and one - -- on the result. This used to be done in part in the back-end, - -- but for other targets (E.g. LLVM) it is preferable to create - -- the tests in full in the front-end. - - if Is_Fixed_Point_Type (Etype (N)) then - declare - Loc : constant Source_Ptr := Sloc (N); - Equiv_T : constant Entity_Id := Make_Temporary (Loc, 'T', N); - Expr : constant Node_Id := Expression (N); - Fst : constant Entity_Id := Root_Type (Etype (N)); - Decl : Node_Id; - begin - Decl := - Make_Full_Type_Declaration (Sloc (N), - Defining_Identifier => Equiv_T, - Type_Definition => - Make_Signed_Integer_Type_Definition (Loc, - Low_Bound => - Make_Integer_Literal (Loc, - Intval => - Corresponding_Integer_Value - (Type_Low_Bound (Fst))), - High_Bound => - Make_Integer_Literal (Loc, - Intval => - Corresponding_Integer_Value - (Type_High_Bound (Fst))))); - Insert_Action (N, Decl); - - -- Verify that the conversion is possible + Apply_Type_Conversion_Checks (N); - Generate_Range_Check (Expr, Equiv_T, CE_Overflow_Check_Failed); + -- Note that Apply_Type_Conversion_Checks only deals with the + -- overflow checks on conversions involving fixed-point types + -- so we must apply range checks manually on them and expand. - -- and verify that the result is in range + Apply_Scalar_Range_Check + (Expression (N), Etype (N), Fixed_Int => True); - Generate_Range_Check (N, Etype (N), CE_Range_Check_Failed); - end; - end if; + Set_Analyzed (N); + Expand (N); ----------- -- Floor -- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 117d6d67528..a062434018a 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10274,7 +10274,6 @@ package body Exp_Ch4 is Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True); if Do_Range_Check (Operand) then - Set_Do_Range_Check (Operand, False); Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed); end if; end Expand_N_Qualified_Expression; @@ -10929,9 +10928,12 @@ package body Exp_Ch4 is procedure Expand_N_Type_Conversion (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Operand : constant Node_Id := Expression (N); - Target_Type : constant Entity_Id := Etype (N); + Target_Type : Entity_Id := Etype (N); Operand_Type : Entity_Id := Etype (Operand); + procedure Discrete_Range_Check; + -- Handles generation of range check for discrete target value + procedure Handle_Changed_Representation; -- This is called in the case of record and array type conversions to -- see if there is a change of representation to be handled. Change of @@ -10954,6 +10956,44 @@ package body Exp_Ch4 is -- True iff Present (Effective_Extra_Accessibility (Id)) successfully -- evaluates to True. + -------------------------- + -- Discrete_Range_Check -- + -------------------------- + + -- Case of conversions to a discrete type + + procedure Discrete_Range_Check is + Expr : Node_Id; + Ityp : Entity_Id; + + begin + -- Nothing to do if conversion was rewritten + + if Nkind (N) /= N_Type_Conversion then + return; + end if; + + Expr := Expression (N); + + -- Before we do a range check, we have to deal with treating + -- a fixed-point operand as an integer. The way we do this + -- is simply to do an unchecked conversion to an appropriate + -- integer type large enough to hold the result. + + if Is_Fixed_Point_Type (Etype (Expr)) then + if Esize (Base_Type (Etype (Expr))) > Esize (Standard_Integer) then + Ityp := Standard_Long_Long_Integer; + else + Ityp := Standard_Integer; + end if; + + Set_Do_Range_Check (Expr, False); + Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr)); + end if; + + Generate_Range_Check (Expr, Target_Type, CE_Range_Check_Failed); + end Discrete_Range_Check; + ----------------------------------- -- Handle_Changed_Representation -- ----------------------------------- @@ -11169,7 +11209,6 @@ package body Exp_Ch4 is Btyp : constant Entity_Id := Base_Type (Target_Type); Lo : constant Node_Id := Type_Low_Bound (Target_Type); Hi : constant Node_Id := Type_High_Bound (Target_Type); - Xtyp : constant Entity_Id := Etype (Operand); Conv : Node_Id; Hi_Arg : Node_Id; @@ -11193,6 +11232,12 @@ package body Exp_Ch4 is and then Hi = Type_High_Bound (Btyp)) then + -- Unset the range check flag on the current value of + -- Expression (N), since the captured Operand may have + -- been rewritten (such as for the case of a conversion + -- to a fixed-point type). + + Set_Do_Range_Check (Expression (N), False); return; end if; @@ -11202,6 +11247,7 @@ package body Exp_Ch4 is if Is_Entity_Name (Operand) and then Range_Checks_Suppressed (Entity (Operand)) then + Set_Do_Range_Check (Expression (N), False); return; end if; @@ -11211,12 +11257,12 @@ package body Exp_Ch4 is -- not trust it to be in range (might be infinite) declare - S_Lo : constant Node_Id := Type_Low_Bound (Xtyp); - S_Hi : constant Node_Id := Type_High_Bound (Xtyp); + S_Lo : constant Node_Id := Type_Low_Bound (Operand_Type); + S_Hi : constant Node_Id := Type_High_Bound (Operand_Type); begin - if (not Is_Floating_Point_Type (Xtyp) - or else Is_Constrained (Xtyp)) + if (not Is_Floating_Point_Type (Operand_Type) + or else Is_Constrained (Operand_Type)) and then Compile_Time_Known_Value (S_Lo) and then Compile_Time_Known_Value (S_Hi) and then Compile_Time_Known_Value (Hi) @@ -11229,7 +11275,7 @@ package body Exp_Ch4 is S_Hiv : Ureal; begin - if Is_Real_Type (Xtyp) then + if Is_Real_Type (Operand_Type) then S_Lov := Expr_Value_R (S_Lo); S_Hiv := Expr_Value_R (S_Hi); else @@ -11241,30 +11287,17 @@ package body Exp_Ch4 is and then S_Lov >= D_Lov and then S_Hiv <= D_Hiv then - -- Unset the range check flag on the current value of - -- Expression (N), since the captured Operand may have - -- been rewritten (such as for the case of a conversion - -- to a fixed-point type). - Set_Do_Range_Check (Expression (N), False); - return; end if; end; end if; end; - -- For float to float conversions, we are done - - if Is_Floating_Point_Type (Xtyp) - and then - Is_Floating_Point_Type (Btyp) - then - return; - end if; - -- Otherwise rewrite the conversion as described above + Set_Do_Range_Check (Expression (N), False); + Conv := Relocate_Node (N); Rewrite (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc)); Set_Etype (Conv, Btyp); @@ -11273,7 +11306,7 @@ package body Exp_Ch4 is -- where it is never required, since we can never have overflow in -- this case. - if not Is_Integer_Type (Etype (Operand)) then + if not Is_Integer_Type (Operand_Type) then Enable_Overflow_Check (Conv); end if; @@ -11895,31 +11928,21 @@ package body Exp_Ch4 is then Set_Rounded_Result (N); Set_Etype (N, Etype (Parent (N))); + Target_Type := Etype (N); end if; - -- Otherwise do correct fixed-conversion, but skip these if the - -- Conversion_OK flag is set, because from a semantic point of view - -- these are simple integer conversions needing no further processing - -- (the backend will simply treat them as integers). - - if not Conversion_OK (N) then - if Is_Fixed_Point_Type (Etype (N)) then - Expand_Convert_Fixed_To_Fixed (N); - Real_Range_Check; - - elsif Is_Integer_Type (Etype (N)) then - Expand_Convert_Fixed_To_Integer (N); - - -- The result of the conversion might need a range check, so do - -- not assume that the result is in bounds. + if Is_Fixed_Point_Type (Target_Type) then + Expand_Convert_Fixed_To_Fixed (N); + Real_Range_Check; - Set_Etype (N, Base_Type (Target_Type)); + elsif Is_Integer_Type (Target_Type) then + Expand_Convert_Fixed_To_Integer (N); + Discrete_Range_Check; - else - pragma Assert (Is_Floating_Point_Type (Etype (N))); - Expand_Convert_Fixed_To_Float (N); - Real_Range_Check; - end if; + else + pragma Assert (Is_Floating_Point_Type (Target_Type)); + Expand_Convert_Fixed_To_Float (N); + Real_Range_Check; end if; -- Case of conversions to a fixed-point type @@ -11941,42 +11964,6 @@ package body Exp_Ch4 is Real_Range_Check; end if; - -- Case of float-to-integer conversions - - -- We also handle float-to-fixed conversions with Conversion_OK set - -- since semantically the fixed-point target is treated as though it - -- were an integer in such cases. - - elsif Is_Floating_Point_Type (Operand_Type) - and then - (Is_Integer_Type (Target_Type) - or else - (Is_Fixed_Point_Type (Target_Type) and then Conversion_OK (N))) - then - -- One more check here, gcc is still not able to do conversions of - -- this type with proper overflow checking, and so gigi is doing an - -- approximation of what is required by doing floating-point compares - -- with the end-point. But that can lose precision in some cases, and - -- give a wrong result. Converting the operand to Universal_Real is - -- helpful, but still does not catch all cases with 64-bit integers - -- on targets with only 64-bit floats. - - -- The above comment seems obsoleted by Apply_Float_Conversion_Check - -- Can this code be removed ??? - - if Do_Range_Check (Operand) then - Rewrite (Operand, - Make_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of (Universal_Real, Loc), - Expression => - Relocate_Node (Operand))); - - Set_Etype (Operand, Universal_Real); - Enable_Range_Check (Operand); - Set_Do_Range_Check (Expression (Operand), False); - end if; - -- Case of array conversions -- Expansion of array conversions, add required length/range checks but @@ -12059,11 +12046,6 @@ package body Exp_Ch4 is Analyze_And_Resolve (N, Target_Type); end if; - - -- Case of conversions to floating-point - - elsif Is_Floating_Point_Type (Target_Type) then - Real_Range_Check; end if; -- At this stage, either the conversion node has been transformed into @@ -12081,80 +12063,51 @@ package body Exp_Ch4 is -- Check: are these rules stated in sinfo??? if so, why restate here??? -- The only remaining step is to generate a range check if we still have - -- a type conversion at this stage and Do_Range_Check is set. For now we - -- do this only for conversions of discrete types and for float-to-float - -- conversions. - - if Nkind (N) = N_Type_Conversion then + -- a type conversion at this stage and Do_Range_Check is set. - -- For now we only support floating-point cases where both source - -- and target are floating-point types. Conversions where the source - -- and target involve integer or fixed-point types are still TBD, - -- though not clear whether those can even happen at this point, due - -- to transformations above. ??? + if Nkind (N) = N_Type_Conversion + and then Do_Range_Check (Expression (N)) + then + -- Float-to-float conversions - if Is_Floating_Point_Type (Etype (N)) + if Is_Floating_Point_Type (Target_Type) and then Is_Floating_Point_Type (Etype (Expression (N))) then - if Do_Range_Check (Expression (N)) - and then Is_Floating_Point_Type (Target_Type) - then - Generate_Range_Check - (Expression (N), Target_Type, CE_Range_Check_Failed); - end if; - - -- Discrete-to-discrete conversions + Generate_Range_Check + (Expression (N), Target_Type, CE_Range_Check_Failed); - elsif Is_Discrete_Type (Etype (N)) then - declare - Expr : constant Node_Id := Expression (N); - Ftyp : Entity_Id; - Ityp : Entity_Id; + -- Discrete-to-discrete conversions or fixed-point-to-discrete + -- conversions when Conversion_OK is set. - begin - if Do_Range_Check (Expr) - and then Is_Discrete_Type (Etype (Expr)) - then - Set_Do_Range_Check (Expr, False); - - -- Before we do a range check, we have to deal with treating - -- a fixed-point operand as an integer. The way we do this - -- is simply to do an unchecked conversion to an appropriate - -- integer type large enough to hold the result. - - -- This code is not active yet, because we are only dealing - -- with discrete types so far ??? - - if Nkind (Expr) in N_Has_Treat_Fixed_As_Integer - and then Treat_Fixed_As_Integer (Expr) - then - Ftyp := Base_Type (Etype (Expr)); + elsif Is_Discrete_Type (Target_Type) + and then (Is_Discrete_Type (Etype (Expression (N))) + or else (Is_Fixed_Point_Type (Etype (Expression (N))) + and then Conversion_OK (N))) + then + -- Reset overflow flag, since the range check will include + -- dealing with possible overflow, and generate the check. - if Esize (Ftyp) >= Esize (Standard_Integer) then - Ityp := Standard_Long_Long_Integer; - else - Ityp := Standard_Integer; - end if; + Set_Do_Overflow_Check (N, False); - Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr)); - end if; + -- If Address is either a source type or target type, + -- suppress range check to avoid typing anomalies when + -- it is a visible integer type. - -- Reset overflow flag, since the range check will include - -- dealing with possible overflow, and generate the check. - -- If Address is either a source type or target type, - -- suppress range check to avoid typing anomalies when - -- it is a visible integer type. + if Is_Descendant_Of_Address (Etype (Expression (N))) + or else Is_Descendant_Of_Address (Target_Type) + then + Set_Do_Range_Check (Expression (N), False); + else + Discrete_Range_Check; + end if; - Set_Do_Overflow_Check (N, False); + -- Conversions to floating- or fixed-point when Conversion_OK is set - if not Is_Descendant_Of_Address (Etype (Expr)) - and then not Is_Descendant_Of_Address (Target_Type) - then - Generate_Range_Check - (Expr, Target_Type, CE_Range_Check_Failed); - end if; - end if; - end; + elsif Is_Floating_Point_Type (Target_Type) + or else (Is_Fixed_Point_Type (Target_Type) + and then Conversion_OK (N)) + then + Real_Range_Check; end if; end if; -- 2.30.2