1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- WARNING: There is a C version of this package. Any changes to this source
27 -- file must be properly reflected in the corresponding C header a-nlists.h
30 with Atree; use Atree;
31 with Debug; use Debug;
32 with Output; use Output;
33 with Sinfo; use Sinfo;
34 with Sinfo.Nodes; use Sinfo.Nodes;
37 package body Nlists is
38 Locked : Boolean := False;
39 -- Compiling with assertions enabled, list contents modifications are
40 -- permitted only when this switch is set to False; compiling without
41 -- assertions this lock has no effect.
43 ----------------------------------
44 -- Implementation of Node Lists --
45 ----------------------------------
47 -- A node list is represented by a list header which contains
50 type List_Header is record
51 First : Node_Or_Entity_Id;
52 -- Pointer to first node in list. Empty if list is empty
54 Last : Node_Or_Entity_Id;
55 -- Pointer to last node in list. Empty if list is empty
58 -- Pointer to parent of list. Empty if list has no parent
61 -- The node lists are stored in a table indexed by List_Id values
63 package Lists is new Table.Table (
64 Table_Component_Type => List_Header,
65 Table_Index_Type => List_Id'Base,
66 Table_Low_Bound => First_List_Id,
67 Table_Initial => Alloc.Lists_Initial,
68 Table_Increment => Alloc.Lists_Increment,
69 Table_Name => "Lists");
71 -- The nodes in the list all have the In_List flag set, and their Link
72 -- fields (which otherwise point to the parent) contain the List_Id of
73 -- the list header giving immediate access to the list containing the
74 -- node, and its parent and first and last elements.
76 -- Two auxiliary tables, indexed by Node_Id values and built in parallel
77 -- with the main nodes table and always having the same size contain the
78 -- list link values that allow locating the previous and next node in a
79 -- list. The entries in these tables are valid only if the In_List flag
80 -- is set in the corresponding node. Next_Node is Empty at the end of a
81 -- list and Prev_Node is Empty at the start of a list.
83 package Next_Node is new Table.Table (
84 Table_Component_Type => Node_Or_Entity_Id,
85 Table_Index_Type => Node_Or_Entity_Id'Base,
86 Table_Low_Bound => First_Node_Id,
87 Table_Initial => Alloc.Node_Offsets_Initial,
88 Table_Increment => Alloc.Node_Offsets_Increment,
89 Table_Name => "Next_Node");
91 package Prev_Node is new Table.Table (
92 Table_Component_Type => Node_Or_Entity_Id,
93 Table_Index_Type => Node_Or_Entity_Id'Base,
94 Table_Low_Bound => First_Node_Id,
95 Table_Initial => Alloc.Node_Offsets_Initial,
96 Table_Increment => Alloc.Node_Offsets_Increment,
97 Table_Name => "Prev_Node");
99 -----------------------
100 -- Local Subprograms --
101 -----------------------
103 procedure Set_First (List : List_Id; To : Node_Or_Entity_Id);
104 pragma Inline (Set_First);
105 -- Sets First field of list header List to reference To
107 procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id);
108 pragma Inline (Set_Last);
109 -- Sets Last field of list header List to reference To
111 procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id);
112 pragma Inline (Set_List_Link);
113 -- Sets list link of Node to list header To
115 procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
116 pragma Inline (Set_Next);
117 -- Sets the Next_Node pointer for Node to reference To
119 procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
120 pragma Inline (Set_Prev);
121 -- Sets the Prev_Node pointer for Node to reference To
123 --------------------------
124 -- Allocate_List_Tables --
125 --------------------------
127 procedure Allocate_List_Tables (N : Node_Or_Entity_Id) is
128 Old_Last : constant Node_Or_Entity_Id'Base := Next_Node.Last;
131 pragma Assert (N >= Old_Last);
132 Next_Node.Set_Last (N);
133 Prev_Node.Set_Last (N);
135 -- Make sure we have no uninitialized junk in any new entries added.
137 for J in Old_Last + 1 .. N loop
138 Next_Node.Table (J) := Empty;
139 Prev_Node.Table (J) := Empty;
141 end Allocate_List_Tables;
147 procedure Append (Node : Node_Or_Entity_Id; To : List_Id) is
148 L : constant Node_Or_Entity_Id := Last (To);
150 procedure Append_Debug;
151 pragma Inline (Append_Debug);
152 -- Output debug information if Debug_Flag_N set
158 procedure Append_Debug is
161 Write_Str ("Append node ");
162 Write_Int (Int (Node));
163 Write_Str (" to list ");
164 Write_Int (Int (To));
169 -- Start of processing for Append
172 pragma Assert (not Is_List_Member (Node));
178 pragma Debug (Append_Debug);
181 Set_First (To, Node);
188 Set_In_List (Node, True);
190 Set_Next (Node, Empty);
192 Set_List_Link (Node, To);
199 procedure Append_List (List : List_Id; To : List_Id) is
200 procedure Append_List_Debug;
201 pragma Inline (Append_List_Debug);
202 -- Output debug information if Debug_Flag_N set
204 -----------------------
205 -- Append_List_Debug --
206 -----------------------
208 procedure Append_List_Debug is
211 Write_Str ("Append list ");
212 Write_Int (Int (List));
213 Write_Str (" to list ");
214 Write_Int (Int (To));
217 end Append_List_Debug;
219 -- Start of processing for Append_List
222 if Is_Empty_List (List) then
227 L : constant Node_Or_Entity_Id := Last (To);
228 F : constant Node_Or_Entity_Id := First (List);
229 N : Node_Or_Entity_Id;
232 pragma Debug (Append_List_Debug);
236 Set_List_Link (N, To);
248 Set_Last (To, Last (List));
250 Set_First (List, Empty);
251 Set_Last (List, Empty);
260 procedure Append_List_To (To : List_Id; List : List_Id) is
262 Append_List (List, To);
269 procedure Append_New (Node : Node_Or_Entity_Id; To : in out List_Id) is
282 procedure Append_New_To (To : in out List_Id; Node : Node_Or_Entity_Id) is
284 Append_New (Node, To);
291 procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id) is
300 function First (List : List_Id) return Node_Or_Entity_Id is
302 if List = No_List then
305 pragma Assert (List <= Lists.Last);
306 return Lists.Table (List).First;
310 ----------------------
311 -- First_Non_Pragma --
312 ----------------------
314 function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
315 N : constant Node_Or_Entity_Id := First (List);
317 if Nkind (N) /= N_Pragma
319 Nkind (N) /= N_Null_Statement
323 return Next_Non_Pragma (N);
325 end First_Non_Pragma;
331 procedure Initialize is
337 -- Allocate Error_List list header
339 Lists.Increment_Last;
340 Set_Parent (Error_List, Empty);
341 Set_First (Error_List, Empty);
342 Set_Last (Error_List, Empty);
349 function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean is
351 return List_Containing (N1) = List_Containing (N2);
358 procedure Insert_After
359 (After : Node_Or_Entity_Id;
360 Node : Node_Or_Entity_Id)
362 procedure Insert_After_Debug;
363 pragma Inline (Insert_After_Debug);
364 -- Output debug information if Debug_Flag_N set
366 ------------------------
367 -- Insert_After_Debug --
368 ------------------------
370 procedure Insert_After_Debug is
373 Write_Str ("Insert node");
374 Write_Int (Int (Node));
375 Write_Str (" after node ");
376 Write_Int (Int (After));
379 end Insert_After_Debug;
381 -- Start of processing for Insert_After
385 (Is_List_Member (After) and then not Is_List_Member (Node));
391 pragma Debug (Insert_After_Debug);
394 Before : constant Node_Or_Entity_Id := Next (After);
395 LC : constant List_Id := List_Containing (After);
398 if Present (Before) then
399 Set_Prev (Before, Node);
404 Set_Next (After, Node);
406 Set_In_List (Node, True);
408 Set_Prev (Node, After);
409 Set_Next (Node, Before);
410 Set_List_Link (Node, LC);
418 procedure Insert_Before
419 (Before : Node_Or_Entity_Id;
420 Node : Node_Or_Entity_Id)
422 procedure Insert_Before_Debug;
423 pragma Inline (Insert_Before_Debug);
424 -- Output debug information if Debug_Flag_N set
426 -------------------------
427 -- Insert_Before_Debug --
428 -------------------------
430 procedure Insert_Before_Debug is
433 Write_Str ("Insert node");
434 Write_Int (Int (Node));
435 Write_Str (" before node ");
436 Write_Int (Int (Before));
439 end Insert_Before_Debug;
441 -- Start of processing for Insert_Before
445 (Is_List_Member (Before) and then not Is_List_Member (Node));
451 pragma Debug (Insert_Before_Debug);
454 After : constant Node_Or_Entity_Id := Prev (Before);
455 LC : constant List_Id := List_Containing (Before);
458 if Present (After) then
459 Set_Next (After, Node);
461 Set_First (LC, Node);
464 Set_Prev (Before, Node);
466 Set_In_List (Node, True);
468 Set_Prev (Node, After);
469 Set_Next (Node, Before);
470 Set_List_Link (Node, LC);
474 -----------------------
475 -- Insert_List_After --
476 -----------------------
478 procedure Insert_List_After (After : Node_Or_Entity_Id; List : List_Id) is
480 procedure Insert_List_After_Debug;
481 pragma Inline (Insert_List_After_Debug);
482 -- Output debug information if Debug_Flag_N set
484 -----------------------------
485 -- Insert_List_After_Debug --
486 -----------------------------
488 procedure Insert_List_After_Debug is
491 Write_Str ("Insert list ");
492 Write_Int (Int (List));
493 Write_Str (" after node ");
494 Write_Int (Int (After));
497 end Insert_List_After_Debug;
499 -- Start of processing for Insert_List_After
502 pragma Assert (Is_List_Member (After));
504 if Is_Empty_List (List) then
509 Before : constant Node_Or_Entity_Id := Next (After);
510 LC : constant List_Id := List_Containing (After);
511 F : constant Node_Or_Entity_Id := First (List);
512 L : constant Node_Or_Entity_Id := Last (List);
513 N : Node_Or_Entity_Id;
516 pragma Debug (Insert_List_After_Debug);
520 Set_List_Link (N, LC);
525 if Present (Before) then
526 Set_Prev (Before, L);
533 Set_Next (L, Before);
535 Set_First (List, Empty);
536 Set_Last (List, Empty);
539 end Insert_List_After;
541 ------------------------
542 -- Insert_List_Before --
543 ------------------------
545 procedure Insert_List_Before (Before : Node_Or_Entity_Id; List : List_Id) is
547 procedure Insert_List_Before_Debug;
548 pragma Inline (Insert_List_Before_Debug);
549 -- Output debug information if Debug_Flag_N set
551 ------------------------------
552 -- Insert_List_Before_Debug --
553 ------------------------------
555 procedure Insert_List_Before_Debug is
558 Write_Str ("Insert list ");
559 Write_Int (Int (List));
560 Write_Str (" before node ");
561 Write_Int (Int (Before));
564 end Insert_List_Before_Debug;
566 -- Start of processing for Insert_List_Before
569 pragma Assert (Is_List_Member (Before));
571 if Is_Empty_List (List) then
576 After : constant Node_Or_Entity_Id := Prev (Before);
577 LC : constant List_Id := List_Containing (Before);
578 F : constant Node_Or_Entity_Id := First (List);
579 L : constant Node_Or_Entity_Id := Last (List);
580 N : Node_Or_Entity_Id;
583 pragma Debug (Insert_List_Before_Debug);
587 Set_List_Link (N, LC);
592 if Present (After) then
598 Set_Prev (Before, L);
600 Set_Next (L, Before);
602 Set_First (List, Empty);
603 Set_Last (List, Empty);
606 end Insert_List_Before;
612 function Is_Empty_List (List : List_Id) return Boolean is
614 return First (List) = Empty;
621 function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean is
623 return In_List (Node);
626 -----------------------
627 -- Is_Non_Empty_List --
628 -----------------------
630 function Is_Non_Empty_List (List : List_Id) return Boolean is
632 return First (List) /= Empty;
633 end Is_Non_Empty_List;
639 function Last (List : List_Id) return Node_Or_Entity_Id is
641 pragma Assert (List <= Lists.Last);
642 return Lists.Table (List).Last;
649 function Last_List_Id return List_Id is
654 ---------------------
655 -- Last_Non_Pragma --
656 ---------------------
658 function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
659 N : constant Node_Or_Entity_Id := Last (List);
661 if Nkind (N) /= N_Pragma then
664 return Prev_Non_Pragma (N);
668 ---------------------
669 -- List_Containing --
670 ---------------------
672 function List_Containing (Node : Node_Or_Entity_Id) return List_Id is
674 pragma Assert (Is_List_Member (Node));
675 return List_Id (Link (Node));
682 function List_Length (List : List_Id) return Nat is
684 Node : Node_Or_Entity_Id;
688 Node := First (List);
689 while Present (Node) loop
690 Result := Result + 1;
701 function Lists_Address return System.Address is
703 return Lists.Table (First_List_Id)'Address;
713 Lists.Locked := True;
715 Prev_Node.Locked := True;
717 Next_Node.Locked := True;
724 procedure Lock_Lists is
726 pragma Assert (not Locked);
734 function New_Copy_List (List : List_Id) return List_Id is
736 E : Node_Or_Entity_Id;
739 if List = No_List then
746 while Present (E) loop
747 Append (New_Copy (E), NL);
755 ----------------------------
756 -- New_Copy_List_Original --
757 ----------------------------
759 function New_Copy_List_Original (List : List_Id) return List_Id is
761 E : Node_Or_Entity_Id;
764 if List = No_List then
771 while Present (E) loop
772 if Comes_From_Source (E) then
773 Append (New_Copy (E), NL);
781 end New_Copy_List_Original;
787 function New_List return List_Id is
789 procedure New_List_Debug;
790 pragma Inline (New_List_Debug);
791 -- Output debugging information if Debug_Flag_N is set
797 procedure New_List_Debug is
800 Write_Str ("Allocate new list, returned ID = ");
801 Write_Int (Int (Lists.Last));
806 -- Start of processing for New_List
809 Lists.Increment_Last;
812 List : constant List_Id := Lists.Last;
815 Set_Parent (List, Empty);
816 Set_First (List, Empty);
817 Set_Last (List, Empty);
819 pragma Debug (New_List_Debug);
824 -- Since the one argument case is common, we optimize to build the right
825 -- list directly, rather than first building an empty list and then doing
826 -- the insertion, which results in some unnecessary work.
828 function New_List (Node : Node_Or_Entity_Id) return List_Id is
830 procedure New_List_Debug;
831 pragma Inline (New_List_Debug);
832 -- Output debugging information if Debug_Flag_N is set
838 procedure New_List_Debug is
841 Write_Str ("Allocate new list, returned ID = ");
842 Write_Int (Int (Lists.Last));
847 -- Start of processing for New_List
854 pragma Assert (not Is_List_Member (Node));
856 Lists.Increment_Last;
859 List : constant List_Id := Lists.Last;
862 Set_Parent (List, Empty);
863 Set_First (List, Node);
864 Set_Last (List, Node);
866 Set_In_List (Node, True);
867 Set_List_Link (Node, List);
868 Set_Prev (Node, Empty);
869 Set_Next (Node, Empty);
870 pragma Debug (New_List_Debug);
877 (Node1 : Node_Or_Entity_Id;
878 Node2 : Node_Or_Entity_Id) return List_Id
880 L : constant List_Id := New_List (Node1);
887 (Node1 : Node_Or_Entity_Id;
888 Node2 : Node_Or_Entity_Id;
889 Node3 : Node_Or_Entity_Id) return List_Id
891 L : constant List_Id := New_List (Node1);
899 (Node1 : Node_Or_Entity_Id;
900 Node2 : Node_Or_Entity_Id;
901 Node3 : Node_Or_Entity_Id;
902 Node4 : Node_Or_Entity_Id) return List_Id
904 L : constant List_Id := New_List (Node1);
913 (Node1 : Node_Or_Entity_Id;
914 Node2 : Node_Or_Entity_Id;
915 Node3 : Node_Or_Entity_Id;
916 Node4 : Node_Or_Entity_Id;
917 Node5 : Node_Or_Entity_Id) return List_Id
919 L : constant List_Id := New_List (Node1);
929 (Node1 : Node_Or_Entity_Id;
930 Node2 : Node_Or_Entity_Id;
931 Node3 : Node_Or_Entity_Id;
932 Node4 : Node_Or_Entity_Id;
933 Node5 : Node_Or_Entity_Id;
934 Node6 : Node_Or_Entity_Id) return List_Id
936 L : constant List_Id := New_List (Node1);
950 function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
952 pragma Assert (Is_List_Member (Node));
953 return Next_Node.Table (Node);
956 procedure Next (Node : in out Node_Or_Entity_Id) is
961 -----------------------
962 -- Next_Node_Address --
963 -----------------------
965 function Next_Node_Address return System.Address is
967 return Next_Node.Table (First_Node_Id)'Address;
968 end Next_Node_Address;
970 ---------------------
971 -- Next_Non_Pragma --
972 ---------------------
974 function Next_Non_Pragma
975 (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
977 N : Node_Or_Entity_Id;
983 exit when Nkind (N) not in N_Pragma | N_Null_Statement;
989 procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id) is
991 Node := Next_Non_Pragma (Node);
998 function No (List : List_Id) return Boolean is
1000 return List = No_List;
1007 function Num_Lists return Nat is
1009 return Int (Lists.Last) - Int (Lists.First) + 1;
1016 function Parent (List : List_Id) return Node_Or_Entity_Id is
1018 pragma Assert (Present (List));
1019 pragma Assert (List <= Lists.Last);
1020 return Lists.Table (List).Parent;
1027 function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id is
1028 Elmt : Node_Or_Entity_Id;
1031 Elmt := First (List);
1032 for J in 1 .. Index - 1 loop
1043 procedure Prepend (Node : Node_Or_Entity_Id; To : List_Id) is
1044 F : constant Node_Or_Entity_Id := First (To);
1046 procedure Prepend_Debug;
1047 pragma Inline (Prepend_Debug);
1048 -- Output debug information if Debug_Flag_N set
1054 procedure Prepend_Debug is
1056 if Debug_Flag_N then
1057 Write_Str ("Prepend node ");
1058 Write_Int (Int (Node));
1059 Write_Str (" to list ");
1060 Write_Int (Int (To));
1065 -- Start of processing for Prepend_Debug
1068 pragma Assert (not Is_List_Member (Node));
1070 if Node = Error then
1074 pragma Debug (Prepend_Debug);
1077 Set_Last (To, Node);
1082 Set_First (To, Node);
1084 Set_In_List (Node, True);
1087 Set_Prev (Node, Empty);
1088 Set_List_Link (Node, To);
1095 procedure Prepend_List (List : List_Id; To : List_Id) is
1097 procedure Prepend_List_Debug;
1098 pragma Inline (Prepend_List_Debug);
1099 -- Output debug information if Debug_Flag_N set
1101 ------------------------
1102 -- Prepend_List_Debug --
1103 ------------------------
1105 procedure Prepend_List_Debug is
1107 if Debug_Flag_N then
1108 Write_Str ("Prepend list ");
1109 Write_Int (Int (List));
1110 Write_Str (" to list ");
1111 Write_Int (Int (To));
1114 end Prepend_List_Debug;
1116 -- Start of processing for Prepend_List
1119 if Is_Empty_List (List) then
1124 F : constant Node_Or_Entity_Id := First (To);
1125 L : constant Node_Or_Entity_Id := Last (List);
1126 N : Node_Or_Entity_Id;
1129 pragma Debug (Prepend_List_Debug);
1133 Set_List_Link (N, To);
1145 Set_First (To, First (List));
1147 Set_First (List, Empty);
1148 Set_Last (List, Empty);
1153 ---------------------
1154 -- Prepend_List_To --
1155 ---------------------
1157 procedure Prepend_List_To (To : List_Id; List : List_Id) is
1159 Prepend_List (List, To);
1160 end Prepend_List_To;
1166 procedure Prepend_New (Node : Node_Or_Entity_Id; To : in out List_Id) is
1175 --------------------
1176 -- Prepend_New_To --
1177 --------------------
1179 procedure Prepend_New_To (To : in out List_Id; Node : Node_Or_Entity_Id) is
1181 Prepend_New (Node, To);
1188 procedure Prepend_To (To : List_Id; Node : Node_Or_Entity_Id) is
1197 function Present (List : List_Id) return Boolean is
1199 return List /= No_List;
1206 function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
1208 pragma Assert (Is_List_Member (Node));
1209 return Prev_Node.Table (Node);
1212 procedure Prev (Node : in out Node_Or_Entity_Id) is
1214 Node := Prev (Node);
1217 -----------------------
1218 -- Prev_Node_Address --
1219 -----------------------
1221 function Prev_Node_Address return System.Address is
1223 return Prev_Node.Table (First_Node_Id)'Address;
1224 end Prev_Node_Address;
1226 ---------------------
1227 -- Prev_Non_Pragma --
1228 ---------------------
1230 function Prev_Non_Pragma
1231 (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
1233 N : Node_Or_Entity_Id;
1239 exit when Nkind (N) /= N_Pragma;
1243 end Prev_Non_Pragma;
1245 procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id) is
1247 Node := Prev_Non_Pragma (Node);
1248 end Prev_Non_Pragma;
1254 procedure Remove (Node : Node_Or_Entity_Id) is
1255 Lst : constant List_Id := List_Containing (Node);
1256 Prv : constant Node_Or_Entity_Id := Prev (Node);
1257 Nxt : constant Node_Or_Entity_Id := Next (Node);
1259 procedure Remove_Debug;
1260 pragma Inline (Remove_Debug);
1261 -- Output debug information if Debug_Flag_N set
1267 procedure Remove_Debug is
1269 if Debug_Flag_N then
1270 Write_Str ("Remove node ");
1271 Write_Int (Int (Node));
1276 -- Start of processing for Remove
1279 pragma Debug (Remove_Debug);
1282 Set_First (Lst, Nxt);
1284 Set_Next (Prv, Nxt);
1288 Set_Last (Lst, Prv);
1290 Set_Prev (Nxt, Prv);
1293 Set_In_List (Node, False);
1294 Set_Parent (Node, Empty);
1301 function Remove_Head (List : List_Id) return Node_Or_Entity_Id is
1302 Frst : constant Node_Or_Entity_Id := First (List);
1304 procedure Remove_Head_Debug;
1305 pragma Inline (Remove_Head_Debug);
1306 -- Output debug information if Debug_Flag_N set
1308 -----------------------
1309 -- Remove_Head_Debug --
1310 -----------------------
1312 procedure Remove_Head_Debug is
1314 if Debug_Flag_N then
1315 Write_Str ("Remove head of list ");
1316 Write_Int (Int (List));
1319 end Remove_Head_Debug;
1321 -- Start of processing for Remove_Head
1324 pragma Debug (Remove_Head_Debug);
1326 if Frst = Empty then
1331 Nxt : constant Node_Or_Entity_Id := Next (Frst);
1334 Set_First (List, Nxt);
1337 Set_Last (List, Empty);
1339 Set_Prev (Nxt, Empty);
1342 Set_In_List (Frst, False);
1343 Set_Parent (Frst, Empty);
1353 function Remove_Next
1354 (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
1356 Nxt : constant Node_Or_Entity_Id := Next (Node);
1358 procedure Remove_Next_Debug;
1359 pragma Inline (Remove_Next_Debug);
1360 -- Output debug information if Debug_Flag_N set
1362 -----------------------
1363 -- Remove_Next_Debug --
1364 -----------------------
1366 procedure Remove_Next_Debug is
1368 if Debug_Flag_N then
1369 Write_Str ("Remove next node after ");
1370 Write_Int (Int (Node));
1373 end Remove_Next_Debug;
1375 -- Start of processing for Remove_Next
1378 if Present (Nxt) then
1380 Nxt2 : constant Node_Or_Entity_Id := Next (Nxt);
1381 LC : constant List_Id := List_Containing (Node);
1384 pragma Debug (Remove_Next_Debug);
1385 Set_Next (Node, Nxt2);
1388 Set_Last (LC, Node);
1390 Set_Prev (Nxt2, Node);
1393 Set_In_List (Nxt, False);
1394 Set_Parent (Nxt, Empty);
1405 procedure Set_First (List : List_Id; To : Node_Or_Entity_Id) is
1407 pragma Assert (not Locked);
1408 Lists.Table (List).First := To;
1415 procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id) is
1417 pragma Assert (not Locked);
1418 Lists.Table (List).Last := To;
1425 procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is
1427 pragma Assert (not Locked);
1428 Set_Link (Node, Union_Id (To));
1435 procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
1437 pragma Assert (not Locked);
1438 Next_Node.Table (Node) := To;
1445 procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id) is
1447 pragma Assert (not Locked);
1448 pragma Assert (List <= Lists.Last);
1449 Lists.Table (List).Parent := Node;
1456 procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
1458 pragma Assert (not Locked);
1459 Prev_Node.Table (Node) := To;
1468 Lists.Locked := False;
1469 Prev_Node.Locked := False;
1470 Next_Node.Locked := False;
1477 procedure Unlock_Lists is
1479 pragma Assert (Locked);