-- Local Subprograms --
-----------------------
- procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id);
- -- This subprogram is used to fixup parent pointers that are rendered
- -- incorrect because of a node copy. Field is checked to see if it
- -- points to a node, list, or element list that has a parent that
- -- points to Old_Node. If so, the parent is reset to point to New_Node.
+ procedure Fix_Parents (Old_Node, New_Node : Node_Id);
+ -- Fixup parent pointers for the syntactic children of New_Node after
+ -- a copy, setting them to New_Node when they pointed to Old_Node.
+
+ function Allocate_Initialize_Node
+ (Src : Node_Id;
+ With_Extension : Boolean) return Node_Id;
+ -- Allocate a new node or node extension. If Src is not empty,
+ -- the information for the newly-allocated node is copied from it.
+
+ ------------------------------
+ -- Allocate_Initialize_Node --
+ ------------------------------
+
+ function Allocate_Initialize_Node
+ (Src : Node_Id;
+ With_Extension : Boolean) return Node_Id
+ is
+ New_Id : Node_Id := Src;
+ Nod : Node_Record := Default_Node;
+ Ext1 : Node_Record := Default_Node_Extension;
+ Ext2 : Node_Record := Default_Node_Extension;
+ Ext3 : Node_Record := Default_Node_Extension;
+ begin
+ if Present (Src) then
+ Nod := Nodes.Table (Src);
+
+ if Has_Extension (Src) then
+ Ext1 := Nodes.Table (Src + 1);
+ Ext2 := Nodes.Table (Src + 2);
+ Ext3 := Nodes.Table (Src + 3);
+ end if;
+ end if;
+
+ if not (Present (Src)
+ and then not Has_Extension (Src)
+ and then With_Extension
+ and then Src = Nodes.Last)
+ then
+ -- We are allocating a new node, or extending a node
+ -- other than Nodes.Last.
+
+ Nodes.Append (Nod);
+ New_Id := Nodes.Last;
+ Orig_Nodes.Append (New_Id);
+ Node_Count := Node_Count + 1;
+ end if;
+
+ if With_Extension then
+ Nodes.Append (Ext1);
+ Nodes.Append (Ext2);
+ Nodes.Append (Ext3);
+ end if;
+
+ Orig_Nodes.Set_Last (Nodes.Last);
+ Allocate_List_Tables (Nodes.Last);
+ return New_Id;
+ end Allocate_Initialize_Node;
--------------
-- Analyzed --
return Copy_Entity (Source);
else
- Nodes.Increment_Last;
- New_Id := Nodes.Last;
- Nodes.Table (New_Id) := Nodes.Table (Source);
- Nodes.Table (New_Id).Link := Empty_List_Or_Node;
- Nodes.Table (New_Id).In_List := False;
- Nodes.Table (New_Id).Rewrite_Ins := False;
- Node_Count := Node_Count + 1;
-
- Orig_Nodes.Increment_Last;
- Allocate_List_Tables (Nodes.Last);
- Orig_Nodes.Table (New_Id) := New_Id;
+ New_Id := New_Copy (Source);
-- Recursively copy descendents
pragma Inline (Debug_Extend_Node);
begin
- if Node /= Nodes.Last then
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Nodes.Table (Node);
- Result := Nodes.Last;
-
- Orig_Nodes.Increment_Last;
- Orig_Nodes.Table (Nodes.Last) := Nodes.Last;
+ pragma Assert (not (Has_Extension (Node)));
+ Result := Allocate_Initialize_Node (Node, With_Extension => True);
+ pragma Debug (Debug_Extend_Node);
+ return Result;
+ end Extend_Node;
- else
- Result := Node;
- end if;
+ -----------------
+ -- Fix_Parents --
+ -----------------
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node_Extension;
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node_Extension;
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node_Extension;
+ procedure Fix_Parents (Old_Node, New_Node : Node_Id) is
- Orig_Nodes.Set_Last (Nodes.Last);
- Allocate_List_Tables (Nodes.Last);
+ procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id);
+ -- Fixup one parent pointer. Field is checked to see if it
+ -- points to a node, list, or element list that has a parent that
+ -- points to Old_Node. If so, the parent is reset to point to New_Node.
- pragma Debug (Debug_Extend_Node);
- return Result;
- end Extend_Node;
+ procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id) is
+ begin
+ -- Fix parent of node that is referenced by Field. Note that we must
+ -- exclude the case where the node is a member of a list, because in
+ -- this case the parent is the parent of the list.
- ----------------
- -- Fix_Parent --
- ----------------
+ if Field in Node_Range
+ and then Present (Node_Id (Field))
+ and then not Nodes.Table (Node_Id (Field)).In_List
+ and then Parent (Node_Id (Field)) = Old_Node
+ then
+ Set_Parent (Node_Id (Field), New_Node);
- procedure Fix_Parent (Field : Union_Id; Old_Node, New_Node : Node_Id) is
- begin
- -- Fix parent of node that is referenced by Field. Note that we must
- -- exclude the case where the node is a member of a list, because in
- -- this case the parent is the parent of the list.
-
- if Field in Node_Range
- and then Present (Node_Id (Field))
- and then not Nodes.Table (Node_Id (Field)).In_List
- and then Parent (Node_Id (Field)) = Old_Node
- then
- Set_Parent (Node_Id (Field), New_Node);
+ -- Fix parent of list that is referenced by Field
- -- Fix parent of list that is referenced by Field
+ elsif Field in List_Range
+ and then Present (List_Id (Field))
+ and then Parent (List_Id (Field)) = Old_Node
+ then
+ Set_Parent (List_Id (Field), New_Node);
+ end if;
+ end Fix_Parent;
- elsif Field in List_Range
- and then Present (List_Id (Field))
- and then Parent (List_Id (Field)) = Old_Node
- then
- Set_Parent (List_Id (Field), New_Node);
- end if;
- end Fix_Parent;
+ begin
+ Fix_Parent (Field1 (New_Node), Old_Node, New_Node);
+ Fix_Parent (Field2 (New_Node), Old_Node, New_Node);
+ Fix_Parent (Field3 (New_Node), Old_Node, New_Node);
+ Fix_Parent (Field4 (New_Node), Old_Node, New_Node);
+ Fix_Parent (Field5 (New_Node), Old_Node, New_Node);
+ end Fix_Parents;
-----------------------------------
-- Get_Comes_From_Source_Default --
--------------
function New_Copy (Source : Node_Id) return Node_Id is
- New_Id : Node_Id;
+ New_Id : Node_Id := Source;
begin
- if Source <= Empty_Or_Error then
- return Source;
+ if Source > Empty_Or_Error then
+
+ New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source));
- else
- Nodes.Increment_Last;
- New_Id := Nodes.Last;
- Nodes.Table (New_Id) := Nodes.Table (Source);
Nodes.Table (New_Id).Link := Empty_List_Or_Node;
Nodes.Table (New_Id).In_List := False;
- Nodes.Table (New_Id).Rewrite_Ins := False;
- Orig_Nodes.Increment_Last;
- Orig_Nodes.Table (New_Id) := New_Id;
+ -- If the original is marked as a rewrite insertion, then unmark
+ -- the copy, since we inserted the original, not the copy.
- if Has_Extension (Source) then
- Nodes.Increment_Last;
- Nodes.Table (New_Id + 1) := Nodes.Table (Source + 1);
- Nodes.Increment_Last;
- Nodes.Table (New_Id + 2) := Nodes.Table (Source + 2);
- Nodes.Increment_Last;
- Nodes.Table (New_Id + 3) := Nodes.Table (Source + 3);
-
- Orig_Nodes.Set_Last (Nodes.Last);
- end if;
-
- Allocate_List_Tables (Nodes.Last);
- Node_Count := Node_Count + 1;
- return New_Id;
+ Nodes.Table (New_Id).Rewrite_Ins := False;
end if;
+
+ return New_Id;
end New_Copy;
-------------------
return Assoc (Old_Node);
else
- Nodes.Increment_Last;
- New_Node := Nodes.Last;
- Nodes.Table (New_Node) := Nodes.Table (Old_Node);
- Nodes.Table (New_Node).Link := Empty_List_Or_Node;
- Nodes.Table (New_Node).In_List := False;
- Node_Count := Node_Count + 1;
-
- Orig_Nodes.Increment_Last;
- Allocate_List_Tables (Nodes.Last);
-
- Orig_Nodes.Table (Nodes.Last) := Nodes.Last;
+ New_Node := New_Copy (Old_Node);
-- If the node we are copying is the associated node of a
-- previously copied Itype, then adjust the associated node
Set_Field5
(New_Node, Copy_Field_With_Replacement (Field5 (New_Node)));
- -- If the original is marked as a rewrite insertion, then unmark
- -- the copy, since we inserted the original, not the copy.
-
- Nodes.Table (New_Node).Rewrite_Ins := False;
-- Adjust Sloc of new node if necessary
begin
if Debug_Flag_N then
Write_Str ("Allocate entity, Id = ");
- Write_Int (Int (Nodes.Last));
+ Write_Int (Int (Ent));
Write_Str (" ");
Write_Location (New_Sloc);
Write_Str (" ");
begin
pragma Assert (New_Node_Kind in N_Entity);
- Nodes.Increment_Last;
- Ent := Nodes.Last;
+ Ent := Allocate_Initialize_Node (Empty, With_Extension => True);
-- If this is a node with a real location and we are generating
-- source nodes, then reset Current_Error_Node. This is useful
Current_Error_Node := Ent;
end if;
- Nodes.Table (Nodes.Last) := Default_Node;
- Nodes.Table (Nodes.Last).Nkind := New_Node_Kind;
- Nodes.Table (Nodes.Last).Sloc := New_Sloc;
+ Nodes.Table (Ent).Nkind := New_Node_Kind;
+ Nodes.Table (Ent).Sloc := New_Sloc;
pragma Debug (New_Entity_Debugging_Output);
- Orig_Nodes.Increment_Last;
- Orig_Nodes.Table (Nodes.Last) := Nodes.Last;
-
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node_Extension;
-
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node_Extension;
-
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node_Extension;
-
- Orig_Nodes.Set_Last (Nodes.Last);
- Allocate_List_Tables (Nodes.Last);
- Node_Count := Node_Count + 1;
return Ent;
end New_Entity;
begin
if Debug_Flag_N then
Write_Str ("Allocate node, Id = ");
- Write_Int (Int (Nodes.Last));
+ Write_Int (Int (Nod));
Write_Str (" ");
Write_Location (New_Sloc);
Write_Str (" ");
begin
pragma Assert (New_Node_Kind not in N_Entity);
- Nodes.Increment_Last;
- Nodes.Table (Nodes.Last) := Default_Node;
- Nodes.Table (Nodes.Last).Nkind := New_Node_Kind;
- Nodes.Table (Nodes.Last).Sloc := New_Sloc;
+ Nod := Allocate_Initialize_Node (Empty, With_Extension => False);
+ Nodes.Table (Nod).Nkind := New_Node_Kind;
+ Nodes.Table (Nod).Sloc := New_Sloc;
pragma Debug (New_Node_Debugging_Output);
- Nod := Nodes.Last;
-- If this is a node with a real location and we are generating
-- source nodes, then reset Current_Error_Node. This is useful
Current_Error_Node := Nod;
end if;
- Node_Count := Node_Count + 1;
- Orig_Nodes.Increment_Last;
- Allocate_List_Tables (Nodes.Last);
- Orig_Nodes.Table (Nodes.Last) := Nodes.Last;
return Nod;
end New_Node;
end if;
New_Node := New_Copy (Source);
- Fix_Parent (Field1 (Source), Source, New_Node);
- Fix_Parent (Field2 (Source), Source, New_Node);
- Fix_Parent (Field3 (Source), Source, New_Node);
- Fix_Parent (Field4 (Source), Source, New_Node);
- Fix_Parent (Field5 (Source), Source, New_Node);
+ Fix_Parents (Source, New_Node);
-- We now set the parent of the new node to be the same as the
-- parent of the source. Almost always this parent will be
-------------
procedure Replace (Old_Node, New_Node : Node_Id) is
- Old_Link : constant Union_Id := Nodes.Table (Old_Node).Link;
- Old_InL : constant Boolean := Nodes.Table (Old_Node).In_List;
Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
Old_CFS : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source;
-- Do copy, preserving link and in list status and comes from source
- Nodes.Table (Old_Node) := Nodes.Table (New_Node);
- Nodes.Table (Old_Node).Link := Old_Link;
- Nodes.Table (Old_Node).In_List := Old_InL;
+ Copy_Node (Source => New_Node, Destination => Old_Node);
Nodes.Table (Old_Node).Comes_From_Source := Old_CFS;
Nodes.Table (Old_Node).Error_Posted := Old_Post;
-- Fix parents of substituted node, since it has changed identity
- Fix_Parent (Field1 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field2 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field3 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field4 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field5 (Old_Node), New_Node, Old_Node);
+ Fix_Parents (New_Node, Old_Node);
-- Since we are doing a replace, we assume that the original node
-- is intended to become the new replaced node. The call would be
procedure Rewrite (Old_Node, New_Node : Node_Id) is
- Old_Link : constant Union_Id := Nodes.Table (Old_Node).Link;
- Old_In_List : constant Boolean := Nodes.Table (Old_Node).In_List;
Old_Error_P : constant Boolean := Nodes.Table (Old_Node).Error_Posted;
- -- These three fields are always preserved in the new node
+ -- This fields is always preserved in the new node
Old_Paren_Count : Paren_Count_Type;
Old_Must_Not_Freeze : Boolean;
-- that does not reference the Old_Node.
if Orig_Nodes.Table (Old_Node) = Old_Node then
- Nodes.Increment_Last;
- Sav_Node := Nodes.Last;
- Nodes.Table (Sav_Node) := Nodes.Table (Old_Node);
- Nodes.Table (Sav_Node).In_List := False;
- Nodes.Table (Sav_Node).Link := Union_Id (Parent (Old_Node));
-
- Orig_Nodes.Increment_Last;
- Allocate_List_Tables (Nodes.Last);
-
+ Sav_Node := New_Copy (Old_Node);
Orig_Nodes.Table (Sav_Node) := Sav_Node;
Orig_Nodes.Table (Old_Node) := Sav_Node;
end if;
-- Copy substitute node into place, preserving old fields as required
- Nodes.Table (Old_Node) := Nodes.Table (New_Node);
- Nodes.Table (Old_Node).Link := Old_Link;
- Nodes.Table (Old_Node).In_List := Old_In_List;
+ Copy_Node (Source => New_Node, Destination => Old_Node);
Nodes.Table (Old_Node).Error_Posted := Old_Error_P;
if Nkind (New_Node) in N_Subexpr then
Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
end if;
- Fix_Parent (Field1 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field2 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field3 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field4 (Old_Node), New_Node, Old_Node);
- Fix_Parent (Field5 (Old_Node), New_Node, Old_Node);
+ Fix_Parents (New_Node, Old_Node);
end Rewrite;
------------------