Commit a4941eec by Ed Schonberg Committed by Arnaud Charlet

einfo.ads, einfo.adb: New attribute Related_Expression...

2009-07-09  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb: New attribute Related_Expression, used to link
	a temporary to the source expression whose value it captures.

	* exp_util.adb (Remove_Side_Effects): Set Related_Expression as needed.

From-SVN: r149406
parent 4b41f35e
2009-07-09 Ed Schonberg <schonberg@adacore.com>
* einfo.ads, einfo.adb: New attribute Related_Expression, used to link
a temporary to the source expression whose value it captures.
* exp_util.adb (Remove_Side_Effects): Set Related_Expression as needed.
2009-07-07 Manuel López-Ibáñez <manu@gcc.gnu.org> 2009-07-07 Manuel López-Ibáñez <manu@gcc.gnu.org>
* gcc-interface/trans.c (gnat_gimplify_expr): Replace EXPR_LOCUS by * gcc-interface/trans.c (gnat_gimplify_expr): Replace EXPR_LOCUS by
......
...@@ -205,6 +205,7 @@ package body Einfo is ...@@ -205,6 +205,7 @@ package body Einfo is
-- Protection_Object Node23 -- Protection_Object Node23
-- Stored_Constraint Elist23 -- Stored_Constraint Elist23
-- Related_Expression Node24
-- Spec_PPC_List Node24 -- Spec_PPC_List Node24
-- Underlying_Record_View Node24 -- Underlying_Record_View Node24
...@@ -2463,6 +2464,12 @@ package body Einfo is ...@@ -2463,6 +2464,12 @@ package body Einfo is
return Node19 (Id); return Node19 (Id);
end Related_Array_Object; end Related_Array_Object;
function Related_Expression (Id : E) return N is
begin
pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
return Node24 (Id);
end Related_Expression;
function Related_Instance (Id : E) return E is function Related_Instance (Id : E) return E is
begin begin
pragma Assert pragma Assert
...@@ -4955,6 +4962,11 @@ package body Einfo is ...@@ -4955,6 +4962,11 @@ package body Einfo is
Set_Node19 (Id, V); Set_Node19 (Id, V);
end Set_Related_Array_Object; end Set_Related_Array_Object;
procedure Set_Related_Expression (Id : E; V : N) is
begin
Set_Node24 (Id, V);
end Set_Related_Expression;
procedure Set_Related_Instance (Id : E; V : E) is procedure Set_Related_Instance (Id : E; V : E) is
begin begin
pragma Assert pragma Assert
...@@ -7948,6 +7960,9 @@ package body Einfo is ...@@ -7948,6 +7960,9 @@ package body Einfo is
when E_Record_Type => when E_Record_Type =>
Write_Str ("Underlying record view"); Write_Str ("Underlying record view");
when E_Variable | E_Constant =>
Write_Str ("Related expression");
when others => when others =>
Write_Str ("???"); Write_Str ("???");
end case; end case;
......
...@@ -3226,6 +3226,11 @@ package Einfo is ...@@ -3226,6 +3226,11 @@ package Einfo is
-- to the entity of the corresponding array object. Currently used -- to the entity of the corresponding array object. Currently used
-- only for type-related error messages. -- only for type-related error messages.
-- Related_Expression (Node24)
-- Present in variables generated internally. Denotes the source
-- expression whose elaboration created the variable declaration.
-- Used for clearer messages from CodePeer.
-- Related_Instance (Node15) -- Related_Instance (Node15)
-- Present in the wrapper packages created for subprogram instances. -- Present in the wrapper packages created for subprogram instances.
-- The internal subprogram that implements the instance is inside the -- The internal subprogram that implements the instance is inside the
...@@ -5396,6 +5401,7 @@ package Einfo is ...@@ -5396,6 +5401,7 @@ package Einfo is
-- Interface_Name (Node21) -- Interface_Name (Node21)
-- Shared_Var_Procs_Instance (Node22) -- Shared_Var_Procs_Instance (Node22)
-- Extra_Constrained (Node23) -- Extra_Constrained (Node23)
-- Related_Expression (Node24)
-- Debug_Renaming_Link (Node25) -- Debug_Renaming_Link (Node25)
-- Last_Assignment (Node26) -- Last_Assignment (Node26)
-- Has_Alignment_Clause (Flag46) -- Has_Alignment_Clause (Flag46)
...@@ -5970,6 +5976,7 @@ package Einfo is ...@@ -5970,6 +5976,7 @@ package Einfo is
function Referenced_Object (Id : E) return N; function Referenced_Object (Id : E) return N;
function Register_Exception_Call (Id : E) return N; function Register_Exception_Call (Id : E) return N;
function Related_Array_Object (Id : E) return E; function Related_Array_Object (Id : E) return E;
function Related_Expression (Id : E) return N;
function Related_Instance (Id : E) return E; function Related_Instance (Id : E) return E;
function Related_Type (Id : E) return E; function Related_Type (Id : E) return E;
function Relative_Deadline_Variable (Id : E) return E; function Relative_Deadline_Variable (Id : E) return E;
...@@ -6524,6 +6531,7 @@ package Einfo is ...@@ -6524,6 +6531,7 @@ package Einfo is
procedure Set_Referenced_Object (Id : E; V : N); procedure Set_Referenced_Object (Id : E; V : N);
procedure Set_Register_Exception_Call (Id : E; V : N); procedure Set_Register_Exception_Call (Id : E; V : N);
procedure Set_Related_Array_Object (Id : E; V : E); procedure Set_Related_Array_Object (Id : E; V : E);
procedure Set_Related_Expression (Id : E; V : N);
procedure Set_Related_Instance (Id : E; V : E); procedure Set_Related_Instance (Id : E; V : E);
procedure Set_Related_Type (Id : E; V : E); procedure Set_Related_Type (Id : E; V : E);
procedure Set_Relative_Deadline_Variable (Id : E; V : E); procedure Set_Relative_Deadline_Variable (Id : E; V : E);
...@@ -7219,6 +7227,7 @@ package Einfo is ...@@ -7219,6 +7227,7 @@ package Einfo is
pragma Inline (Referenced_Object); pragma Inline (Referenced_Object);
pragma Inline (Register_Exception_Call); pragma Inline (Register_Exception_Call);
pragma Inline (Related_Array_Object); pragma Inline (Related_Array_Object);
pragma Inline (Related_Expression);
pragma Inline (Related_Instance); pragma Inline (Related_Instance);
pragma Inline (Related_Type); pragma Inline (Related_Type);
pragma Inline (Relative_Deadline_Variable); pragma Inline (Relative_Deadline_Variable);
...@@ -7607,6 +7616,7 @@ package Einfo is ...@@ -7607,6 +7616,7 @@ package Einfo is
pragma Inline (Set_Referenced_Object); pragma Inline (Set_Referenced_Object);
pragma Inline (Set_Register_Exception_Call); pragma Inline (Set_Register_Exception_Call);
pragma Inline (Set_Related_Array_Object); pragma Inline (Set_Related_Array_Object);
pragma Inline (Set_Related_Expression);
pragma Inline (Set_Related_Instance); pragma Inline (Set_Related_Instance);
pragma Inline (Set_Related_Type); pragma Inline (Set_Related_Type);
pragma Inline (Set_Renamed_Entity); pragma Inline (Set_Renamed_Entity);
......
...@@ -4595,6 +4595,7 @@ package body Exp_Util is ...@@ -4595,6 +4595,7 @@ package body Exp_Util is
Set_Assignment_OK (E); Set_Assignment_OK (E);
Insert_Action (Exp, E); Insert_Action (Exp, E);
Set_Related_Expression (Def_Id, Exp);
-- If the expression has the form v.all then we can just capture -- If the expression has the form v.all then we can just capture
-- the pointer, and then do an explicit dereference on the result. -- the pointer, and then do an explicit dereference on the result.
...@@ -4612,6 +4613,7 @@ package body Exp_Util is ...@@ -4612,6 +4613,7 @@ package body Exp_Util is
New_Reference_To (Etype (Prefix (Exp)), Loc), New_Reference_To (Etype (Prefix (Exp)), Loc),
Constant_Present => True, Constant_Present => True,
Expression => Relocate_Node (Prefix (Exp)))); Expression => Relocate_Node (Prefix (Exp))));
Set_Related_Expression (Def_Id, Exp);
-- Similar processing for an unchecked conversion of an expression -- Similar processing for an unchecked conversion of an expression
-- of the form v.all, where we want the same kind of treatment. -- of the form v.all, where we want the same kind of treatment.
...@@ -4653,6 +4655,7 @@ package body Exp_Util is ...@@ -4653,6 +4655,7 @@ package body Exp_Util is
Defining_Identifier => Def_Id, Defining_Identifier => Def_Id,
Subtype_Mark => New_Reference_To (Exp_Type, Loc), Subtype_Mark => New_Reference_To (Exp_Type, Loc),
Name => Relocate_Node (Exp))); Name => Relocate_Node (Exp)));
Set_Related_Expression (Def_Id, Exp);
else else
Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
...@@ -4668,6 +4671,7 @@ package body Exp_Util is ...@@ -4668,6 +4671,7 @@ package body Exp_Util is
Set_Assignment_OK (E); Set_Assignment_OK (E);
Insert_Action (Exp, E); Insert_Action (Exp, E);
Set_Related_Expression (Def_Id, Exp);
end if; end if;
-- For expressions that denote objects, we can use a renaming scheme. -- For expressions that denote objects, we can use a renaming scheme.
...@@ -4709,9 +4713,10 @@ package body Exp_Util is ...@@ -4709,9 +4713,10 @@ package body Exp_Util is
Defining_Identifier => Def_Id, Defining_Identifier => Def_Id,
Subtype_Mark => New_Reference_To (Exp_Type, Loc), Subtype_Mark => New_Reference_To (Exp_Type, Loc),
Name => Relocate_Node (Exp))); Name => Relocate_Node (Exp)));
end if; end if;
Set_Related_Expression (Def_Id, Exp);
-- If this is a packed reference, or a selected component with a -- If this is a packed reference, or a selected component with a
-- non-standard representation, a reference to the temporary will -- non-standard representation, a reference to the temporary will
-- be replaced by a copy of the original expression (see -- be replaced by a copy of the original expression (see
...@@ -4757,6 +4762,7 @@ package body Exp_Util is ...@@ -4757,6 +4762,7 @@ package body Exp_Util is
Expression => Relocate_Node (Exp)); Expression => Relocate_Node (Exp));
Insert_Action (Exp, Decl); Insert_Action (Exp, Decl);
Set_Etype (Obj, Exp_Type); Set_Etype (Obj, Exp_Type);
Set_Related_Expression (Obj, Exp);
Rewrite (Exp, New_Occurrence_Of (Obj, Loc)); Rewrite (Exp, New_Occurrence_Of (Obj, Loc));
return; return;
end; end;
...@@ -4814,6 +4820,7 @@ package body Exp_Util is ...@@ -4814,6 +4820,7 @@ package body Exp_Util is
Defining_Identifier => Def_Id, Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Ref_Type, Loc), Object_Definition => New_Reference_To (Ref_Type, Loc),
Expression => New_Exp)); Expression => New_Exp));
Set_Related_Expression (Def_Id, Exp);
end if; end if;
-- Preserve the Assignment_OK flag in all copies, since at least -- Preserve the Assignment_OK flag in all copies, since at least
......
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