Skip to content

R
riscv-gcc-1
Commit 864a4236 by Ed Schonberg Committed by Arnaud Charlet
Options

atree.ads, atree.adb (Copy_Separate_List): New function that applies… 

atree.ads, atree.adb (Copy_Separate_List): New function that applies Copy_Separate_Tree to a list of nodes.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* atree.ads, atree.adb (Copy_Separate_List): New function that applies
	Copy_Separate_Tree to a list of nodes. Used to create disjoint copies
	of statement lists that may contain local declarations.
	(Expand_N_Timed_Entry_Call): Use Copy_Separate_List to duplicate the
	triggering statements needed for the expansion of this construct, when
	the trigger is a dispatching call to a synchronized primitive.

From-SVN: r178169
parent 7f394c1d
Showing with 55 additions and 20 deletions
gcc/ada/ChangeLog
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* atree.ads, atree.adb (Copy_Separate_List): New function that applies
Copy_Separate_Tree to a list of nodes. Used to create disjoint copies
of statement lists that may contain local declarations.
(Expand_N_Timed_Entry_Call): Use Copy_Separate_List to duplicate the
triggering statements needed for the expansion of this construct, when
the trigger is a dispatching call to a synchronized primitive.
2011-08-29 Arnaud Charlet <charlet@adacore.com>
* gnat_rm.texi: Add doc for 'Elab_Subp_Body.
......
gcc/ada/atree.adb
......@@ -646,6 +646,24 @@ package body Atree is
end Copy_Node;
------------------------
-- Copy_Separate_List --
------------------------
function Copy_Separate_List (Source : List_Id) return List_Id is
Result : constant List_Id := New_List;
Nod : Node_Id;
begin
Nod := First (Source);
while Present (Nod) loop
Append (Copy_Separate_Tree (Nod), Result);
Next (Nod);
end loop;
return Result;
end Copy_Separate_List;
------------------------
-- Copy_Separate_Tree --
------------------------
......@@ -766,8 +784,8 @@ package body Atree is
Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id)));
Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id)));
-- Set Entity field to Empty
-- Why is this done??? and why is it always right to do it???
-- Set Entity field to Empty to ensure that no entity references
-- are shared between the two, if the source is already analyzed.
if Nkind (New_Id) in N_Has_Entity
or else Nkind (New_Id) = N_Freeze_Entity
......
gcc/ada/atree.ads
......@@ -429,16 +429,20 @@ package Atree is
-- Source to be Empty, in which case Relocate_Node simply returns
-- Empty as the result.
function Copy_Separate_List (Source : List_Id) return List_Id;
-- Apply the following to a list of nodes
function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Separate_Tree copies
-- the entire syntactic subtree, including recursively any descendants
-- whose parent field references a copied node (descendants not linked to
-- a copied node by the parent field are also copied.) The parent pointers
-- in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns
-- Empty/Error. The semantic fields are not copied and the new subtree
-- does not share any entity with source subtree.
-- But the code *does* copy semantic fields, and the description above
-- is in any case unclear on this point ??? (RBKD)
-- Empty/Error. The new subtree does not share entities with the source,
-- but has new entities with the same name. Most of the time this routine
-- is called on an unanalyzed tree, and no semantic information is copied.
-- However, to ensure that no entities are shared between the two when the
-- source is already analyzed, entity fields in the copy are zeroed out.
procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id);
-- Exchange the contents of two entities. The parent pointers are switched
......@@ -449,16 +453,15 @@ package Atree is
-- two entities may be list members.
function Extend_Node (Node : Node_Id) return Entity_Id;
-- This function returns a copy of its input node with an extension
-- added. The fields of the extension are set to Empty. Due to the way
-- extensions are handled (as four consecutive array elements), it may
-- be necessary to reallocate the node, so that the returned value is
-- not the same as the input value, but where possible the returned
-- value will be the same as the input value (i.e. the extension will
-- occur in place). It is the caller's responsibility to ensure that
-- any pointers to the original node are appropriately updated. This
-- function is used only by Sinfo.CN to change nodes into their
-- corresponding entities.
-- This function returns a copy of its input node with an extension added.
-- The fields of the extension are set to Empty. Due to the way extensions
-- are handled (as four consecutive array elements), it may be necessary
-- to reallocate the node, so that the returned value is not the same as
-- the input value, but where possible the returned value will be the same
-- as the input value (i.e. the extension will occur in place). It is the
-- caller's responsibility to ensure that any pointers to the original node
-- are appropriately updated. This function is used only by Sinfo.CN to
-- change nodes into their corresponding entities.
type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
......@@ -475,7 +478,7 @@ package Atree is
-- the results of Process calls. See below for details.
generic
with function Process (N : Node_Id) return Traverse_Result is <>;
with function Process (N : Node_Id) return Traverse_Result is <>;
function Traverse_Func (Node : Node_Id) return Traverse_Final_Result;
-- This is a generic function that, given the parent node for a subtree,
-- traverses all syntactic nodes of this tree, calling the given function
......@@ -501,7 +504,7 @@ package Atree is
-- all calls to process returned either OK, OK_Orig, or Skip).
generic
with function Process (N : Node_Id) return Traverse_Result is <>;
with function Process (N : Node_Id) return Traverse_Result is <>;
procedure Traverse_Proc (Node : Node_Id);
pragma Inline (Traverse_Proc);
-- This is the same as Traverse_Func except that no result is returned,
......
gcc/ada/exp_ch9.adb
......@@ -10990,6 +10990,11 @@ package body Exp_Ch9 is
-- end if;
-- end if;
-- end;
--
-- The triggering statement and the timed statements have not been
-- analyzed yet (see Analyzed_Timed_Entry_Call). They may contain local
-- declarations, and therefore the copies that are made during expansion
-- must be disjoint, as for any other inlining.
procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
......@@ -11284,7 +11289,7 @@ package body Exp_Ch9 is
-- <timed-statements>
-- end if;
N_Stats := New_Copy_List_Tree (E_Stats);
N_Stats := Copy_Separate_List (E_Stats);
Prepend_To (N_Stats,
Make_If_Statement (Loc,
......@@ -11327,7 +11332,7 @@ package body Exp_Ch9 is
-- <dispatching-call>;
-- <triggering-statements>
Lim_Typ_Stmts := New_Copy_List_Tree (E_Stats);
Lim_Typ_Stmts := Copy_Separate_List (E_Stats);
Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (E_Call));
-- Generate:
......
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