end if;
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 --
------------------------
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
-- 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
-- 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);
-- 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
-- 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,
-- 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);
-- <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,
-- <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:
projects / gcc.git / commitdiff