Skip to content

R
riscv-gcc-1
Commit 28c7180f by Robert Dewar Committed by Arnaud Charlet
Options

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
parent e83a01c3
Showing with 54 additions and 82 deletions
gcc/ada/ChangeLog
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>
* gcc-interface/trans.c (Attribute_to_gnu) <Code_Address case>:
......
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;
---------------------------------
......
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;
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment