]>
Commit | Line | Data |
---|---|---|
70482933 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- E L I S T S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
15ce9ca2 | 9 | -- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- |
70482933 RK |
10 | -- -- |
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, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
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. -- | |
28 | -- -- | |
29 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
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. | |
36 | ||
37 | with Alloc; | |
38 | with Debug; use Debug; | |
39 | with Output; use Output; | |
40 | with Table; | |
41 | ||
42 | package body Elists is | |
43 | ||
44 | ------------------------------------- | |
45 | -- Implementation of Element Lists -- | |
46 | ------------------------------------- | |
47 | ||
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: | |
53 | ||
54 | -- +----------------------------------------------------+ | |
55 | -- | +------------------------------------------+ | | |
56 | -- | | | | | |
57 | -- V | V | | |
58 | -- +-----|--+ +-------+ +-------+ +-------+ | | |
59 | -- | Elmt | | 1st | | 2nd | | Last | | | |
60 | -- | List |--->| Elmt |--->| Elmt ---...-->| Elmt ---+ | |
61 | -- | Header | | | | | | | | | | | |
62 | -- +--------+ +---|---+ +---|---+ +---|---+ | |
63 | -- | | | | |
64 | -- V V V | |
65 | -- +-------+ +-------+ +-------+ | |
66 | -- | | | | | | | |
67 | -- | Node1 | | Node2 | | Node3 | | |
68 | -- | | | | | | | |
69 | -- +-------+ +-------+ +-------+ | |
70 | ||
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. | |
76 | ||
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. | |
81 | ||
15ce9ca2 AC |
82 | ------------------------- |
83 | -- Element List Tables -- | |
84 | ------------------------- | |
70482933 RK |
85 | |
86 | type Elist_Header is record | |
87 | First : Elmt_Id; | |
88 | Last : Elmt_Id; | |
89 | end record; | |
90 | ||
91 | package Elists is new Table.Table ( | |
92 | Table_Component_Type => Elist_Header, | |
93 | Table_Index_Type => Elist_Id, | |
94 | Table_Low_Bound => First_Elist_Id, | |
95 | Table_Initial => Alloc.Elists_Initial, | |
96 | Table_Increment => Alloc.Elists_Increment, | |
97 | Table_Name => "Elists"); | |
98 | ||
99 | type Elmt_Item is record | |
100 | Node : Node_Id; | |
101 | Next : Union_Id; | |
102 | end record; | |
103 | ||
104 | package Elmts is new Table.Table ( | |
105 | Table_Component_Type => Elmt_Item, | |
106 | Table_Index_Type => Elmt_Id, | |
107 | Table_Low_Bound => First_Elmt_Id, | |
108 | Table_Initial => Alloc.Elmts_Initial, | |
109 | Table_Increment => Alloc.Elmts_Increment, | |
110 | Table_Name => "Elmts"); | |
111 | ||
112 | ----------------- | |
113 | -- Append_Elmt -- | |
114 | ----------------- | |
115 | ||
116 | procedure Append_Elmt (Node : Node_Id; To : Elist_Id) is | |
117 | L : constant Elmt_Id := Elists.Table (To).Last; | |
118 | ||
119 | begin | |
120 | Elmts.Increment_Last; | |
121 | Elmts.Table (Elmts.Last).Node := Node; | |
122 | Elmts.Table (Elmts.Last).Next := Union_Id (To); | |
123 | ||
124 | if L = No_Elmt then | |
125 | Elists.Table (To).First := Elmts.Last; | |
126 | else | |
127 | Elmts.Table (L).Next := Union_Id (Elmts.Last); | |
128 | end if; | |
129 | ||
130 | Elists.Table (To).Last := Elmts.Last; | |
131 | ||
132 | if Debug_Flag_N then | |
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_Id = "); | |
138 | Write_Int (Int (Node)); | |
139 | Write_Eol; | |
140 | end if; | |
141 | end Append_Elmt; | |
142 | ||
143 | -------------------- | |
144 | -- Elists_Address -- | |
145 | -------------------- | |
146 | ||
147 | function Elists_Address return System.Address is | |
148 | begin | |
149 | return Elists.Table (First_Elist_Id)'Address; | |
150 | end Elists_Address; | |
151 | ||
152 | ------------------- | |
153 | -- Elmts_Address -- | |
154 | ------------------- | |
155 | ||
156 | function Elmts_Address return System.Address is | |
157 | begin | |
158 | return Elmts.Table (First_Elmt_Id)'Address; | |
159 | end Elmts_Address; | |
160 | ||
161 | ---------------- | |
162 | -- First_Elmt -- | |
163 | ---------------- | |
164 | ||
165 | function First_Elmt (List : Elist_Id) return Elmt_Id is | |
166 | begin | |
167 | pragma Assert (List > Elist_Low_Bound); | |
168 | return Elists.Table (List).First; | |
169 | end First_Elmt; | |
170 | ||
171 | ---------------- | |
172 | -- Initialize -- | |
173 | ---------------- | |
174 | ||
175 | procedure Initialize is | |
176 | begin | |
177 | Elists.Init; | |
178 | Elmts.Init; | |
179 | end Initialize; | |
180 | ||
181 | ----------------------- | |
182 | -- Insert_Elmt_After -- | |
183 | ----------------------- | |
184 | ||
185 | procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id) is | |
186 | N : constant Union_Id := Elmts.Table (Elmt).Next; | |
187 | ||
188 | begin | |
189 | ||
190 | pragma Assert (Elmt /= No_Elmt); | |
191 | ||
192 | Elmts.Increment_Last; | |
193 | Elmts.Table (Elmts.Last).Node := Node; | |
194 | Elmts.Table (Elmts.Last).Next := N; | |
195 | ||
196 | Elmts.Table (Elmt).Next := Union_Id (Elmts.Last); | |
197 | ||
198 | if N in Elist_Range then | |
199 | Elists.Table (Elist_Id (N)).Last := Elmts.Last; | |
200 | end if; | |
201 | end Insert_Elmt_After; | |
202 | ||
203 | ------------------------ | |
204 | -- Is_Empty_Elmt_List -- | |
205 | ------------------------ | |
206 | ||
207 | function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is | |
208 | begin | |
209 | return Elists.Table (List).First = No_Elmt; | |
210 | end Is_Empty_Elmt_List; | |
211 | ||
212 | ------------------- | |
213 | -- Last_Elist_Id -- | |
214 | ------------------- | |
215 | ||
216 | function Last_Elist_Id return Elist_Id is | |
217 | begin | |
218 | return Elists.Last; | |
219 | end Last_Elist_Id; | |
220 | ||
221 | --------------- | |
222 | -- Last_Elmt -- | |
223 | --------------- | |
224 | ||
225 | function Last_Elmt (List : Elist_Id) return Elmt_Id is | |
226 | begin | |
227 | return Elists.Table (List).Last; | |
228 | end Last_Elmt; | |
229 | ||
230 | ------------------ | |
231 | -- Last_Elmt_Id -- | |
232 | ------------------ | |
233 | ||
234 | function Last_Elmt_Id return Elmt_Id is | |
235 | begin | |
236 | return Elmts.Last; | |
237 | end Last_Elmt_Id; | |
238 | ||
239 | ---------- | |
240 | -- Lock -- | |
241 | ---------- | |
242 | ||
243 | procedure Lock is | |
244 | begin | |
245 | Elists.Locked := True; | |
246 | Elmts.Locked := True; | |
247 | Elists.Release; | |
248 | Elmts.Release; | |
249 | end Lock; | |
250 | ||
251 | ------------------- | |
252 | -- New_Elmt_List -- | |
253 | ------------------- | |
254 | ||
255 | function New_Elmt_List return Elist_Id is | |
256 | begin | |
257 | Elists.Increment_Last; | |
258 | Elists.Table (Elists.Last).First := No_Elmt; | |
259 | Elists.Table (Elists.Last).Last := No_Elmt; | |
260 | ||
261 | if Debug_Flag_N then | |
262 | Write_Str ("Allocate new element list, returned ID = "); | |
263 | Write_Int (Int (Elists.Last)); | |
264 | Write_Eol; | |
265 | end if; | |
266 | ||
267 | return Elists.Last; | |
268 | end New_Elmt_List; | |
269 | ||
270 | --------------- | |
271 | -- Next_Elmt -- | |
272 | --------------- | |
273 | ||
274 | function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is | |
275 | N : constant Union_Id := Elmts.Table (Elmt).Next; | |
276 | ||
277 | begin | |
278 | if N in Elist_Range then | |
279 | return No_Elmt; | |
280 | else | |
281 | return Elmt_Id (N); | |
282 | end if; | |
283 | end Next_Elmt; | |
284 | ||
285 | procedure Next_Elmt (Elmt : in out Elmt_Id) is | |
286 | begin | |
287 | Elmt := Next_Elmt (Elmt); | |
288 | end Next_Elmt; | |
289 | ||
290 | -------- | |
291 | -- No -- | |
292 | -------- | |
293 | ||
294 | function No (List : Elist_Id) return Boolean is | |
295 | begin | |
296 | return List = No_Elist; | |
297 | end No; | |
298 | ||
299 | function No (Elmt : Elmt_Id) return Boolean is | |
300 | begin | |
301 | return Elmt = No_Elmt; | |
302 | end No; | |
303 | ||
304 | ----------- | |
305 | -- Node -- | |
306 | ----------- | |
307 | ||
308 | function Node (Elmt : Elmt_Id) return Node_Id is | |
309 | begin | |
310 | if Elmt = No_Elmt then | |
311 | return Empty; | |
312 | else | |
313 | return Elmts.Table (Elmt).Node; | |
314 | end if; | |
315 | end Node; | |
316 | ||
317 | ---------------- | |
318 | -- Num_Elists -- | |
319 | ---------------- | |
320 | ||
321 | function Num_Elists return Nat is | |
322 | begin | |
323 | return Int (Elmts.Last) - Int (Elmts.First) + 1; | |
324 | end Num_Elists; | |
325 | ||
326 | ------------------ | |
327 | -- Prepend_Elmt -- | |
328 | ------------------ | |
329 | ||
330 | procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id) is | |
331 | F : constant Elmt_Id := Elists.Table (To).First; | |
332 | ||
333 | begin | |
334 | Elmts.Increment_Last; | |
335 | Elmts.Table (Elmts.Last).Node := Node; | |
336 | ||
337 | if F = No_Elmt then | |
338 | Elists.Table (To).Last := Elmts.Last; | |
339 | Elmts.Table (Elmts.Last).Next := Union_Id (To); | |
340 | else | |
341 | Elmts.Table (Elmts.Last).Next := Union_Id (F); | |
342 | end if; | |
343 | ||
344 | Elists.Table (To).First := Elmts.Last; | |
345 | ||
346 | end Prepend_Elmt; | |
347 | ||
348 | ------------- | |
349 | -- Present -- | |
350 | ------------- | |
351 | ||
352 | function Present (List : Elist_Id) return Boolean is | |
353 | begin | |
354 | return List /= No_Elist; | |
355 | end Present; | |
356 | ||
357 | function Present (Elmt : Elmt_Id) return Boolean is | |
358 | begin | |
359 | return Elmt /= No_Elmt; | |
360 | end Present; | |
361 | ||
362 | ----------------- | |
363 | -- Remove_Elmt -- | |
364 | ----------------- | |
365 | ||
366 | procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is | |
367 | Nxt : Elmt_Id; | |
368 | Prv : Elmt_Id; | |
369 | ||
370 | begin | |
371 | Nxt := Elists.Table (List).First; | |
372 | ||
373 | -- Case of removing only element in the list | |
374 | ||
375 | if Elmts.Table (Nxt).Next in Elist_Range then | |
376 | ||
377 | pragma Assert (Nxt = Elmt); | |
378 | ||
379 | Elists.Table (List).First := No_Elmt; | |
380 | Elists.Table (List).Last := No_Elmt; | |
381 | ||
382 | -- Case of removing the first element in the list | |
383 | ||
384 | elsif Nxt = Elmt then | |
385 | Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next); | |
386 | ||
387 | -- Case of removing second or later element in the list | |
388 | ||
389 | else | |
390 | loop | |
391 | Prv := Nxt; | |
392 | Nxt := Elmt_Id (Elmts.Table (Prv).Next); | |
393 | exit when Nxt = Elmt | |
394 | or else Elmts.Table (Nxt).Next in Elist_Range; | |
395 | end loop; | |
396 | ||
397 | pragma Assert (Nxt = Elmt); | |
398 | ||
399 | Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; | |
400 | ||
401 | if Elmts.Table (Prv).Next in Elist_Range then | |
402 | Elists.Table (List).Last := Prv; | |
403 | end if; | |
404 | end if; | |
405 | end Remove_Elmt; | |
406 | ||
407 | ---------------------- | |
408 | -- Remove_Last_Elmt -- | |
409 | ---------------------- | |
410 | ||
411 | procedure Remove_Last_Elmt (List : Elist_Id) is | |
412 | Nxt : Elmt_Id; | |
413 | Prv : Elmt_Id; | |
414 | ||
415 | begin | |
416 | Nxt := Elists.Table (List).First; | |
417 | ||
418 | -- Case of removing only element in the list | |
419 | ||
420 | if Elmts.Table (Nxt).Next in Elist_Range then | |
421 | Elists.Table (List).First := No_Elmt; | |
422 | Elists.Table (List).Last := No_Elmt; | |
423 | ||
424 | -- Case of at least two elements in list | |
425 | ||
426 | else | |
427 | loop | |
428 | Prv := Nxt; | |
429 | Nxt := Elmt_Id (Elmts.Table (Prv).Next); | |
430 | exit when Elmts.Table (Nxt).Next in Elist_Range; | |
431 | end loop; | |
432 | ||
433 | Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; | |
434 | Elists.Table (List).Last := Prv; | |
435 | end if; | |
436 | end Remove_Last_Elmt; | |
437 | ||
438 | ------------------ | |
439 | -- Replace_Elmt -- | |
440 | ------------------ | |
441 | ||
442 | procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Id) is | |
443 | begin | |
444 | Elmts.Table (Elmt).Node := New_Node; | |
445 | end Replace_Elmt; | |
446 | ||
447 | --------------- | |
448 | -- Tree_Read -- | |
449 | --------------- | |
450 | ||
451 | procedure Tree_Read is | |
452 | begin | |
453 | Elists.Tree_Read; | |
454 | Elmts.Tree_Read; | |
455 | end Tree_Read; | |
456 | ||
457 | ---------------- | |
458 | -- Tree_Write -- | |
459 | ---------------- | |
460 | ||
461 | procedure Tree_Write is | |
462 | begin | |
463 | Elists.Tree_Write; | |
464 | Elmts.Tree_Write; | |
465 | end Tree_Write; | |
466 | ||
467 | end Elists; |