1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- WARNING: There is a C version of this package. Any changes to this source
33 -- file must be properly reflected in the corresponding C header a-nlists.h
36 with Atree; use Atree;
37 with Debug; use Debug;
38 with Output; use Output;
39 with Sinfo; use Sinfo;
42 package body Nlists is
44 use Atree_Private_Part;
45 -- Get access to Nodes table
47 ----------------------------------
48 -- Implementation of Node Lists --
49 ----------------------------------
51 -- A node list is represented by a list header which contains
54 type List_Header is record
55 First : Node_Or_Entity_Id;
56 -- Pointer to first node in list. Empty if list is empty
58 Last : Node_Or_Entity_Id;
59 -- Pointer to last node in list. Empty if list is empty
62 -- Pointer to parent of list. Empty if list has no parent
65 -- The node lists are stored in a table indexed by List_Id values
67 package Lists is new Table.Table (
68 Table_Component_Type => List_Header,
69 Table_Index_Type => List_Id'Base,
70 Table_Low_Bound => First_List_Id,
71 Table_Initial => Alloc.Lists_Initial,
72 Table_Increment => Alloc.Lists_Increment,
73 Table_Name => "Lists");
75 -- The nodes in the list all have the In_List flag set, and their Link
76 -- fields (which otherwise point to the parent) contain the List_Id of
77 -- the list header giving immediate access to the list containing the
78 -- node, and its parent and first and last elements.
80 -- Two auxiliary tables, indexed by Node_Id values and built in parallel
81 -- with the main nodes table and always having the same size contain the
82 -- list link values that allow locating the previous and next node in a
83 -- list. The entries in these tables are valid only if the In_List flag
84 -- is set in the corresponding node. Next_Node is Empty at the end of a
85 -- list and Prev_Node is Empty at the start of a list.
87 package Next_Node is new Table.Table (
88 Table_Component_Type => Node_Or_Entity_Id,
89 Table_Index_Type => Node_Or_Entity_Id'Base,
90 Table_Low_Bound => First_Node_Id,
91 Table_Initial => Alloc.Orig_Nodes_Initial,
92 Table_Increment => Alloc.Orig_Nodes_Increment,
93 Table_Name => "Next_Node");
95 package Prev_Node is new Table.Table (
96 Table_Component_Type => Node_Or_Entity_Id,
97 Table_Index_Type => Node_Or_Entity_Id'Base,
98 Table_Low_Bound => First_Node_Id,
99 Table_Initial => Alloc.Orig_Nodes_Initial,
100 Table_Increment => Alloc.Orig_Nodes_Increment,
101 Table_Name => "Prev_Node");
103 -----------------------
104 -- Local Subprograms --
105 -----------------------
107 procedure Set_First (List : List_Id; To : Node_Or_Entity_Id);
108 pragma Inline (Set_First);
109 -- Sets First field of list header List to reference To
111 procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id);
112 pragma Inline (Set_Last);
113 -- Sets Last field of list header List to reference To
115 procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id);
116 pragma Inline (Set_List_Link);
117 -- Sets list link of Node to list header To
119 procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
120 pragma Inline (Set_Next);
121 -- Sets the Next_Node pointer for Node to reference To
123 procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
124 pragma Inline (Set_Prev);
125 -- Sets the Prev_Node pointer for Node to reference To
127 --------------------------
128 -- Allocate_List_Tables --
129 --------------------------
131 procedure Allocate_List_Tables (N : Node_Or_Entity_Id) is
132 Old_Last : constant Node_Or_Entity_Id'Base := Next_Node.Last;
135 pragma Assert (N >= Old_Last);
136 Next_Node.Set_Last (N);
137 Prev_Node.Set_Last (N);
139 -- Make sure we have no uninitialized junk in any new entires added.
140 -- This ensures that Tree_Gen will not write out any uninitialized junk.
142 for J in Old_Last + 1 .. N loop
143 Next_Node.Table (J) := Empty;
144 Prev_Node.Table (J) := Empty;
146 end Allocate_List_Tables;
152 procedure Append (Node : Node_Or_Entity_Id; To : List_Id) is
153 L : constant Node_Or_Entity_Id := Last (To);
155 procedure Append_Debug;
156 pragma Inline (Append_Debug);
157 -- Output debug information if Debug_Flag_N set
163 procedure Append_Debug is
166 Write_Str ("Append node ");
167 Write_Int (Int (Node));
168 Write_Str (" to list ");
169 Write_Int (Int (To));
174 -- Start of processing for Append
177 pragma Assert (not Is_List_Member (Node));
183 pragma Debug (Append_Debug);
186 Set_First (To, Node);
193 Nodes.Table (Node).In_List := True;
195 Set_Next (Node, Empty);
197 Set_List_Link (Node, To);
204 procedure Append_List (List : List_Id; To : List_Id) is
206 procedure Append_List_Debug;
207 pragma Inline (Append_List_Debug);
208 -- Output debug information if Debug_Flag_N set
210 -----------------------
211 -- Append_List_Debug --
212 -----------------------
214 procedure Append_List_Debug is
217 Write_Str ("Append list ");
218 Write_Int (Int (List));
219 Write_Str (" to list ");
220 Write_Int (Int (To));
223 end Append_List_Debug;
225 -- Start of processing for Append_List
228 if Is_Empty_List (List) then
233 L : constant Node_Or_Entity_Id := Last (To);
234 F : constant Node_Or_Entity_Id := First (List);
235 N : Node_Or_Entity_Id;
238 pragma Debug (Append_List_Debug);
242 Set_List_Link (N, To);
254 Set_Last (To, Last (List));
256 Set_First (List, Empty);
257 Set_Last (List, Empty);
266 procedure Append_List_To (To : List_Id; List : List_Id) is
268 Append_List (List, To);
275 procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id) is
284 function First (List : List_Id) return Node_Or_Entity_Id is
286 if List = No_List then
289 pragma Assert (List <= Lists.Last);
290 return Lists.Table (List).First;
294 ----------------------
295 -- First_Non_Pragma --
296 ----------------------
298 function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
299 N : constant Node_Or_Entity_Id := First (List);
301 if Nkind (N) /= N_Pragma
303 Nkind (N) /= N_Null_Statement
307 return Next_Non_Pragma (N);
309 end First_Non_Pragma;
315 procedure Initialize is
316 E : constant List_Id := Error_List;
323 -- Allocate Error_List list header
325 Lists.Increment_Last;
326 Set_Parent (E, Empty);
327 Set_First (E, Empty);
335 function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean is
337 return List_Containing (N1) = List_Containing (N2);
344 procedure Insert_After
345 (After : Node_Or_Entity_Id;
346 Node : Node_Or_Entity_Id)
348 procedure Insert_After_Debug;
349 pragma Inline (Insert_After_Debug);
350 -- Output debug information if Debug_Flag_N set
352 ------------------------
353 -- Insert_After_Debug --
354 ------------------------
356 procedure Insert_After_Debug is
359 Write_Str ("Insert node");
360 Write_Int (Int (Node));
361 Write_Str (" after node ");
362 Write_Int (Int (After));
365 end Insert_After_Debug;
367 -- Start of processing for Insert_After
371 (Is_List_Member (After) and then not Is_List_Member (Node));
377 pragma Debug (Insert_After_Debug);
380 Before : constant Node_Or_Entity_Id := Next (After);
381 LC : constant List_Id := List_Containing (After);
384 if Present (Before) then
385 Set_Prev (Before, Node);
390 Set_Next (After, Node);
392 Nodes.Table (Node).In_List := True;
394 Set_Prev (Node, After);
395 Set_Next (Node, Before);
396 Set_List_Link (Node, LC);
404 procedure Insert_Before
405 (Before : Node_Or_Entity_Id;
406 Node : Node_Or_Entity_Id)
408 procedure Insert_Before_Debug;
409 pragma Inline (Insert_Before_Debug);
410 -- Output debug information if Debug_Flag_N set
412 -------------------------
413 -- Insert_Before_Debug --
414 -------------------------
416 procedure Insert_Before_Debug is
419 Write_Str ("Insert node");
420 Write_Int (Int (Node));
421 Write_Str (" before node ");
422 Write_Int (Int (Before));
425 end Insert_Before_Debug;
427 -- Start of processing for Insert_Before
431 (Is_List_Member (Before) and then not Is_List_Member (Node));
437 pragma Debug (Insert_Before_Debug);
440 After : constant Node_Or_Entity_Id := Prev (Before);
441 LC : constant List_Id := List_Containing (Before);
444 if Present (After) then
445 Set_Next (After, Node);
447 Set_First (LC, Node);
450 Set_Prev (Before, Node);
452 Nodes.Table (Node).In_List := True;
454 Set_Prev (Node, After);
455 Set_Next (Node, Before);
456 Set_List_Link (Node, LC);
460 -----------------------
461 -- Insert_List_After --
462 -----------------------
464 procedure Insert_List_After (After : Node_Or_Entity_Id; List : List_Id) is
466 procedure Insert_List_After_Debug;
467 pragma Inline (Insert_List_After_Debug);
468 -- Output debug information if Debug_Flag_N set
470 -----------------------------
471 -- Insert_List_After_Debug --
472 -----------------------------
474 procedure Insert_List_After_Debug is
477 Write_Str ("Insert list ");
478 Write_Int (Int (List));
479 Write_Str (" after node ");
480 Write_Int (Int (After));
483 end Insert_List_After_Debug;
485 -- Start of processing for Insert_List_After
488 pragma Assert (Is_List_Member (After));
490 if Is_Empty_List (List) then
495 Before : constant Node_Or_Entity_Id := Next (After);
496 LC : constant List_Id := List_Containing (After);
497 F : constant Node_Or_Entity_Id := First (List);
498 L : constant Node_Or_Entity_Id := Last (List);
499 N : Node_Or_Entity_Id;
502 pragma Debug (Insert_List_After_Debug);
506 Set_List_Link (N, LC);
511 if Present (Before) then
512 Set_Prev (Before, L);
519 Set_Next (L, Before);
521 Set_First (List, Empty);
522 Set_Last (List, Empty);
525 end Insert_List_After;
527 ------------------------
528 -- Insert_List_Before --
529 ------------------------
531 procedure Insert_List_Before (Before : Node_Or_Entity_Id; List : List_Id) is
533 procedure Insert_List_Before_Debug;
534 pragma Inline (Insert_List_Before_Debug);
535 -- Output debug information if Debug_Flag_N set
537 ------------------------------
538 -- Insert_List_Before_Debug --
539 ------------------------------
541 procedure Insert_List_Before_Debug is
544 Write_Str ("Insert list ");
545 Write_Int (Int (List));
546 Write_Str (" before node ");
547 Write_Int (Int (Before));
550 end Insert_List_Before_Debug;
552 -- Start of processing for Insert_List_Before
555 pragma Assert (Is_List_Member (Before));
557 if Is_Empty_List (List) then
562 After : constant Node_Or_Entity_Id := Prev (Before);
563 LC : constant List_Id := List_Containing (Before);
564 F : constant Node_Or_Entity_Id := First (List);
565 L : constant Node_Or_Entity_Id := Last (List);
566 N : Node_Or_Entity_Id;
569 pragma Debug (Insert_List_Before_Debug);
573 Set_List_Link (N, LC);
578 if Present (After) then
584 Set_Prev (Before, L);
586 Set_Next (L, Before);
588 Set_First (List, Empty);
589 Set_Last (List, Empty);
592 end Insert_List_Before;
598 function Is_Empty_List (List : List_Id) return Boolean is
600 return First (List) = Empty;
607 function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean is
609 return Nodes.Table (Node).In_List;
612 -----------------------
613 -- Is_Non_Empty_List --
614 -----------------------
616 function Is_Non_Empty_List (List : List_Id) return Boolean is
618 return First (List) /= Empty;
619 end Is_Non_Empty_List;
625 function Last (List : List_Id) return Node_Or_Entity_Id is
627 pragma Assert (List <= Lists.Last);
628 return Lists.Table (List).Last;
635 function Last_List_Id return List_Id is
640 ---------------------
641 -- Last_Non_Pragma --
642 ---------------------
644 function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
645 N : constant Node_Or_Entity_Id := Last (List);
647 if Nkind (N) /= N_Pragma then
650 return Prev_Non_Pragma (N);
654 ---------------------
655 -- List_Containing --
656 ---------------------
658 function List_Containing (Node : Node_Or_Entity_Id) return List_Id is
660 pragma Assert (Is_List_Member (Node));
661 return List_Id (Nodes.Table (Node).Link);
668 function List_Length (List : List_Id) return Nat is
670 Node : Node_Or_Entity_Id;
674 Node := First (List);
675 while Present (Node) loop
676 Result := Result + 1;
687 function Lists_Address return System.Address is
689 return Lists.Table (First_List_Id)'Address;
698 Lists.Locked := True;
701 Prev_Node.Locked := True;
702 Next_Node.Locked := True;
712 function New_Copy_List (List : List_Id) return List_Id is
714 E : Node_Or_Entity_Id;
717 if List = No_List then
724 while Present (E) loop
725 Append (New_Copy (E), NL);
733 ----------------------------
734 -- New_Copy_List_Original --
735 ----------------------------
737 function New_Copy_List_Original (List : List_Id) return List_Id is
739 E : Node_Or_Entity_Id;
742 if List = No_List then
749 while Present (E) loop
750 if Comes_From_Source (E) then
751 Append (New_Copy (E), NL);
759 end New_Copy_List_Original;
765 function New_List return List_Id is
767 procedure New_List_Debug;
768 pragma Inline (New_List_Debug);
769 -- Output debugging information if Debug_Flag_N is set
775 procedure New_List_Debug is
778 Write_Str ("Allocate new list, returned ID = ");
779 Write_Int (Int (Lists.Last));
784 -- Start of processing for New_List
787 Lists.Increment_Last;
790 List : constant List_Id := Lists.Last;
793 Set_Parent (List, Empty);
794 Set_First (List, Empty);
795 Set_Last (List, Empty);
797 pragma Debug (New_List_Debug);
802 -- Since the one argument case is common, we optimize to build the right
803 -- list directly, rather than first building an empty list and then doing
804 -- the insertion, which results in some unnecessary work.
806 function New_List (Node : Node_Or_Entity_Id) return List_Id is
808 procedure New_List_Debug;
809 pragma Inline (New_List_Debug);
810 -- Output debugging information if Debug_Flag_N is set
816 procedure New_List_Debug is
819 Write_Str ("Allocate new list, returned ID = ");
820 Write_Int (Int (Lists.Last));
825 -- Start of processing for New_List
832 pragma Assert (not Is_List_Member (Node));
834 Lists.Increment_Last;
837 List : constant List_Id := Lists.Last;
840 Set_Parent (List, Empty);
841 Set_First (List, Node);
842 Set_Last (List, Node);
844 Nodes.Table (Node).In_List := True;
845 Set_List_Link (Node, List);
846 Set_Prev (Node, Empty);
847 Set_Next (Node, Empty);
848 pragma Debug (New_List_Debug);
855 (Node1 : Node_Or_Entity_Id;
856 Node2 : Node_Or_Entity_Id) return List_Id
858 L : constant List_Id := New_List (Node1);
865 (Node1 : Node_Or_Entity_Id;
866 Node2 : Node_Or_Entity_Id;
867 Node3 : Node_Or_Entity_Id) return List_Id
869 L : constant List_Id := New_List (Node1);
877 (Node1 : Node_Or_Entity_Id;
878 Node2 : Node_Or_Entity_Id;
879 Node3 : Node_Or_Entity_Id;
880 Node4 : Node_Or_Entity_Id) return List_Id
882 L : constant List_Id := New_List (Node1);
891 (Node1 : Node_Or_Entity_Id;
892 Node2 : Node_Or_Entity_Id;
893 Node3 : Node_Or_Entity_Id;
894 Node4 : Node_Or_Entity_Id;
895 Node5 : Node_Or_Entity_Id) return List_Id
897 L : constant List_Id := New_List (Node1);
907 (Node1 : Node_Or_Entity_Id;
908 Node2 : Node_Or_Entity_Id;
909 Node3 : Node_Or_Entity_Id;
910 Node4 : Node_Or_Entity_Id;
911 Node5 : Node_Or_Entity_Id;
912 Node6 : Node_Or_Entity_Id) return List_Id
914 L : constant List_Id := New_List (Node1);
928 function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
930 pragma Assert (Is_List_Member (Node));
931 return Next_Node.Table (Node);
934 procedure Next (Node : in out Node_Or_Entity_Id) is
939 -----------------------
940 -- Next_Node_Address --
941 -----------------------
943 function Next_Node_Address return System.Address is
945 return Next_Node.Table (First_Node_Id)'Address;
946 end Next_Node_Address;
948 ---------------------
949 -- Next_Non_Pragma --
950 ---------------------
952 function Next_Non_Pragma
953 (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
955 N : Node_Or_Entity_Id;
961 exit when not Nkind_In (N, N_Pragma, N_Null_Statement);
967 procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id) is
969 Node := Next_Non_Pragma (Node);
976 function No (List : List_Id) return Boolean is
978 return List = No_List;
985 function Num_Lists return Nat is
987 return Int (Lists.Last) - Int (Lists.First) + 1;
994 function p (U : Union_Id) return Node_Or_Entity_Id is
996 if U in Node_Range then
997 return Parent (Node_Or_Entity_Id (U));
998 elsif U in List_Range then
999 return Parent (List_Id (U));
1009 function Parent (List : List_Id) return Node_Or_Entity_Id is
1011 pragma Assert (List <= Lists.Last);
1012 return Lists.Table (List).Parent;
1019 function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id is
1020 Elmt : Node_Or_Entity_Id;
1023 Elmt := First (List);
1024 for J in 1 .. Index - 1 loop
1025 Elmt := Next (Elmt);
1035 procedure Prepend (Node : Node_Or_Entity_Id; To : List_Id) is
1036 F : constant Node_Or_Entity_Id := First (To);
1038 procedure Prepend_Debug;
1039 pragma Inline (Prepend_Debug);
1040 -- Output debug information if Debug_Flag_N set
1046 procedure Prepend_Debug is
1048 if Debug_Flag_N then
1049 Write_Str ("Prepend node ");
1050 Write_Int (Int (Node));
1051 Write_Str (" to list ");
1052 Write_Int (Int (To));
1057 -- Start of processing for Prepend_Debug
1060 pragma Assert (not Is_List_Member (Node));
1062 if Node = Error then
1066 pragma Debug (Prepend_Debug);
1069 Set_Last (To, Node);
1074 Set_First (To, Node);
1076 Nodes.Table (Node).In_List := True;
1079 Set_Prev (Node, Empty);
1080 Set_List_Link (Node, To);
1087 procedure Prepend_List (List : List_Id; To : List_Id) is
1089 procedure Prepend_List_Debug;
1090 pragma Inline (Prepend_List_Debug);
1091 -- Output debug information if Debug_Flag_N set
1093 ------------------------
1094 -- Prepend_List_Debug --
1095 ------------------------
1097 procedure Prepend_List_Debug is
1099 if Debug_Flag_N then
1100 Write_Str ("Prepend list ");
1101 Write_Int (Int (List));
1102 Write_Str (" to list ");
1103 Write_Int (Int (To));
1106 end Prepend_List_Debug;
1108 -- Start of processing for Prepend_List
1111 if Is_Empty_List (List) then
1116 F : constant Node_Or_Entity_Id := First (To);
1117 L : constant Node_Or_Entity_Id := Last (List);
1118 N : Node_Or_Entity_Id;
1121 pragma Debug (Prepend_List_Debug);
1125 Set_List_Link (N, To);
1137 Set_First (To, First (List));
1139 Set_First (List, Empty);
1140 Set_Last (List, Empty);
1145 ---------------------
1146 -- Prepend_List_To --
1147 ---------------------
1149 procedure Prepend_List_To (To : List_Id; List : List_Id) is
1151 Prepend_List (List, To);
1152 end Prepend_List_To;
1158 procedure Prepend_To (To : List_Id; Node : Node_Or_Entity_Id) is
1167 function Present (List : List_Id) return Boolean is
1169 return List /= No_List;
1176 function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
1178 pragma Assert (Is_List_Member (Node));
1179 return Prev_Node.Table (Node);
1182 procedure Prev (Node : in out Node_Or_Entity_Id) is
1184 Node := Prev (Node);
1187 -----------------------
1188 -- Prev_Node_Address --
1189 -----------------------
1191 function Prev_Node_Address return System.Address is
1193 return Prev_Node.Table (First_Node_Id)'Address;
1194 end Prev_Node_Address;
1196 ---------------------
1197 -- Prev_Non_Pragma --
1198 ---------------------
1200 function Prev_Non_Pragma
1201 (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
1203 N : Node_Or_Entity_Id;
1209 exit when Nkind (N) /= N_Pragma;
1213 end Prev_Non_Pragma;
1215 procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id) is
1217 Node := Prev_Non_Pragma (Node);
1218 end Prev_Non_Pragma;
1224 procedure Remove (Node : Node_Or_Entity_Id) is
1225 Lst : constant List_Id := List_Containing (Node);
1226 Prv : constant Node_Or_Entity_Id := Prev (Node);
1227 Nxt : constant Node_Or_Entity_Id := Next (Node);
1229 procedure Remove_Debug;
1230 pragma Inline (Remove_Debug);
1231 -- Output debug information if Debug_Flag_N set
1237 procedure Remove_Debug is
1239 if Debug_Flag_N then
1240 Write_Str ("Remove node ");
1241 Write_Int (Int (Node));
1246 -- Start of processing for Remove
1249 pragma Debug (Remove_Debug);
1252 Set_First (Lst, Nxt);
1254 Set_Next (Prv, Nxt);
1258 Set_Last (Lst, Prv);
1260 Set_Prev (Nxt, Prv);
1263 Nodes.Table (Node).In_List := False;
1264 Set_Parent (Node, Empty);
1271 function Remove_Head (List : List_Id) return Node_Or_Entity_Id is
1272 Frst : constant Node_Or_Entity_Id := First (List);
1274 procedure Remove_Head_Debug;
1275 pragma Inline (Remove_Head_Debug);
1276 -- Output debug information if Debug_Flag_N set
1278 -----------------------
1279 -- Remove_Head_Debug --
1280 -----------------------
1282 procedure Remove_Head_Debug is
1284 if Debug_Flag_N then
1285 Write_Str ("Remove head of list ");
1286 Write_Int (Int (List));
1289 end Remove_Head_Debug;
1291 -- Start of processing for Remove_Head
1294 pragma Debug (Remove_Head_Debug);
1296 if Frst = Empty then
1301 Nxt : constant Node_Or_Entity_Id := Next (Frst);
1304 Set_First (List, Nxt);
1307 Set_Last (List, Empty);
1309 Set_Prev (Nxt, Empty);
1312 Nodes.Table (Frst).In_List := False;
1313 Set_Parent (Frst, Empty);
1323 function Remove_Next
1324 (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
1326 Nxt : constant Node_Or_Entity_Id := Next (Node);
1328 procedure Remove_Next_Debug;
1329 pragma Inline (Remove_Next_Debug);
1330 -- Output debug information if Debug_Flag_N set
1332 -----------------------
1333 -- Remove_Next_Debug --
1334 -----------------------
1336 procedure Remove_Next_Debug is
1338 if Debug_Flag_N then
1339 Write_Str ("Remove next node after ");
1340 Write_Int (Int (Node));
1343 end Remove_Next_Debug;
1345 -- Start of processing for Remove_Next
1348 if Present (Nxt) then
1350 Nxt2 : constant Node_Or_Entity_Id := Next (Nxt);
1351 LC : constant List_Id := List_Containing (Node);
1354 pragma Debug (Remove_Next_Debug);
1355 Set_Next (Node, Nxt2);
1358 Set_Last (LC, Node);
1360 Set_Prev (Nxt2, Node);
1363 Nodes.Table (Nxt).In_List := False;
1364 Set_Parent (Nxt, Empty);
1375 procedure Set_First (List : List_Id; To : Node_Or_Entity_Id) is
1377 Lists.Table (List).First := To;
1384 procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id) is
1386 Lists.Table (List).Last := To;
1393 procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is
1395 Nodes.Table (Node).Link := Union_Id (To);
1402 procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
1404 Next_Node.Table (Node) := To;
1411 procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id) is
1413 pragma Assert (List <= Lists.Last);
1414 Lists.Table (List).Parent := Node;
1421 procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
1423 Prev_Node.Table (Node) := To;
1430 procedure Tree_Read is
1433 Next_Node.Tree_Read;
1434 Prev_Node.Tree_Read;
1441 procedure Tree_Write is
1444 Next_Node.Tree_Write;
1445 Prev_Node.Tree_Write;
1454 Lists.Locked := False;
1455 Prev_Node.Locked := False;
1456 Next_Node.Locked := False;