git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

exp_util.ads, [...] (Force_Evaluation): Add Related_Id and Is_Low/High_Bound params. 

2015-03-13  Robert Dewar  <dewar@adacore.com>

	* 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
This commit is contained in:
Robert Dewar 2015-03-13 13:18:39 +00:00 committed by Arnaud Charlet
parent e83a01c383
commit 28c7180f1c
4 changed files with 53 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -1,3 +1,10 @@
2015-03-13 Robert Dewar <dewar@adacore.com>
* 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 <hainque@adacore.com> 2015-03-12 Olivier Hainque <hainque@adacore.com>
* gcc-interface/trans.c (Attribute_to_gnu) <Code_Address case>: * gcc-interface/trans.c (Attribute_to_gnu) <Code_Address case>:

17
gcc/ada/exp_util.adb
View File

@ -2996,9 +2996,22 @@ package body Exp_Util is
-- Force_Evaluation -- -- 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 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; end Force_Evaluation;
--------------------------------- ---------------------------------

17
gcc/ada/exp_util.ads
View File

@ -520,15 +520,26 @@ package Exp_Util is
-- like a potential bug ??? -- like a potential bug ???
procedure Force_Evaluation procedure Force_Evaluation
(Exp : Node_Id; (Exp : Node_Id;
Name_Req : Boolean := False); 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 -- Force the evaluation of the expression right away. Similar behavior
-- to Remove_Side_Effects when Variable_Ref is set to TRUE. That is to -- 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 -- variables. Remove_Side_Effects guarantees that multiple evaluations
-- of the same expression won't generate multiple side effects, whereas -- of the same expression won't generate multiple side effects, whereas
-- Force_Evaluation further guarantees that all evaluations will yield -- Force_Evaluation further guarantees that all evaluations will yield
-- the same result. -- 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 function Fully_Qualified_Name_String
(E : Entity_Id; (E : Entity_Id;

93
gcc/ada/sem_ch3.adb
View File

@ -8053,9 +8053,9 @@ package body Sem_Ch3 is
while Present (C) loop while Present (C) loop
Expr := Node (C); Expr := Node (C);
-- It is safe here to call New_Copy_Tree since -- It is safe here to call New_Copy_Tree since we called
-- Force_Evaluation was called on each constraint in -- Force_Evaluation on each constraint previously
-- Build_Discriminant_Constraints. -- in Build_Discriminant_Constraints.
Append (New_Copy_Tree (Expr), To => Constr_List); 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. -- supposed to occur, e.g. on default parameters of a call.
if Expander_Active or GNATprove_Mode then if Expander_Active or GNATprove_Mode then
Force_Evaluation (Low_Bound (R)); Force_Evaluation
Force_Evaluation (High_Bound (R)); (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; end if;
elsif Nkind (S) = N_Discriminant_Association then elsif Nkind (S) = N_Discriminant_Association then
@ -20171,80 +20173,19 @@ package body Sem_Ch3 is
if Expander_Active or GNATprove_Mode then if Expander_Active or GNATprove_Mode then
-- If no subtype name, then just call Force_Evaluation to -- Call Force_Evaluation to create declarations as needed to
-- create declarations as needed to deal with side effects. -- deal with side effects, and also create typ_FIRST/LAST
-- Also ignore calls from within a record type, where we -- entities for bounds if we have a subtype name.
-- 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.
-- Note: we do this transformation even if expansion is not -- Note: we do this transformation even if expansion is not
-- active, and in particular we do it in GNATprove_Mode since -- active if we are in GNATprove_Mode since the transformation
-- the transformation is in general required to ensure that the -- is in general required to ensure that the resulting tree has
-- resulting tree has proper Ada semantics. -- proper Ada semantics.
-- Historical note: We used to just do Force_Evaluation calls Force_Evaluation
-- in all cases, but it is better to capture the bounds with (Lo, Related_Id => Subtyp, Is_Low_Bound => True);
-- proper non-serialized names, since these will be accessed Force_Evaluation
-- from other units, and hence may be public, and also we can (Hi, Related_Id => Subtyp, Is_High_Bound => True);
-- 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;
end if; end if;
-- We use a flag here instead of suppressing checks on the -- We use a flag here instead of suppressing checks on the