diff options
Diffstat (limited to 'gcc/ada/atree.adb')
| -rw-r--r-- | gcc/ada/atree.adb | 288 |
1 files changed, 123 insertions, 165 deletions
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 49938b98ece..c03a1836194 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -380,11 +380,64 @@ package body Atree is -- 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 -- @@ -584,17 +637,7 @@ package body Atree is 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 @@ -787,58 +830,53 @@ package body Atree is 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 -- @@ -942,38 +980,23 @@ package body Atree is -------------- 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; ------------------- @@ -1353,17 +1376,7 @@ package body Atree is 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 @@ -1416,10 +1429,6 @@ package body Atree is 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 @@ -1838,7 +1847,7 @@ package body Atree is 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 (" "); @@ -1852,8 +1861,7 @@ package body Atree is 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 @@ -1863,26 +1871,10 @@ package body Atree is 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; @@ -1908,7 +1900,7 @@ package body Atree is 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 (" "); @@ -1921,12 +1913,10 @@ package body Atree is 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 @@ -1936,10 +1926,6 @@ package body Atree is 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; @@ -2054,11 +2040,7 @@ package body Atree is 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 @@ -2085,8 +2067,6 @@ package body Atree is ------------- 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; @@ -2098,19 +2078,13 @@ package body Atree is -- 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 @@ -2129,10 +2103,8 @@ package body Atree is 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; @@ -2165,24 +2137,14 @@ package body Atree is -- 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 @@ -2190,11 +2152,7 @@ package body Atree is 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; ------------------ |
