1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 -- WARNING: There is a C version of this package. Any changes to this source
36 -- file must be properly reflected in the corresponding C header a-nlists.h
39 with Atree
; use Atree
;
40 with Debug
; use Debug
;
41 with Output
; use Output
;
42 with Sinfo
; use Sinfo
;
45 package body Nlists
is
47 use Atree_Private_Part
;
48 -- Get access to Nodes table
50 ----------------------------------
51 -- Implementation of Node Lists --
52 ----------------------------------
54 -- A node list is represented by a list header which contains
57 type List_Header
is record
59 -- Pointer to first node in list. Empty if list is empty
62 -- Pointer to last node in list. Empty if list is empty
65 -- Pointer to parent of list. Empty if list has no parent
68 -- The node lists are stored in a table indexed by List_Id values
70 package Lists
is new Table
.Table
(
71 Table_Component_Type
=> List_Header
,
72 Table_Index_Type
=> List_Id
,
73 Table_Low_Bound
=> First_List_Id
,
74 Table_Initial
=> Alloc
.Lists_Initial
,
75 Table_Increment
=> Alloc
.Lists_Increment
,
76 Table_Name
=> "Lists");
78 -- The nodes in the list all have the In_List flag set, and their Link
79 -- fields (which otherwise point to the parent) contain the List_Id of
80 -- the list header giving immediate access to the list containing the
81 -- node, and its parent and first and last elements.
83 -- Two auxiliary tables, indexed by Node_Id values and built in parallel
84 -- with the main nodes table and always having the same size contain the
85 -- list link values that allow locating the previous and next node in a
86 -- list. The entries in these tables are valid only if the In_List flag
87 -- is set in the corresponding node. Next_Node is Empty at the end of a
88 -- list and Prev_Node is Empty at the start of a list.
90 package Next_Node
is new Table
.Table
(
91 Table_Component_Type
=> Node_Id
,
92 Table_Index_Type
=> Node_Id
,
93 Table_Low_Bound
=> First_Node_Id
,
94 Table_Initial
=> Alloc
.Orig_Nodes_Initial
,
95 Table_Increment
=> Alloc
.Orig_Nodes_Increment
,
96 Table_Name
=> "Next_Node");
98 package Prev_Node
is new Table
.Table
(
99 Table_Component_Type
=> Node_Id
,
100 Table_Index_Type
=> Node_Id
,
101 Table_Low_Bound
=> First_Node_Id
,
102 Table_Initial
=> Alloc
.Orig_Nodes_Initial
,
103 Table_Increment
=> Alloc
.Orig_Nodes_Increment
,
104 Table_Name
=> "Prev_Node");
106 -----------------------
107 -- Local Subprograms --
108 -----------------------
110 procedure Prepend_Debug
(Node
: Node_Id
; To
: List_Id
);
111 pragma Inline
(Prepend_Debug
);
112 -- Output debug information if Debug_Flag_N set
114 procedure Remove_Next_Debug
(Node
: Node_Id
);
115 pragma Inline
(Remove_Next_Debug
);
116 -- Output debug information if Debug_Flag_N set
118 procedure Set_First
(List
: List_Id
; To
: Node_Id
);
119 pragma Inline
(Set_First
);
120 -- Sets First field of list header List to reference To
122 procedure Set_Last
(List
: List_Id
; To
: Node_Id
);
123 pragma Inline
(Set_Last
);
124 -- Sets Last field of list header List to reference To
126 procedure Set_List_Link
(Node
: Node_Id
; To
: List_Id
);
127 pragma Inline
(Set_List_Link
);
128 -- Sets list link of Node to list header To
130 procedure Set_Next
(Node
: Node_Id
; To
: Node_Id
);
131 pragma Inline
(Set_Next
);
132 -- Sets the Next_Node pointer for Node to reference To
134 procedure Set_Prev
(Node
: Node_Id
; To
: Node_Id
);
135 pragma Inline
(Set_Prev
);
136 -- Sets the Prev_Node pointer for Node to reference To
138 --------------------------
139 -- Allocate_List_Tables --
140 --------------------------
142 procedure Allocate_List_Tables
(N
: Node_Id
) is
144 Next_Node
.Set_Last
(N
);
145 Prev_Node
.Set_Last
(N
);
146 end Allocate_List_Tables
;
152 procedure Append
(Node
: Node_Id
; To
: List_Id
) is
153 L
: constant Node_Id
:= Last
(To
);
155 procedure Append_Debug
;
156 pragma Inline
(Append_Debug
);
157 -- Output debug information if Debug_Flag_N set
159 procedure Append_Debug
is
162 Write_Str
("Append node ");
163 Write_Int
(Int
(Node
));
164 Write_Str
(" to list ");
165 Write_Int
(Int
(To
));
170 -- Start of processing for Append
173 pragma Assert
(not Is_List_Member
(Node
));
179 pragma Debug
(Append_Debug
);
182 Set_First
(To
, Node
);
189 Nodes
.Table
(Node
).In_List
:= True;
191 Set_Next
(Node
, Empty
);
193 Set_List_Link
(Node
, To
);
200 procedure Append_List
(List
: List_Id
; To
: List_Id
) is
202 procedure Append_List_Debug
;
203 pragma Inline
(Append_List_Debug
);
204 -- Output debug information if Debug_Flag_N set
206 procedure Append_List_Debug
is
209 Write_Str
("Append list ");
210 Write_Int
(Int
(List
));
211 Write_Str
(" to list ");
212 Write_Int
(Int
(To
));
215 end Append_List_Debug
;
217 -- Start of processing for Append_List
220 if Is_Empty_List
(List
) then
225 L
: constant Node_Id
:= Last
(To
);
226 F
: constant Node_Id
:= First
(List
);
230 pragma Debug
(Append_List_Debug
);
234 Set_List_Link
(N
, To
);
246 Set_Last
(To
, Last
(List
));
248 Set_First
(List
, Empty
);
249 Set_Last
(List
, Empty
);
258 procedure Append_List_To
(To
: List_Id
; List
: List_Id
) is
260 Append_List
(List
, To
);
267 procedure Append_To
(To
: List_Id
; Node
: Node_Id
) is
276 procedure Delete_List
(L
: List_Id
) is
280 while Is_Non_Empty_List
(L
) loop
281 N
:= Remove_Head
(L
);
285 -- Should recycle list header???
292 -- This subprogram is deliberately placed early on, out of alphabetical
293 -- order, so that it can be properly inlined from within this unit.
295 function First
(List
: List_Id
) return Node_Id
is
297 if List
= No_List
then
300 pragma Assert
(List
in First_List_Id
.. Lists
.Last
);
301 return Lists
.Table
(List
).First
;
305 ----------------------
306 -- First_Non_Pragma --
307 ----------------------
309 function First_Non_Pragma
(List
: List_Id
) return Node_Id
is
310 N
: constant Node_Id
:= First
(List
);
313 if Nkind
(N
) /= N_Pragma
315 Nkind
(N
) /= N_Null_Statement
319 return Next_Non_Pragma
(N
);
321 end First_Non_Pragma
;
327 procedure Initialize
is
328 E
: constant List_Id
:= Error_List
;
335 -- Allocate Error_List list header
337 Lists
.Increment_Last
;
338 Set_Parent
(E
, Empty
);
339 Set_First
(E
, Empty
);
347 procedure Insert_After
(After
: Node_Id
; Node
: Node_Id
) is
349 procedure Insert_After_Debug
;
350 pragma Inline
(Insert_After_Debug
);
351 -- Output debug information if Debug_Flag_N set
353 procedure Insert_After_Debug
is
356 Write_Str
("Insert node");
357 Write_Int
(Int
(Node
));
358 Write_Str
(" after node ");
359 Write_Int
(Int
(After
));
362 end Insert_After_Debug
;
364 -- Start of processing for Insert_After
368 (Is_List_Member
(After
) and then not Is_List_Member
(Node
));
374 pragma Debug
(Insert_After_Debug
);
377 Before
: constant Node_Id
:= Next
(After
);
378 LC
: constant List_Id
:= List_Containing
(After
);
381 if Present
(Before
) then
382 Set_Prev
(Before
, Node
);
387 Set_Next
(After
, Node
);
389 Nodes
.Table
(Node
).In_List
:= True;
391 Set_Prev
(Node
, After
);
392 Set_Next
(Node
, Before
);
393 Set_List_Link
(Node
, LC
);
401 procedure Insert_Before
(Before
: Node_Id
; Node
: Node_Id
) is
403 procedure Insert_Before_Debug
;
404 pragma Inline
(Insert_Before_Debug
);
405 -- Output debug information if Debug_Flag_N set
407 procedure Insert_Before_Debug
is
410 Write_Str
("Insert node");
411 Write_Int
(Int
(Node
));
412 Write_Str
(" before node ");
413 Write_Int
(Int
(Before
));
416 end Insert_Before_Debug
;
418 -- Start of processing for Insert_Before
422 (Is_List_Member
(Before
) and then not Is_List_Member
(Node
));
428 pragma Debug
(Insert_Before_Debug
);
431 After
: constant Node_Id
:= Prev
(Before
);
432 LC
: constant List_Id
:= List_Containing
(Before
);
435 if Present
(After
) then
436 Set_Next
(After
, Node
);
438 Set_First
(LC
, Node
);
441 Set_Prev
(Before
, Node
);
443 Nodes
.Table
(Node
).In_List
:= True;
445 Set_Prev
(Node
, After
);
446 Set_Next
(Node
, Before
);
447 Set_List_Link
(Node
, LC
);
451 -----------------------
452 -- Insert_List_After --
453 -----------------------
455 procedure Insert_List_After
(After
: Node_Id
; List
: List_Id
) is
457 procedure Insert_List_After_Debug
;
458 pragma Inline
(Insert_List_After_Debug
);
459 -- Output debug information if Debug_Flag_N set
461 procedure Insert_List_After_Debug
is
464 Write_Str
("Insert list ");
465 Write_Int
(Int
(List
));
466 Write_Str
(" after node ");
467 Write_Int
(Int
(After
));
470 end Insert_List_After_Debug
;
472 -- Start of processing for Insert_List_After
475 pragma Assert
(Is_List_Member
(After
));
477 if Is_Empty_List
(List
) then
482 Before
: constant Node_Id
:= Next
(After
);
483 LC
: constant List_Id
:= List_Containing
(After
);
484 F
: constant Node_Id
:= First
(List
);
485 L
: constant Node_Id
:= Last
(List
);
489 pragma Debug
(Insert_List_After_Debug
);
493 Set_List_Link
(N
, LC
);
498 if Present
(Before
) then
499 Set_Prev
(Before
, L
);
506 Set_Next
(L
, Before
);
508 Set_First
(List
, Empty
);
509 Set_Last
(List
, Empty
);
512 end Insert_List_After
;
514 ------------------------
515 -- Insert_List_Before --
516 ------------------------
518 procedure Insert_List_Before
(Before
: Node_Id
; List
: List_Id
) is
520 procedure Insert_List_Before_Debug
;
521 pragma Inline
(Insert_List_Before_Debug
);
522 -- Output debug information if Debug_Flag_N set
524 procedure Insert_List_Before_Debug
is
527 Write_Str
("Insert list ");
528 Write_Int
(Int
(List
));
529 Write_Str
(" before node ");
530 Write_Int
(Int
(Before
));
533 end Insert_List_Before_Debug
;
535 -- Start of prodcessing for Insert_List_Before
538 pragma Assert
(Is_List_Member
(Before
));
540 if Is_Empty_List
(List
) then
545 After
: constant Node_Id
:= Prev
(Before
);
546 LC
: constant List_Id
:= List_Containing
(Before
);
547 F
: constant Node_Id
:= First
(List
);
548 L
: constant Node_Id
:= Last
(List
);
552 pragma Debug
(Insert_List_Before_Debug
);
556 Set_List_Link
(N
, LC
);
561 if Present
(After
) then
567 Set_Prev
(Before
, L
);
569 Set_Next
(L
, Before
);
571 Set_First
(List
, Empty
);
572 Set_Last
(List
, Empty
);
575 end Insert_List_Before
;
581 function Is_Empty_List
(List
: List_Id
) return Boolean is
583 return First
(List
) = Empty
;
590 function Is_List_Member
(Node
: Node_Id
) return Boolean is
592 return Nodes
.Table
(Node
).In_List
;
595 -----------------------
596 -- Is_Non_Empty_List --
597 -----------------------
599 function Is_Non_Empty_List
(List
: List_Id
) return Boolean is
601 return List
/= No_List
and then First
(List
) /= Empty
;
602 end Is_Non_Empty_List
;
608 -- This subprogram is deliberately placed early on, out of alphabetical
609 -- order, so that it can be properly inlined from within this unit.
611 function Last
(List
: List_Id
) return Node_Id
is
613 pragma Assert
(List
in First_List_Id
.. Lists
.Last
);
614 return Lists
.Table
(List
).Last
;
621 function Last_List_Id
return List_Id
is
626 ---------------------
627 -- Last_Non_Pragma --
628 ---------------------
630 function Last_Non_Pragma
(List
: List_Id
) return Node_Id
is
631 N
: constant Node_Id
:= Last
(List
);
634 if Nkind
(N
) /= N_Pragma
then
637 return Prev_Non_Pragma
(N
);
641 ---------------------
642 -- List_Containing --
643 ---------------------
645 function List_Containing
(Node
: Node_Id
) return List_Id
is
647 pragma Assert
(Is_List_Member
(Node
));
648 return List_Id
(Nodes
.Table
(Node
).Link
);
655 function List_Length
(List
: List_Id
) return Nat
is
661 Node
:= First
(List
);
662 while Present
(Node
) loop
663 Result
:= Result
+ 1;
674 function Lists_Address
return System
.Address
is
676 return Lists
.Table
(First_List_Id
)'Address;
685 Lists
.Locked
:= True;
688 Prev_Node
.Locked
:= True;
689 Next_Node
.Locked
:= True;
699 function New_Copy_List
(List
: List_Id
) return List_Id
is
704 if List
= No_List
then
711 while Present
(E
) loop
712 Append
(New_Copy
(E
), NL
);
720 ----------------------------
721 -- New_Copy_List_Original --
722 ----------------------------
724 function New_Copy_List_Original
(List
: List_Id
) return List_Id
is
729 if List
= No_List
then
736 while Present
(E
) loop
737 if Comes_From_Source
(E
) then
738 Append
(New_Copy
(E
), NL
);
746 end New_Copy_List_Original
;
748 ------------------------
749 -- New_Copy_List_Tree --
750 ------------------------
752 function New_Copy_List_Tree
(List
: List_Id
) return List_Id
is
757 if List
= No_List
then
764 while Present
(E
) loop
765 Append
(New_Copy_Tree
(E
), NL
);
771 end New_Copy_List_Tree
;
777 function New_List
return List_Id
is
779 procedure New_List_Debug
;
780 pragma Inline
(New_List_Debug
);
781 -- Output debugging information if Debug_Flag_N is set
783 procedure New_List_Debug
is
786 Write_Str
("Allocate new list, returned ID = ");
787 Write_Int
(Int
(Lists
.Last
));
792 -- Start of processing for New_List
795 Lists
.Increment_Last
;
798 List
: constant List_Id
:= Lists
.Last
;
801 Set_Parent
(List
, Empty
);
802 Set_First
(List
, Empty
);
803 Set_Last
(List
, Empty
);
805 pragma Debug
(New_List_Debug
);
810 -- Since the one argument case is common, we optimize to build the right
811 -- list directly, rather than first building an empty list and then doing
812 -- the insertion, which results in some unnecessary work.
814 function New_List
(Node
: Node_Id
) return List_Id
is
816 procedure New_List_Debug
;
817 pragma Inline
(New_List_Debug
);
818 -- Output debugging information if Debug_Flag_N is set
820 procedure New_List_Debug
is
823 Write_Str
("Allocate new list, returned ID = ");
824 Write_Int
(Int
(Lists
.Last
));
829 -- Start of processing for New_List
836 pragma Assert
(not Is_List_Member
(Node
));
838 Lists
.Increment_Last
;
841 List
: constant List_Id
:= Lists
.Last
;
844 Set_Parent
(List
, Empty
);
845 Set_First
(List
, Node
);
846 Set_Last
(List
, Node
);
848 Nodes
.Table
(Node
).In_List
:= True;
849 Set_List_Link
(Node
, List
);
850 Set_Prev
(Node
, Empty
);
851 Set_Next
(Node
, Empty
);
852 pragma Debug
(New_List_Debug
);
858 function New_List
(Node1
, Node2
: Node_Id
) return List_Id
is
859 L
: constant List_Id
:= New_List
(Node1
);
866 function New_List
(Node1
, Node2
, Node3
: Node_Id
) return List_Id
is
867 L
: constant List_Id
:= New_List
(Node1
);
875 function New_List
(Node1
, Node2
, Node3
, Node4
: Node_Id
) return List_Id
is
876 L
: constant List_Id
:= New_List
(Node1
);
893 L
: constant List_Id
:= New_List
(Node1
);
912 L
: constant List_Id
:= New_List
(Node1
);
927 -- This subprogram is deliberately placed early on, out of alphabetical
928 -- order, so that it can be properly inlined from within this unit.
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 -- This subprogram is deliberately placed early on, out of alphabetical
979 -- order, so that it can be properly inlined from within this unit.
981 function No
(List
: List_Id
) return Boolean is
983 return List
= No_List
;
990 function Num_Lists
return Nat
is
992 return Int
(Lists
.Last
) - Int
(Lists
.First
) + 1;
999 function p
(U
: Union_Id
) return Node_Id
is
1001 if U
in Node_Range
then
1002 return Parent
(Node_Id
(U
));
1004 elsif U
in List_Range
then
1005 return Parent
(List_Id
(U
));
1016 function Parent
(List
: List_Id
) return Node_Id
is
1018 pragma Assert
(List
in First_List_Id
.. Lists
.Last
);
1019 return Lists
.Table
(List
).Parent
;
1026 function Pick
(List
: List_Id
; Index
: Pos
) return Node_Id
is
1030 Elmt
:= First
(List
);
1031 for J
in 1 .. Index
- 1 loop
1032 Elmt
:= Next
(Elmt
);
1042 procedure Prepend
(Node
: Node_Id
; To
: List_Id
) is
1043 F
: constant Node_Id
:= First
(To
);
1046 pragma Assert
(not Is_List_Member
(Node
));
1048 if Node
= Error
then
1052 pragma Debug
(Prepend_Debug
(Node
, To
));
1055 Set_Last
(To
, Node
);
1060 Set_First
(To
, Node
);
1062 Nodes
.Table
(Node
).In_List
:= True;
1065 Set_Prev
(Node
, Empty
);
1066 Set_List_Link
(Node
, To
);
1073 procedure Prepend_Debug
(Node
: Node_Id
; To
: List_Id
) is
1075 if Debug_Flag_N
then
1076 Write_Str
("Prepend node ");
1077 Write_Int
(Int
(Node
));
1078 Write_Str
(" to list ");
1079 Write_Int
(Int
(To
));
1088 procedure Prepend_To
(To
: List_Id
; Node
: Node_Id
) is
1097 function Present
(List
: List_Id
) return Boolean is
1099 return List
/= No_List
;
1106 -- This subprogram is deliberately placed early on, out of alphabetical
1107 -- order, so that it can be properly inlined from within this unit.
1109 function Prev
(Node
: Node_Id
) return Node_Id
is
1111 pragma Assert
(Is_List_Member
(Node
));
1112 return Prev_Node
.Table
(Node
);
1115 procedure Prev
(Node
: in out Node_Id
) is
1117 Node
:= Prev
(Node
);
1120 -----------------------
1121 -- Prev_Node_Address --
1122 -----------------------
1124 function Prev_Node_Address
return System
.Address
is
1126 return Prev_Node
.Table
(First_Node_Id
)'Address;
1127 end Prev_Node_Address
;
1129 ---------------------
1130 -- Prev_Non_Pragma --
1131 ---------------------
1133 function Prev_Non_Pragma
(Node
: Node_Id
) return Node_Id
is
1140 exit when Nkind
(N
) /= N_Pragma
;
1144 end Prev_Non_Pragma
;
1146 procedure Prev_Non_Pragma
(Node
: in out Node_Id
) is
1148 Node
:= Prev_Non_Pragma
(Node
);
1149 end Prev_Non_Pragma
;
1155 procedure Remove
(Node
: Node_Id
) is
1156 Lst
: constant List_Id
:= List_Containing
(Node
);
1157 Prv
: constant Node_Id
:= Prev
(Node
);
1158 Nxt
: constant Node_Id
:= Next
(Node
);
1160 procedure Remove_Debug
;
1161 pragma Inline
(Remove_Debug
);
1162 -- Output debug information if Debug_Flag_N set
1164 procedure Remove_Debug
is
1166 if Debug_Flag_N
then
1167 Write_Str
("Remove node ");
1168 Write_Int
(Int
(Node
));
1173 -- Start of processing for Remove
1176 pragma Debug
(Remove_Debug
);
1179 Set_First
(Lst
, Nxt
);
1181 Set_Next
(Prv
, Nxt
);
1185 Set_Last
(Lst
, Prv
);
1187 Set_Prev
(Nxt
, Prv
);
1190 Nodes
.Table
(Node
).In_List
:= False;
1191 Set_Parent
(Node
, Empty
);
1198 function Remove_Head
(List
: List_Id
) return Node_Id
is
1199 Frst
: constant Node_Id
:= First
(List
);
1201 procedure Remove_Head_Debug
;
1202 pragma Inline
(Remove_Head_Debug
);
1203 -- Output debug information if Debug_Flag_N set
1205 procedure Remove_Head_Debug
is
1207 if Debug_Flag_N
then
1208 Write_Str
("Remove head of list ");
1209 Write_Int
(Int
(List
));
1212 end Remove_Head_Debug
;
1214 -- Start of processing for Remove_Head
1217 pragma Debug
(Remove_Head_Debug
);
1219 if Frst
= Empty
then
1224 Nxt
: constant Node_Id
:= Next
(Frst
);
1227 Set_First
(List
, Nxt
);
1230 Set_Last
(List
, Empty
);
1232 Set_Prev
(Nxt
, Empty
);
1235 Nodes
.Table
(Frst
).In_List
:= False;
1236 Set_Parent
(Frst
, Empty
);
1246 function Remove_Next
(Node
: Node_Id
) return Node_Id
is
1247 Nxt
: constant Node_Id
:= Next
(Node
);
1250 if Present
(Nxt
) then
1252 Nxt2
: constant Node_Id
:= Next
(Nxt
);
1253 LC
: constant List_Id
:= List_Containing
(Node
);
1256 pragma Debug
(Remove_Next_Debug
(Node
));
1257 Set_Next
(Node
, Nxt2
);
1260 Set_Last
(LC
, Node
);
1262 Set_Prev
(Nxt2
, Node
);
1265 Nodes
.Table
(Nxt
).In_List
:= False;
1266 Set_Parent
(Nxt
, Empty
);
1273 -----------------------
1274 -- Remove_Next_Debug --
1275 -----------------------
1277 procedure Remove_Next_Debug
(Node
: Node_Id
) is
1279 if Debug_Flag_N
then
1280 Write_Str
("Remove next node after ");
1281 Write_Int
(Int
(Node
));
1284 end Remove_Next_Debug
;
1290 -- This subprogram is deliberately placed early on, out of alphabetical
1291 -- order, so that it can be properly inlined from within this unit.
1293 procedure Set_First
(List
: List_Id
; To
: Node_Id
) is
1295 Lists
.Table
(List
).First
:= To
;
1302 -- This subprogram is deliberately placed early on, out of alphabetical
1303 -- order, so that it can be properly inlined from within this unit.
1305 procedure Set_Last
(List
: List_Id
; To
: Node_Id
) is
1307 Lists
.Table
(List
).Last
:= To
;
1314 -- This subprogram is deliberately placed early on, out of alphabetical
1315 -- order, so that it can be properly inlined from within this unit.
1317 procedure Set_List_Link
(Node
: Node_Id
; To
: List_Id
) is
1319 Nodes
.Table
(Node
).Link
:= Union_Id
(To
);
1326 -- This subprogram is deliberately placed early on, out of alphabetical
1327 -- order, so that it can be properly inlined from within this unit.
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
in First_List_Id
.. Lists
.Last
);
1341 Lists
.Table
(List
).Parent
:= Node
;
1348 -- This subprogram is deliberately placed early on, out of alphabetical
1349 -- order, so that it can be properly inlined from within this unit.
1351 procedure Set_Prev
(Node
: Node_Id
; To
: Node_Id
) is
1353 Prev_Node
.Table
(Node
) := To
;
1360 procedure Tree_Read
is
1363 Next_Node
.Tree_Read
;
1364 Prev_Node
.Tree_Read
;
1371 procedure Tree_Write
is
1374 Next_Node
.Tree_Write
;
1375 Prev_Node
.Tree_Write
;