1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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
35 -- source file must be properly reflected in the C header a-elists.h.
38 with Debug
; use Debug
;
39 with Output
; use Output
;
42 package body Elists
is
44 -------------------------------------
45 -- Implementation of Element Lists --
46 -------------------------------------
48 -- Element lists are composed of three types of entities. The element
49 -- list header, which references the first and last elements of the
50 -- list, the elements themselves which are singly linked and also
51 -- reference the nodes on the list, and finally the nodes themselves.
52 -- The following diagram shows how an element list is represented:
54 -- +----------------------------------------------------+
55 -- | +------------------------------------------+ |
58 -- +-----|--+ +-------+ +-------+ +-------+ |
59 -- | Elmt | | 1st | | 2nd | | Last | |
60 -- | List |--->| Elmt |--->| Elmt ---...-->| Elmt ---+
61 -- | Header | | | | | | | | | |
62 -- +--------+ +---|---+ +---|---+ +---|---+
65 -- +-------+ +-------+ +-------+
67 -- | Node1 | | Node2 | | Node3 |
69 -- +-------+ +-------+ +-------+
71 -- The list header is an entry in the Elists table. The values used for
72 -- the type Elist_Id are subscripts into this table. The First_Elmt field
73 -- (Lfield1) points to the first element on the list, or to No_Elmt in the
74 -- case of an empty list. Similarly the Last_Elmt field (Lfield2) points to
75 -- the last element on the list or to No_Elmt in the case of an empty list.
77 -- The elements themselves are entries in the Elmts table. The Next field
78 -- of each entry points to the next element, or to the Elist header if this
79 -- is the last item in the list. The Node field points to the node which
80 -- is referenced by the corresponding list entry.
82 -------------------------
83 -- Element List Tables --
84 -------------------------
86 type Elist_Header
is record
91 package Elists
is new Table
.Table
(
92 Table_Component_Type
=> Elist_Header
,
93 Table_Index_Type
=> Elist_Id
'Base,
94 Table_Low_Bound
=> First_Elist_Id
,
95 Table_Initial
=> Alloc
.Elists_Initial
,
96 Table_Increment
=> Alloc
.Elists_Increment
,
97 Table_Name
=> "Elists");
99 type Elmt_Item
is record
100 Node
: Node_Or_Entity_Id
;
104 package Elmts
is new Table
.Table
(
105 Table_Component_Type
=> Elmt_Item
,
106 Table_Index_Type
=> Elmt_Id
'Base,
107 Table_Low_Bound
=> First_Elmt_Id
,
108 Table_Initial
=> Alloc
.Elmts_Initial
,
109 Table_Increment
=> Alloc
.Elmts_Increment
,
110 Table_Name
=> "Elmts");
116 procedure Append_Elmt
(N
: Node_Or_Entity_Id
; To
: Elist_Id
) is
117 L
: constant Elmt_Id
:= Elists
.Table
(To
).Last
;
120 Elmts
.Increment_Last
;
121 Elmts
.Table
(Elmts
.Last
).Node
:= N
;
122 Elmts
.Table
(Elmts
.Last
).Next
:= Union_Id
(To
);
125 Elists
.Table
(To
).First
:= Elmts
.Last
;
127 Elmts
.Table
(L
).Next
:= Union_Id
(Elmts
.Last
);
130 Elists
.Table
(To
).Last
:= Elmts
.Last
;
133 Write_Str
("Append new element Elmt_Id = ");
134 Write_Int
(Int
(Elmts
.Last
));
135 Write_Str
(" to list Elist_Id = ");
136 Write_Int
(Int
(To
));
137 Write_Str
(" referencing Node_Or_Entity_Id = ");
143 ------------------------
144 -- Append_Unique_Elmt --
145 ------------------------
147 procedure Append_Unique_Elmt
(N
: Node_Or_Entity_Id
; To
: Elist_Id
) is
150 Elmt
:= First_Elmt
(To
);
155 elsif Node
(Elmt
) = N
then
161 end Append_Unique_Elmt
;
167 function Elists_Address
return System
.Address
is
169 return Elists
.Table
(First_Elist_Id
)'Address;
176 function Elmts_Address
return System
.Address
is
178 return Elmts
.Table
(First_Elmt_Id
)'Address;
185 function First_Elmt
(List
: Elist_Id
) return Elmt_Id
is
187 pragma Assert
(List
> Elist_Low_Bound
);
188 return Elists
.Table
(List
).First
;
195 procedure Initialize
is
201 -----------------------
202 -- Insert_Elmt_After --
203 -----------------------
205 procedure Insert_Elmt_After
(N
: Node_Or_Entity_Id
; Elmt
: Elmt_Id
) is
206 Nxt
: constant Union_Id
:= Elmts
.Table
(Elmt
).Next
;
209 pragma Assert
(Elmt
/= No_Elmt
);
211 Elmts
.Increment_Last
;
212 Elmts
.Table
(Elmts
.Last
).Node
:= N
;
213 Elmts
.Table
(Elmts
.Last
).Next
:= Nxt
;
215 Elmts
.Table
(Elmt
).Next
:= Union_Id
(Elmts
.Last
);
217 if Nxt
in Elist_Range
then
218 Elists
.Table
(Elist_Id
(Nxt
)).Last
:= Elmts
.Last
;
220 end Insert_Elmt_After
;
222 ------------------------
223 -- Is_Empty_Elmt_List --
224 ------------------------
226 function Is_Empty_Elmt_List
(List
: Elist_Id
) return Boolean is
228 return Elists
.Table
(List
).First
= No_Elmt
;
229 end Is_Empty_Elmt_List
;
235 function Last_Elist_Id
return Elist_Id
is
244 function Last_Elmt
(List
: Elist_Id
) return Elmt_Id
is
246 return Elists
.Table
(List
).Last
;
253 function Last_Elmt_Id
return Elmt_Id
is
264 Elists
.Locked
:= True;
265 Elmts
.Locked
:= True;
274 function New_Elmt_List
return Elist_Id
is
276 Elists
.Increment_Last
;
277 Elists
.Table
(Elists
.Last
).First
:= No_Elmt
;
278 Elists
.Table
(Elists
.Last
).Last
:= No_Elmt
;
281 Write_Str
("Allocate new element list, returned ID = ");
282 Write_Int
(Int
(Elists
.Last
));
293 function Next_Elmt
(Elmt
: Elmt_Id
) return Elmt_Id
is
294 N
: constant Union_Id
:= Elmts
.Table
(Elmt
).Next
;
297 if N
in Elist_Range
then
304 procedure Next_Elmt
(Elmt
: in out Elmt_Id
) is
306 Elmt
:= Next_Elmt
(Elmt
);
313 function No
(List
: Elist_Id
) return Boolean is
315 return List
= No_Elist
;
318 function No
(Elmt
: Elmt_Id
) return Boolean is
320 return Elmt
= No_Elmt
;
327 function Node
(Elmt
: Elmt_Id
) return Node_Or_Entity_Id
is
329 if Elmt
= No_Elmt
then
332 return Elmts
.Table
(Elmt
).Node
;
340 function Num_Elists
return Nat
is
342 return Int
(Elmts
.Last
) - Int
(Elmts
.First
) + 1;
349 procedure Prepend_Elmt
(N
: Node_Or_Entity_Id
; To
: Elist_Id
) is
350 F
: constant Elmt_Id
:= Elists
.Table
(To
).First
;
353 Elmts
.Increment_Last
;
354 Elmts
.Table
(Elmts
.Last
).Node
:= N
;
357 Elists
.Table
(To
).Last
:= Elmts
.Last
;
358 Elmts
.Table
(Elmts
.Last
).Next
:= Union_Id
(To
);
360 Elmts
.Table
(Elmts
.Last
).Next
:= Union_Id
(F
);
363 Elists
.Table
(To
).First
:= Elmts
.Last
;
370 function Present
(List
: Elist_Id
) return Boolean is
372 return List
/= No_Elist
;
375 function Present
(Elmt
: Elmt_Id
) return Boolean is
377 return Elmt
/= No_Elmt
;
384 procedure Remove_Elmt
(List
: Elist_Id
; Elmt
: Elmt_Id
) is
389 Nxt
:= Elists
.Table
(List
).First
;
391 -- Case of removing only element in the list
393 if Elmts
.Table
(Nxt
).Next
in Elist_Range
then
395 pragma Assert
(Nxt
= Elmt
);
397 Elists
.Table
(List
).First
:= No_Elmt
;
398 Elists
.Table
(List
).Last
:= No_Elmt
;
400 -- Case of removing the first element in the list
402 elsif Nxt
= Elmt
then
403 Elists
.Table
(List
).First
:= Elmt_Id
(Elmts
.Table
(Nxt
).Next
);
405 -- Case of removing second or later element in the list
410 Nxt
:= Elmt_Id
(Elmts
.Table
(Prv
).Next
);
412 or else Elmts
.Table
(Nxt
).Next
in Elist_Range
;
415 pragma Assert
(Nxt
= Elmt
);
417 Elmts
.Table
(Prv
).Next
:= Elmts
.Table
(Nxt
).Next
;
419 if Elmts
.Table
(Prv
).Next
in Elist_Range
then
420 Elists
.Table
(List
).Last
:= Prv
;
425 ----------------------
426 -- Remove_Last_Elmt --
427 ----------------------
429 procedure Remove_Last_Elmt
(List
: Elist_Id
) is
434 Nxt
:= Elists
.Table
(List
).First
;
436 -- Case of removing only element in the list
438 if Elmts
.Table
(Nxt
).Next
in Elist_Range
then
439 Elists
.Table
(List
).First
:= No_Elmt
;
440 Elists
.Table
(List
).Last
:= No_Elmt
;
442 -- Case of at least two elements in list
447 Nxt
:= Elmt_Id
(Elmts
.Table
(Prv
).Next
);
448 exit when Elmts
.Table
(Nxt
).Next
in Elist_Range
;
451 Elmts
.Table
(Prv
).Next
:= Elmts
.Table
(Nxt
).Next
;
452 Elists
.Table
(List
).Last
:= Prv
;
454 end Remove_Last_Elmt
;
460 procedure Replace_Elmt
(Elmt
: Elmt_Id
; New_Node
: Node_Or_Entity_Id
) is
462 Elmts
.Table
(Elmt
).Node
:= New_Node
;
469 procedure Tree_Read
is
479 procedure Tree_Write
is
491 Elists
.Locked
:= False;
492 Elmts
.Locked
:= False;