1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2008, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- WARNING: There is a C version of this package. Any changes to this source
35 -- file must be properly reflected in the corresponding C header a-nlists.h
38 with Atree
; use Atree
;
39 with Debug
; use Debug
;
40 with Output
; use Output
;
41 with Sinfo
; use Sinfo
;
44 package body Nlists
is
46 use Atree_Private_Part
;
47 -- Get access to Nodes table
49 ----------------------------------
50 -- Implementation of Node Lists --
51 ----------------------------------
53 -- A node list is represented by a list header which contains
56 type List_Header
is record
58 -- Pointer to first node in list. Empty if list is empty
61 -- Pointer to last node in list. Empty if list is empty
64 -- Pointer to parent of list. Empty if list has no parent
67 -- The node lists are stored in a table indexed by List_Id values
69 package Lists
is new Table
.Table
(
70 Table_Component_Type
=> List_Header
,
71 Table_Index_Type
=> List_Id
'Base,
72 Table_Low_Bound
=> First_List_Id
,
73 Table_Initial
=> Alloc
.Lists_Initial
,
74 Table_Increment
=> Alloc
.Lists_Increment
,
75 Table_Name
=> "Lists");
77 -- The nodes in the list all have the In_List flag set, and their Link
78 -- fields (which otherwise point to the parent) contain the List_Id of
79 -- the list header giving immediate access to the list containing the
80 -- node, and its parent and first and last elements.
82 -- Two auxiliary tables, indexed by Node_Id values and built in parallel
83 -- with the main nodes table and always having the same size contain the
84 -- list link values that allow locating the previous and next node in a
85 -- list. The entries in these tables are valid only if the In_List flag
86 -- is set in the corresponding node. Next_Node is Empty at the end of a
87 -- list and Prev_Node is Empty at the start of a list.
89 package Next_Node
is new Table
.Table
(
90 Table_Component_Type
=> Node_Id
,
91 Table_Index_Type
=> Node_Id
'Base,
92 Table_Low_Bound
=> First_Node_Id
,
93 Table_Initial
=> Alloc
.Orig_Nodes_Initial
,
94 Table_Increment
=> Alloc
.Orig_Nodes_Increment
,
95 Table_Name
=> "Next_Node");
97 package Prev_Node
is new Table
.Table
(
98 Table_Component_Type
=> Node_Id
,
99 Table_Index_Type
=> Node_Id
'Base,
100 Table_Low_Bound
=> First_Node_Id
,
101 Table_Initial
=> Alloc
.Orig_Nodes_Initial
,
102 Table_Increment
=> Alloc
.Orig_Nodes_Increment
,
103 Table_Name
=> "Prev_Node");
105 -----------------------
106 -- Local Subprograms --
107 -----------------------
109 procedure Set_First
(List
: List_Id
; To
: Node_Id
);
110 pragma Inline
(Set_First
);
111 -- Sets First field of list header List to reference To
113 procedure Set_Last
(List
: List_Id
; To
: Node_Id
);
114 pragma Inline
(Set_Last
);
115 -- Sets Last field of list header List to reference To
117 procedure Set_List_Link
(Node
: Node_Id
; To
: List_Id
);
118 pragma Inline
(Set_List_Link
);
119 -- Sets list link of Node to list header To
121 procedure Set_Next
(Node
: Node_Id
; To
: Node_Id
);
122 pragma Inline
(Set_Next
);
123 -- Sets the Next_Node pointer for Node to reference To
125 procedure Set_Prev
(Node
: Node_Id
; To
: Node_Id
);
126 pragma Inline
(Set_Prev
);
127 -- Sets the Prev_Node pointer for Node to reference To
129 --------------------------
130 -- Allocate_List_Tables --
131 --------------------------
133 procedure Allocate_List_Tables
(N
: Node_Id
) is
134 Old_Last
: constant Node_Id
'Base := Next_Node
.Last
;
137 pragma Assert
(N
>= Old_Last
);
138 Next_Node
.Set_Last
(N
);
139 Prev_Node
.Set_Last
(N
);
141 -- Make sure we have no uninitialized junk in any new entires added.
142 -- This ensures that Tree_Gen will not write out any uninitialized junk.
144 for J
in Old_Last
+ 1 .. N
loop
145 Next_Node
.Table
(J
) := Empty
;
146 Prev_Node
.Table
(J
) := Empty
;
148 end Allocate_List_Tables
;
154 procedure Append
(Node
: Node_Id
; To
: List_Id
) is
155 L
: constant Node_Id
:= Last
(To
);
157 procedure Append_Debug
;
158 pragma Inline
(Append_Debug
);
159 -- Output debug information if Debug_Flag_N set
165 procedure Append_Debug
is
168 Write_Str
("Append node ");
169 Write_Int
(Int
(Node
));
170 Write_Str
(" to list ");
171 Write_Int
(Int
(To
));
176 -- Start of processing for Append
179 pragma Assert
(not Is_List_Member
(Node
));
185 pragma Debug
(Append_Debug
);
188 Set_First
(To
, Node
);
195 Nodes
.Table
(Node
).In_List
:= True;
197 Set_Next
(Node
, Empty
);
199 Set_List_Link
(Node
, To
);
206 procedure Append_List
(List
: List_Id
; To
: List_Id
) is
208 procedure Append_List_Debug
;
209 pragma Inline
(Append_List_Debug
);
210 -- Output debug information if Debug_Flag_N set
212 -----------------------
213 -- Append_List_Debug --
214 -----------------------
216 procedure Append_List_Debug
is
219 Write_Str
("Append list ");
220 Write_Int
(Int
(List
));
221 Write_Str
(" to list ");
222 Write_Int
(Int
(To
));
225 end Append_List_Debug
;
227 -- Start of processing for Append_List
230 if Is_Empty_List
(List
) then
235 L
: constant Node_Id
:= Last
(To
);
236 F
: constant Node_Id
:= First
(List
);
240 pragma Debug
(Append_List_Debug
);
244 Set_List_Link
(N
, To
);
256 Set_Last
(To
, Last
(List
));
258 Set_First
(List
, Empty
);
259 Set_Last
(List
, Empty
);
268 procedure Append_List_To
(To
: List_Id
; List
: List_Id
) is
270 Append_List
(List
, To
);
277 procedure Append_To
(To
: List_Id
; Node
: Node_Id
) is
286 function First
(List
: List_Id
) return Node_Id
is
288 if List
= No_List
then
291 pragma Assert
(List
<= Lists
.Last
);
292 return Lists
.Table
(List
).First
;
296 ----------------------
297 -- First_Non_Pragma --
298 ----------------------
300 function First_Non_Pragma
(List
: List_Id
) return Node_Id
is
301 N
: constant Node_Id
:= First
(List
);
303 if Nkind
(N
) /= N_Pragma
305 Nkind
(N
) /= N_Null_Statement
309 return Next_Non_Pragma
(N
);
311 end First_Non_Pragma
;
317 procedure Initialize
is
318 E
: constant List_Id
:= Error_List
;
325 -- Allocate Error_List list header
327 Lists
.Increment_Last
;
328 Set_Parent
(E
, Empty
);
329 Set_First
(E
, Empty
);
337 procedure Insert_After
(After
: Node_Id
; Node
: Node_Id
) is
339 procedure Insert_After_Debug
;
340 pragma Inline
(Insert_After_Debug
);
341 -- Output debug information if Debug_Flag_N set
343 ------------------------
344 -- Insert_After_Debug --
345 ------------------------
347 procedure Insert_After_Debug
is
350 Write_Str
("Insert node");
351 Write_Int
(Int
(Node
));
352 Write_Str
(" after node ");
353 Write_Int
(Int
(After
));
356 end Insert_After_Debug
;
358 -- Start of processing for Insert_After
362 (Is_List_Member
(After
) and then not Is_List_Member
(Node
));
368 pragma Debug
(Insert_After_Debug
);
371 Before
: constant Node_Id
:= Next
(After
);
372 LC
: constant List_Id
:= List_Containing
(After
);
375 if Present
(Before
) then
376 Set_Prev
(Before
, Node
);
381 Set_Next
(After
, Node
);
383 Nodes
.Table
(Node
).In_List
:= True;
385 Set_Prev
(Node
, After
);
386 Set_Next
(Node
, Before
);
387 Set_List_Link
(Node
, LC
);
395 procedure Insert_Before
(Before
: Node_Id
; Node
: Node_Id
) is
397 procedure Insert_Before_Debug
;
398 pragma Inline
(Insert_Before_Debug
);
399 -- Output debug information if Debug_Flag_N set
401 -------------------------
402 -- Insert_Before_Debug --
403 -------------------------
405 procedure Insert_Before_Debug
is
408 Write_Str
("Insert node");
409 Write_Int
(Int
(Node
));
410 Write_Str
(" before node ");
411 Write_Int
(Int
(Before
));
414 end Insert_Before_Debug
;
416 -- Start of processing for Insert_Before
420 (Is_List_Member
(Before
) and then not Is_List_Member
(Node
));
426 pragma Debug
(Insert_Before_Debug
);
429 After
: constant Node_Id
:= Prev
(Before
);
430 LC
: constant List_Id
:= List_Containing
(Before
);
433 if Present
(After
) then
434 Set_Next
(After
, Node
);
436 Set_First
(LC
, Node
);
439 Set_Prev
(Before
, Node
);
441 Nodes
.Table
(Node
).In_List
:= True;
443 Set_Prev
(Node
, After
);
444 Set_Next
(Node
, Before
);
445 Set_List_Link
(Node
, LC
);
449 -----------------------
450 -- Insert_List_After --
451 -----------------------
453 procedure Insert_List_After
(After
: Node_Id
; List
: List_Id
) is
455 procedure Insert_List_After_Debug
;
456 pragma Inline
(Insert_List_After_Debug
);
457 -- Output debug information if Debug_Flag_N set
459 -----------------------------
460 -- Insert_List_After_Debug --
461 -----------------------------
463 procedure Insert_List_After_Debug
is
466 Write_Str
("Insert list ");
467 Write_Int
(Int
(List
));
468 Write_Str
(" after node ");
469 Write_Int
(Int
(After
));
472 end Insert_List_After_Debug
;
474 -- Start of processing for Insert_List_After
477 pragma Assert
(Is_List_Member
(After
));
479 if Is_Empty_List
(List
) then
484 Before
: constant Node_Id
:= Next
(After
);
485 LC
: constant List_Id
:= List_Containing
(After
);
486 F
: constant Node_Id
:= First
(List
);
487 L
: constant Node_Id
:= Last
(List
);
491 pragma Debug
(Insert_List_After_Debug
);
495 Set_List_Link
(N
, LC
);
500 if Present
(Before
) then
501 Set_Prev
(Before
, L
);
508 Set_Next
(L
, Before
);
510 Set_First
(List
, Empty
);
511 Set_Last
(List
, Empty
);
514 end Insert_List_After
;
516 ------------------------
517 -- Insert_List_Before --
518 ------------------------
520 procedure Insert_List_Before
(Before
: Node_Id
; List
: List_Id
) is
522 procedure Insert_List_Before_Debug
;
523 pragma Inline
(Insert_List_Before_Debug
);
524 -- Output debug information if Debug_Flag_N set
526 ------------------------------
527 -- Insert_List_Before_Debug --
528 ------------------------------
530 procedure Insert_List_Before_Debug
is
533 Write_Str
("Insert list ");
534 Write_Int
(Int
(List
));
535 Write_Str
(" before node ");
536 Write_Int
(Int
(Before
));
539 end Insert_List_Before_Debug
;
541 -- Start of processing for Insert_List_Before
544 pragma Assert
(Is_List_Member
(Before
));
546 if Is_Empty_List
(List
) then
551 After
: constant Node_Id
:= Prev
(Before
);
552 LC
: constant List_Id
:= List_Containing
(Before
);
553 F
: constant Node_Id
:= First
(List
);
554 L
: constant Node_Id
:= Last
(List
);
558 pragma Debug
(Insert_List_Before_Debug
);
562 Set_List_Link
(N
, LC
);
567 if Present
(After
) then
573 Set_Prev
(Before
, L
);
575 Set_Next
(L
, Before
);
577 Set_First
(List
, Empty
);
578 Set_Last
(List
, Empty
);
581 end Insert_List_Before
;
587 function Is_Empty_List
(List
: List_Id
) return Boolean is
589 return First
(List
) = Empty
;
596 function Is_List_Member
(Node
: Node_Id
) return Boolean is
598 return Nodes
.Table
(Node
).In_List
;
601 -----------------------
602 -- Is_Non_Empty_List --
603 -----------------------
605 function Is_Non_Empty_List
(List
: List_Id
) return Boolean is
607 return First
(List
) /= Empty
;
608 end Is_Non_Empty_List
;
614 function Last
(List
: List_Id
) return Node_Id
is
616 pragma Assert
(List
<= Lists
.Last
);
617 return Lists
.Table
(List
).Last
;
624 function Last_List_Id
return List_Id
is
629 ---------------------
630 -- Last_Non_Pragma --
631 ---------------------
633 function Last_Non_Pragma
(List
: List_Id
) return Node_Id
is
634 N
: constant Node_Id
:= Last
(List
);
636 if Nkind
(N
) /= N_Pragma
then
639 return Prev_Non_Pragma
(N
);
643 ---------------------
644 -- List_Containing --
645 ---------------------
647 function List_Containing
(Node
: Node_Id
) return List_Id
is
649 pragma Assert
(Is_List_Member
(Node
));
650 return List_Id
(Nodes
.Table
(Node
).Link
);
657 function List_Length
(List
: List_Id
) return Nat
is
663 Node
:= First
(List
);
664 while Present
(Node
) loop
665 Result
:= Result
+ 1;
676 function Lists_Address
return System
.Address
is
678 return Lists
.Table
(First_List_Id
)'Address;
687 Lists
.Locked
:= True;
690 Prev_Node
.Locked
:= True;
691 Next_Node
.Locked
:= True;
701 function New_Copy_List
(List
: List_Id
) return List_Id
is
706 if List
= No_List
then
713 while Present
(E
) loop
714 Append
(New_Copy
(E
), NL
);
722 ----------------------------
723 -- New_Copy_List_Original --
724 ----------------------------
726 function New_Copy_List_Original
(List
: List_Id
) return List_Id
is
731 if List
= No_List
then
738 while Present
(E
) loop
739 if Comes_From_Source
(E
) then
740 Append
(New_Copy
(E
), NL
);
748 end New_Copy_List_Original
;
750 ------------------------
751 -- New_Copy_List_Tree --
752 ------------------------
754 function New_Copy_List_Tree
(List
: List_Id
) return List_Id
is
759 if List
= No_List
then
766 while Present
(E
) loop
767 Append
(New_Copy_Tree
(E
), NL
);
773 end New_Copy_List_Tree
;
779 function New_List
return List_Id
is
781 procedure New_List_Debug
;
782 pragma Inline
(New_List_Debug
);
783 -- Output debugging information if Debug_Flag_N is set
789 procedure New_List_Debug
is
792 Write_Str
("Allocate new list, returned ID = ");
793 Write_Int
(Int
(Lists
.Last
));
798 -- Start of processing for New_List
801 Lists
.Increment_Last
;
804 List
: constant List_Id
:= Lists
.Last
;
807 Set_Parent
(List
, Empty
);
808 Set_First
(List
, Empty
);
809 Set_Last
(List
, Empty
);
811 pragma Debug
(New_List_Debug
);
816 -- Since the one argument case is common, we optimize to build the right
817 -- list directly, rather than first building an empty list and then doing
818 -- the insertion, which results in some unnecessary work.
820 function New_List
(Node
: Node_Id
) return List_Id
is
822 procedure New_List_Debug
;
823 pragma Inline
(New_List_Debug
);
824 -- Output debugging information if Debug_Flag_N is set
830 procedure New_List_Debug
is
833 Write_Str
("Allocate new list, returned ID = ");
834 Write_Int
(Int
(Lists
.Last
));
839 -- Start of processing for New_List
846 pragma Assert
(not Is_List_Member
(Node
));
848 Lists
.Increment_Last
;
851 List
: constant List_Id
:= Lists
.Last
;
854 Set_Parent
(List
, Empty
);
855 Set_First
(List
, Node
);
856 Set_Last
(List
, Node
);
858 Nodes
.Table
(Node
).In_List
:= True;
859 Set_List_Link
(Node
, List
);
860 Set_Prev
(Node
, Empty
);
861 Set_Next
(Node
, Empty
);
862 pragma Debug
(New_List_Debug
);
868 function New_List
(Node1
, Node2
: Node_Id
) return List_Id
is
869 L
: constant List_Id
:= New_List
(Node1
);
875 function New_List
(Node1
, Node2
, Node3
: Node_Id
) return List_Id
is
876 L
: constant List_Id
:= New_List
(Node1
);
883 function New_List
(Node1
, Node2
, Node3
, Node4
: Node_Id
) return List_Id
is
884 L
: constant List_Id
:= New_List
(Node1
);
897 Node5
: Node_Id
) return List_Id
899 L
: constant List_Id
:= New_List
(Node1
);
914 Node6
: Node_Id
) return List_Id
916 L
: constant List_Id
:= New_List
(Node1
);
930 function Next
(Node
: Node_Id
) return Node_Id
is
932 pragma Assert
(Is_List_Member
(Node
));
933 return Next_Node
.Table
(Node
);
936 procedure Next
(Node
: in out Node_Id
) is
941 -----------------------
942 -- Next_Node_Address --
943 -----------------------
945 function Next_Node_Address
return System
.Address
is
947 return Next_Node
.Table
(First_Node_Id
)'Address;
948 end Next_Node_Address
;
950 ---------------------
951 -- Next_Non_Pragma --
952 ---------------------
954 function Next_Non_Pragma
(Node
: Node_Id
) return Node_Id
is
961 exit when Nkind
(N
) /= N_Pragma
963 Nkind
(N
) /= N_Null_Statement
;
969 procedure Next_Non_Pragma
(Node
: in out Node_Id
) is
971 Node
:= Next_Non_Pragma
(Node
);
978 function No
(List
: List_Id
) return Boolean is
980 return List
= No_List
;
987 function Num_Lists
return Nat
is
989 return Int
(Lists
.Last
) - Int
(Lists
.First
) + 1;
996 function p
(U
: Union_Id
) return Node_Id
is
998 if U
in Node_Range
then
999 return Parent
(Node_Id
(U
));
1000 elsif U
in List_Range
then
1001 return Parent
(List_Id
(U
));
1011 function Parent
(List
: List_Id
) return Node_Id
is
1013 pragma Assert
(List
<= Lists
.Last
);
1014 return Lists
.Table
(List
).Parent
;
1021 function Pick
(List
: List_Id
; Index
: Pos
) return Node_Id
is
1025 Elmt
:= First
(List
);
1026 for J
in 1 .. Index
- 1 loop
1027 Elmt
:= Next
(Elmt
);
1037 procedure Prepend
(Node
: Node_Id
; To
: List_Id
) is
1038 F
: constant Node_Id
:= First
(To
);
1040 procedure Prepend_Debug
;
1041 pragma Inline
(Prepend_Debug
);
1042 -- Output debug information if Debug_Flag_N set
1048 procedure Prepend_Debug
is
1050 if Debug_Flag_N
then
1051 Write_Str
("Prepend node ");
1052 Write_Int
(Int
(Node
));
1053 Write_Str
(" to list ");
1054 Write_Int
(Int
(To
));
1059 -- Start of processing for Prepend_Debug
1062 pragma Assert
(not Is_List_Member
(Node
));
1064 if Node
= Error
then
1068 pragma Debug
(Prepend_Debug
);
1071 Set_Last
(To
, Node
);
1076 Set_First
(To
, Node
);
1078 Nodes
.Table
(Node
).In_List
:= True;
1081 Set_Prev
(Node
, Empty
);
1082 Set_List_Link
(Node
, To
);
1089 procedure Prepend_To
(To
: List_Id
; Node
: Node_Id
) is
1098 function Present
(List
: List_Id
) return Boolean is
1100 return List
/= No_List
;
1107 function Prev
(Node
: Node_Id
) return Node_Id
is
1109 pragma Assert
(Is_List_Member
(Node
));
1110 return Prev_Node
.Table
(Node
);
1113 procedure Prev
(Node
: in out Node_Id
) is
1115 Node
:= Prev
(Node
);
1118 -----------------------
1119 -- Prev_Node_Address --
1120 -----------------------
1122 function Prev_Node_Address
return System
.Address
is
1124 return Prev_Node
.Table
(First_Node_Id
)'Address;
1125 end Prev_Node_Address
;
1127 ---------------------
1128 -- Prev_Non_Pragma --
1129 ---------------------
1131 function Prev_Non_Pragma
(Node
: Node_Id
) return Node_Id
is
1138 exit when Nkind
(N
) /= N_Pragma
;
1142 end Prev_Non_Pragma
;
1144 procedure Prev_Non_Pragma
(Node
: in out Node_Id
) is
1146 Node
:= Prev_Non_Pragma
(Node
);
1147 end Prev_Non_Pragma
;
1153 procedure Remove
(Node
: Node_Id
) is
1154 Lst
: constant List_Id
:= List_Containing
(Node
);
1155 Prv
: constant Node_Id
:= Prev
(Node
);
1156 Nxt
: constant Node_Id
:= Next
(Node
);
1158 procedure Remove_Debug
;
1159 pragma Inline
(Remove_Debug
);
1160 -- Output debug information if Debug_Flag_N set
1166 procedure Remove_Debug
is
1168 if Debug_Flag_N
then
1169 Write_Str
("Remove node ");
1170 Write_Int
(Int
(Node
));
1175 -- Start of processing for Remove
1178 pragma Debug
(Remove_Debug
);
1181 Set_First
(Lst
, Nxt
);
1183 Set_Next
(Prv
, Nxt
);
1187 Set_Last
(Lst
, Prv
);
1189 Set_Prev
(Nxt
, Prv
);
1192 Nodes
.Table
(Node
).In_List
:= False;
1193 Set_Parent
(Node
, Empty
);
1200 function Remove_Head
(List
: List_Id
) return Node_Id
is
1201 Frst
: constant Node_Id
:= First
(List
);
1203 procedure Remove_Head_Debug
;
1204 pragma Inline
(Remove_Head_Debug
);
1205 -- Output debug information if Debug_Flag_N set
1207 -----------------------
1208 -- Remove_Head_Debug --
1209 -----------------------
1211 procedure Remove_Head_Debug
is
1213 if Debug_Flag_N
then
1214 Write_Str
("Remove head of list ");
1215 Write_Int
(Int
(List
));
1218 end Remove_Head_Debug
;
1220 -- Start of processing for Remove_Head
1223 pragma Debug
(Remove_Head_Debug
);
1225 if Frst
= Empty
then
1230 Nxt
: constant Node_Id
:= Next
(Frst
);
1233 Set_First
(List
, Nxt
);
1236 Set_Last
(List
, Empty
);
1238 Set_Prev
(Nxt
, Empty
);
1241 Nodes
.Table
(Frst
).In_List
:= False;
1242 Set_Parent
(Frst
, Empty
);
1252 function Remove_Next
(Node
: Node_Id
) return Node_Id
is
1253 Nxt
: constant Node_Id
:= Next
(Node
);
1255 procedure Remove_Next_Debug
;
1256 pragma Inline
(Remove_Next_Debug
);
1257 -- Output debug information if Debug_Flag_N set
1259 -----------------------
1260 -- Remove_Next_Debug --
1261 -----------------------
1263 procedure Remove_Next_Debug
is
1265 if Debug_Flag_N
then
1266 Write_Str
("Remove next node after ");
1267 Write_Int
(Int
(Node
));
1270 end Remove_Next_Debug
;
1272 -- Start of processing for Remove_Next
1275 if Present
(Nxt
) then
1277 Nxt2
: constant Node_Id
:= Next
(Nxt
);
1278 LC
: constant List_Id
:= List_Containing
(Node
);
1281 pragma Debug
(Remove_Next_Debug
);
1282 Set_Next
(Node
, Nxt2
);
1285 Set_Last
(LC
, Node
);
1287 Set_Prev
(Nxt2
, Node
);
1290 Nodes
.Table
(Nxt
).In_List
:= False;
1291 Set_Parent
(Nxt
, Empty
);
1302 procedure Set_First
(List
: List_Id
; To
: Node_Id
) is
1304 Lists
.Table
(List
).First
:= To
;
1311 procedure Set_Last
(List
: List_Id
; To
: Node_Id
) is
1313 Lists
.Table
(List
).Last
:= To
;
1320 procedure Set_List_Link
(Node
: Node_Id
; To
: List_Id
) is
1322 Nodes
.Table
(Node
).Link
:= Union_Id
(To
);
1329 procedure Set_Next
(Node
: Node_Id
; To
: Node_Id
) is
1331 Next_Node
.Table
(Node
) := To
;
1338 procedure Set_Parent
(List
: List_Id
; Node
: Node_Id
) is
1340 pragma Assert
(List
<= Lists
.Last
);
1341 Lists
.Table
(List
).Parent
:= Node
;
1348 procedure Set_Prev
(Node
: Node_Id
; To
: Node_Id
) is
1350 Prev_Node
.Table
(Node
) := To
;
1357 procedure Tree_Read
is
1360 Next_Node
.Tree_Read
;
1361 Prev_Node
.Tree_Read
;
1368 procedure Tree_Write
is
1371 Next_Node
.Tree_Write
;
1372 Prev_Node
.Tree_Write
;
1381 Lists
.Locked
:= False;
1382 Prev_Node
.Locked
:= False;
1383 Next_Node
.Locked
:= False;