From 28c7180f1ce824f720bfd80895c03c5a46269497 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 13 Mar 2015 13:18:39 +0000 Subject: [PATCH] exp_util.ads, [...] (Force_Evaluation): Add Related_Id and Is_Low/High_Bound params. 2015-03-13 Robert Dewar * exp_util.ads, exp_util.adb (Force_Evaluation): Add Related_Id and Is_Low/High_Bound params. * sem_ch3.adb (Constrain_Index): Use new Force_Evaluation calling sequence to simplify generation of FIRST/LAST temps for bounds. From-SVN: r221418 --- gcc/ada/ChangeLog | 7 ++++ gcc/ada/exp_util.adb | 17 +++++++- gcc/ada/exp_util.ads | 17 ++++++-- gcc/ada/sem_ch3.adb | 95 +++++++++----------------------------------- 4 files changed, 54 insertions(+), 82 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 750d48c0e97..d9b7325dc5e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2015-03-13 Robert Dewar + + * exp_util.ads, exp_util.adb (Force_Evaluation): Add Related_Id and + Is_Low/High_Bound params. + * sem_ch3.adb (Constrain_Index): Use new Force_Evaluation calling + sequence to simplify generation of FIRST/LAST temps for bounds. + 2015-03-12 Olivier Hainque * gcc-interface/trans.c (Attribute_to_gnu) : diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index a565e7f023b..bc58efebbd5 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2996,9 +2996,22 @@ package body Exp_Util is -- Force_Evaluation -- ---------------------- - procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False) is + procedure Force_Evaluation + (Exp : Node_Id; + Name_Req : Boolean := False; + Related_Id : Entity_Id := Empty; + Is_Low_Bound : Boolean := False; + Is_High_Bound : Boolean := False) + is begin - Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True); + Remove_Side_Effects + (Exp => Exp, + Name_Req => Name_Req, + Variable_Ref => True, + Renaming_Req => False, + Related_Id => Related_Id, + Is_Low_Bound => Is_Low_Bound, + Is_High_Bound => Is_High_Bound); end Force_Evaluation; --------------------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index b8c54fa5966..1e5aec1584d 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -520,15 +520,26 @@ package Exp_Util is -- like a potential bug ??? procedure Force_Evaluation - (Exp : Node_Id; - Name_Req : Boolean := False); + (Exp : Node_Id; + Name_Req : Boolean := False; + Related_Id : Entity_Id := Empty; + Is_Low_Bound : Boolean := False; + Is_High_Bound : Boolean := False); -- Force the evaluation of the expression right away. Similar behavior -- to Remove_Side_Effects when Variable_Ref is set to TRUE. That is to - -- say, it removes the side-effects and captures the values of the + -- say, it removes the side effects and captures the values of the -- variables. Remove_Side_Effects guarantees that multiple evaluations -- of the same expression won't generate multiple side effects, whereas -- Force_Evaluation further guarantees that all evaluations will yield -- the same result. + -- + -- Related_Id denotes the entity of the context where Expr appears. Flags + -- Is_Low_Bound and Is_High_Bound specify whether the expression to check + -- is the low or the high bound of a range. These three optional arguments + -- signal Remove_Side_Effects to create an external symbol of the form + -- Chars (Related_Id)_FIRST/_LAST. If Related_Id is set, then exactly one + -- of the Is_xxx_Bound flags must be set. For use of these parameters see + -- the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. function Fully_Qualified_Name_String (E : Entity_Id; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 681e47cfd89..3ec9ab523aa 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8053,9 +8053,9 @@ package body Sem_Ch3 is while Present (C) loop Expr := Node (C); - -- It is safe here to call New_Copy_Tree since - -- Force_Evaluation was called on each constraint in - -- Build_Discriminant_Constraints. + -- It is safe here to call New_Copy_Tree since we called + -- Force_Evaluation on each constraint previously + -- in Build_Discriminant_Constraints. Append (New_Copy_Tree (Expr), To => Constr_List); @@ -13220,8 +13220,10 @@ package body Sem_Ch3 is -- supposed to occur, e.g. on default parameters of a call. if Expander_Active or GNATprove_Mode then - Force_Evaluation (Low_Bound (R)); - Force_Evaluation (High_Bound (R)); + Force_Evaluation + (Low_Bound (R), Related_Id => Related_Id, Is_Low_Bound => True); + Force_Evaluation + (High_Bound (R), Related_Id => Related_Id, Is_Low_Bound => True); end if; elsif Nkind (S) = N_Discriminant_Association then @@ -20171,80 +20173,19 @@ package body Sem_Ch3 is if Expander_Active or GNATprove_Mode then - -- If no subtype name, then just call Force_Evaluation to - -- create declarations as needed to deal with side effects. - -- Also ignore calls from within a record type, where we - -- have possible scoping issues. - - if No (Subtyp) or else Is_Record_Type (Current_Scope) then - Force_Evaluation (Lo); - Force_Evaluation (Hi); - - -- If a subtype is given, then we capture the bounds if they - -- are not known at compile time, using constant identifiers - -- xxx_FIRST and xxx_LAST where xxx is the name of the subtype. + -- Call Force_Evaluation to create declarations as needed to + -- deal with side effects, and also create typ_FIRST/LAST + -- entities for bounds if we have a subtype name. -- Note: we do this transformation even if expansion is not - -- active, and in particular we do it in GNATprove_Mode since - -- the transformation is in general required to ensure that the - -- resulting tree has proper Ada semantics. - - -- Historical note: We used to just do Force_Evaluation calls - -- in all cases, but it is better to capture the bounds with - -- proper non-serialized names, since these will be accessed - -- from other units, and hence may be public, and also we can - -- then expand 'First and 'Last references to be references to - -- these special names. - - else - if not Compile_Time_Known_Value (Lo) - - -- No need to capture bounds if they already are - -- references to constants. - - and then not (Is_Entity_Name (Lo) - and then Is_Constant_Object (Entity (Lo))) - then - declare - Loc : constant Source_Ptr := Sloc (Lo); - Lov : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => - New_External_Name (Chars (Subtyp), "_FIRST")); - begin - Insert_Action (R, - Make_Object_Declaration (Loc, - Defining_Identifier => Lov, - Object_Definition => - New_Occurrence_Of (Base_Type (T), Loc), - Constant_Present => True, - Expression => Relocate_Node (Lo))); - Rewrite (Lo, New_Occurrence_Of (Lov, Loc)); - end; - end if; - - if not Compile_Time_Known_Value (Hi) - and then not (Is_Entity_Name (Hi) - and then Is_Constant_Object (Entity (Hi))) - then - declare - Loc : constant Source_Ptr := Sloc (Hi); - Hiv : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => - New_External_Name (Chars (Subtyp), "_LAST")); - begin - Insert_Action (R, - Make_Object_Declaration (Loc, - Defining_Identifier => Hiv, - Object_Definition => - New_Occurrence_Of (Base_Type (T), Loc), - Constant_Present => True, - Expression => Relocate_Node (Hi))); - Rewrite (Hi, New_Occurrence_Of (Hiv, Loc)); - end; - end if; - end if; + -- active if we are in GNATprove_Mode since the transformation + -- is in general required to ensure that the resulting tree has + -- proper Ada semantics. + + Force_Evaluation + (Lo, Related_Id => Subtyp, Is_Low_Bound => True); + Force_Evaluation + (Hi, Related_Id => Subtyp, Is_High_Bound => True); end if; -- We use a flag here instead of suppressing checks on the -- 2.30.2