]>
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 | -- -- | |
1d005acc | 9 | -- Copyright (C) 1992-2019, 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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
70482933 RK |
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 -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
70482933 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | -- WARNING: There is a C version of this package. Any changes to this | |
33 | -- source file must be properly reflected in the C header a-elists.h. | |
34 | ||
35 | with Alloc; | |
36 | with Debug; use Debug; | |
37 | with Output; use Output; | |
38 | with Table; | |
39 | ||
40 | package body Elists is | |
41 | ||
42 | ------------------------------------- | |
43 | -- Implementation of Element Lists -- | |
44 | ------------------------------------- | |
45 | ||
46 | -- Element lists are composed of three types of entities. The element | |
47 | -- list header, which references the first and last elements of the | |
48 | -- list, the elements themselves which are singly linked and also | |
49 | -- reference the nodes on the list, and finally the nodes themselves. | |
50 | -- The following diagram shows how an element list is represented: | |
51 | ||
52 | -- +----------------------------------------------------+ | |
53 | -- | +------------------------------------------+ | | |
54 | -- | | | | | |
55 | -- V | V | | |
56 | -- +-----|--+ +-------+ +-------+ +-------+ | | |
57 | -- | Elmt | | 1st | | 2nd | | Last | | | |
58 | -- | List |--->| Elmt |--->| Elmt ---...-->| Elmt ---+ | |
59 | -- | Header | | | | | | | | | | | |
60 | -- +--------+ +---|---+ +---|---+ +---|---+ | |
61 | -- | | | | |
62 | -- V V V | |
63 | -- +-------+ +-------+ +-------+ | |
64 | -- | | | | | | | |
65 | -- | Node1 | | Node2 | | Node3 | | |
66 | -- | | | | | | | |
67 | -- +-------+ +-------+ +-------+ | |
68 | ||
69 | -- The list header is an entry in the Elists table. The values used for | |
70 | -- the type Elist_Id are subscripts into this table. The First_Elmt field | |
71 | -- (Lfield1) points to the first element on the list, or to No_Elmt in the | |
72 | -- case of an empty list. Similarly the Last_Elmt field (Lfield2) points to | |
73 | -- the last element on the list or to No_Elmt in the case of an empty list. | |
74 | ||
75 | -- The elements themselves are entries in the Elmts table. The Next field | |
76 | -- of each entry points to the next element, or to the Elist header if this | |
77 | -- is the last item in the list. The Node field points to the node which | |
78 | -- is referenced by the corresponding list entry. | |
79 | ||
15ce9ca2 AC |
80 | ------------------------- |
81 | -- Element List Tables -- | |
82 | ------------------------- | |
70482933 RK |
83 | |
84 | type Elist_Header is record | |
85 | First : Elmt_Id; | |
86 | Last : Elmt_Id; | |
87 | end record; | |
88 | ||
89 | package Elists is new Table.Table ( | |
90 | Table_Component_Type => Elist_Header, | |
1c28fe3a | 91 | Table_Index_Type => Elist_Id'Base, |
70482933 RK |
92 | Table_Low_Bound => First_Elist_Id, |
93 | Table_Initial => Alloc.Elists_Initial, | |
94 | Table_Increment => Alloc.Elists_Increment, | |
95 | Table_Name => "Elists"); | |
96 | ||
97 | type Elmt_Item is record | |
87ace727 | 98 | Node : Node_Or_Entity_Id; |
70482933 RK |
99 | Next : Union_Id; |
100 | end record; | |
101 | ||
102 | package Elmts is new Table.Table ( | |
103 | Table_Component_Type => Elmt_Item, | |
1c28fe3a | 104 | Table_Index_Type => Elmt_Id'Base, |
70482933 RK |
105 | Table_Low_Bound => First_Elmt_Id, |
106 | Table_Initial => Alloc.Elmts_Initial, | |
107 | Table_Increment => Alloc.Elmts_Increment, | |
108 | Table_Name => "Elmts"); | |
109 | ||
110 | ----------------- | |
111 | -- Append_Elmt -- | |
112 | ----------------- | |
113 | ||
87ace727 | 114 | procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is |
70482933 RK |
115 | L : constant Elmt_Id := Elists.Table (To).Last; |
116 | ||
117 | begin | |
118 | Elmts.Increment_Last; | |
87ace727 | 119 | Elmts.Table (Elmts.Last).Node := N; |
70482933 RK |
120 | Elmts.Table (Elmts.Last).Next := Union_Id (To); |
121 | ||
122 | if L = No_Elmt then | |
123 | Elists.Table (To).First := Elmts.Last; | |
124 | else | |
125 | Elmts.Table (L).Next := Union_Id (Elmts.Last); | |
126 | end if; | |
127 | ||
128 | Elists.Table (To).Last := Elmts.Last; | |
129 | ||
130 | if Debug_Flag_N then | |
131 | Write_Str ("Append new element Elmt_Id = "); | |
132 | Write_Int (Int (Elmts.Last)); | |
133 | Write_Str (" to list Elist_Id = "); | |
134 | Write_Int (Int (To)); | |
87ace727 RD |
135 | Write_Str (" referencing Node_Or_Entity_Id = "); |
136 | Write_Int (Int (N)); | |
70482933 RK |
137 | Write_Eol; |
138 | end if; | |
139 | end Append_Elmt; | |
140 | ||
21c51f53 RD |
141 | --------------------- |
142 | -- Append_New_Elmt -- | |
143 | --------------------- | |
144 | ||
145 | procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is | |
146 | begin | |
147 | if To = No_Elist then | |
148 | To := New_Elmt_List; | |
149 | end if; | |
150 | ||
151 | Append_Elmt (N, To); | |
152 | end Append_New_Elmt; | |
153 | ||
87ace727 RD |
154 | ------------------------ |
155 | -- Append_Unique_Elmt -- | |
156 | ------------------------ | |
157 | ||
158 | procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is | |
159 | Elmt : Elmt_Id; | |
160 | begin | |
161 | Elmt := First_Elmt (To); | |
162 | loop | |
163 | if No (Elmt) then | |
164 | Append_Elmt (N, To); | |
165 | return; | |
166 | elsif Node (Elmt) = N then | |
167 | return; | |
168 | else | |
169 | Next_Elmt (Elmt); | |
170 | end if; | |
171 | end loop; | |
172 | end Append_Unique_Elmt; | |
173 | ||
fe96ecb9 AC |
174 | -------------- |
175 | -- Contains -- | |
176 | -------------- | |
177 | ||
178 | function Contains (List : Elist_Id; N : Node_Or_Entity_Id) return Boolean is | |
179 | Elmt : Elmt_Id; | |
180 | ||
181 | begin | |
182 | if Present (List) then | |
183 | Elmt := First_Elmt (List); | |
184 | while Present (Elmt) loop | |
185 | if Node (Elmt) = N then | |
186 | return True; | |
187 | end if; | |
188 | ||
189 | Next_Elmt (Elmt); | |
190 | end loop; | |
191 | end if; | |
192 | ||
193 | return False; | |
194 | end Contains; | |
195 | ||
70482933 RK |
196 | -------------------- |
197 | -- Elists_Address -- | |
198 | -------------------- | |
199 | ||
200 | function Elists_Address return System.Address is | |
201 | begin | |
202 | return Elists.Table (First_Elist_Id)'Address; | |
203 | end Elists_Address; | |
204 | ||
205 | ------------------- | |
206 | -- Elmts_Address -- | |
207 | ------------------- | |
208 | ||
209 | function Elmts_Address return System.Address is | |
210 | begin | |
211 | return Elmts.Table (First_Elmt_Id)'Address; | |
212 | end Elmts_Address; | |
213 | ||
214 | ---------------- | |
215 | -- First_Elmt -- | |
216 | ---------------- | |
217 | ||
218 | function First_Elmt (List : Elist_Id) return Elmt_Id is | |
219 | begin | |
220 | pragma Assert (List > Elist_Low_Bound); | |
221 | return Elists.Table (List).First; | |
222 | end First_Elmt; | |
223 | ||
224 | ---------------- | |
225 | -- Initialize -- | |
226 | ---------------- | |
227 | ||
228 | procedure Initialize is | |
229 | begin | |
230 | Elists.Init; | |
231 | Elmts.Init; | |
232 | end Initialize; | |
233 | ||
234 | ----------------------- | |
235 | -- Insert_Elmt_After -- | |
236 | ----------------------- | |
237 | ||
87ace727 RD |
238 | procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is |
239 | Nxt : constant Union_Id := Elmts.Table (Elmt).Next; | |
70482933 RK |
240 | |
241 | begin | |
70482933 RK |
242 | pragma Assert (Elmt /= No_Elmt); |
243 | ||
244 | Elmts.Increment_Last; | |
87ace727 RD |
245 | Elmts.Table (Elmts.Last).Node := N; |
246 | Elmts.Table (Elmts.Last).Next := Nxt; | |
70482933 RK |
247 | |
248 | Elmts.Table (Elmt).Next := Union_Id (Elmts.Last); | |
249 | ||
87ace727 RD |
250 | if Nxt in Elist_Range then |
251 | Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last; | |
70482933 RK |
252 | end if; |
253 | end Insert_Elmt_After; | |
254 | ||
255 | ------------------------ | |
256 | -- Is_Empty_Elmt_List -- | |
257 | ------------------------ | |
258 | ||
259 | function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is | |
260 | begin | |
261 | return Elists.Table (List).First = No_Elmt; | |
262 | end Is_Empty_Elmt_List; | |
263 | ||
264 | ------------------- | |
265 | -- Last_Elist_Id -- | |
266 | ------------------- | |
267 | ||
268 | function Last_Elist_Id return Elist_Id is | |
269 | begin | |
270 | return Elists.Last; | |
271 | end Last_Elist_Id; | |
272 | ||
273 | --------------- | |
274 | -- Last_Elmt -- | |
275 | --------------- | |
276 | ||
277 | function Last_Elmt (List : Elist_Id) return Elmt_Id is | |
278 | begin | |
279 | return Elists.Table (List).Last; | |
280 | end Last_Elmt; | |
281 | ||
282 | ------------------ | |
283 | -- Last_Elmt_Id -- | |
284 | ------------------ | |
285 | ||
286 | function Last_Elmt_Id return Elmt_Id is | |
287 | begin | |
288 | return Elmts.Last; | |
289 | end Last_Elmt_Id; | |
290 | ||
5a271a7f RD |
291 | ----------------- |
292 | -- List_Length -- | |
293 | ----------------- | |
294 | ||
295 | function List_Length (List : Elist_Id) return Nat is | |
296 | Elmt : Elmt_Id; | |
297 | N : Nat; | |
89f0276a | 298 | |
5a271a7f | 299 | begin |
89f0276a RD |
300 | if List = No_Elist then |
301 | return 0; | |
302 | ||
303 | else | |
304 | N := 0; | |
305 | Elmt := First_Elmt (List); | |
306 | loop | |
307 | if No (Elmt) then | |
308 | return N; | |
309 | else | |
310 | N := N + 1; | |
311 | Next_Elmt (Elmt); | |
312 | end if; | |
313 | end loop; | |
314 | end if; | |
5a271a7f RD |
315 | end List_Length; |
316 | ||
70482933 RK |
317 | ---------- |
318 | -- Lock -- | |
319 | ---------- | |
320 | ||
321 | procedure Lock is | |
322 | begin | |
70482933 | 323 | Elists.Release; |
de33eb38 | 324 | Elists.Locked := True; |
70482933 | 325 | Elmts.Release; |
de33eb38 | 326 | Elmts.Locked := True; |
70482933 RK |
327 | end Lock; |
328 | ||
ab8843fa HK |
329 | -------------------- |
330 | -- New_Copy_Elist -- | |
331 | -------------------- | |
332 | ||
333 | function New_Copy_Elist (List : Elist_Id) return Elist_Id is | |
334 | Result : Elist_Id; | |
335 | Elmt : Elmt_Id; | |
336 | ||
337 | begin | |
338 | if List = No_Elist then | |
339 | return No_Elist; | |
340 | ||
341 | -- Replicate the contents of the input list while preserving the | |
342 | -- original order. | |
343 | ||
344 | else | |
345 | Result := New_Elmt_List; | |
346 | ||
347 | Elmt := First_Elmt (List); | |
348 | while Present (Elmt) loop | |
349 | Append_Elmt (Node (Elmt), Result); | |
350 | Next_Elmt (Elmt); | |
351 | end loop; | |
352 | ||
353 | return Result; | |
354 | end if; | |
355 | end New_Copy_Elist; | |
356 | ||
70482933 RK |
357 | ------------------- |
358 | -- New_Elmt_List -- | |
359 | ------------------- | |
360 | ||
361 | function New_Elmt_List return Elist_Id is | |
362 | begin | |
363 | Elists.Increment_Last; | |
364 | Elists.Table (Elists.Last).First := No_Elmt; | |
365 | Elists.Table (Elists.Last).Last := No_Elmt; | |
366 | ||
367 | if Debug_Flag_N then | |
368 | Write_Str ("Allocate new element list, returned ID = "); | |
369 | Write_Int (Int (Elists.Last)); | |
370 | Write_Eol; | |
371 | end if; | |
372 | ||
373 | return Elists.Last; | |
374 | end New_Elmt_List; | |
375 | ||
376 | --------------- | |
377 | -- Next_Elmt -- | |
378 | --------------- | |
379 | ||
380 | function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is | |
381 | N : constant Union_Id := Elmts.Table (Elmt).Next; | |
382 | ||
383 | begin | |
384 | if N in Elist_Range then | |
385 | return No_Elmt; | |
386 | else | |
387 | return Elmt_Id (N); | |
388 | end if; | |
389 | end Next_Elmt; | |
390 | ||
391 | procedure Next_Elmt (Elmt : in out Elmt_Id) is | |
392 | begin | |
393 | Elmt := Next_Elmt (Elmt); | |
394 | end Next_Elmt; | |
395 | ||
396 | -------- | |
397 | -- No -- | |
398 | -------- | |
399 | ||
400 | function No (List : Elist_Id) return Boolean is | |
401 | begin | |
402 | return List = No_Elist; | |
403 | end No; | |
404 | ||
405 | function No (Elmt : Elmt_Id) return Boolean is | |
406 | begin | |
407 | return Elmt = No_Elmt; | |
408 | end No; | |
409 | ||
b5ace3b7 | 410 | ---------- |
70482933 | 411 | -- Node -- |
b5ace3b7 | 412 | ---------- |
70482933 | 413 | |
b5ace3b7 | 414 | function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is |
70482933 RK |
415 | begin |
416 | if Elmt = No_Elmt then | |
417 | return Empty; | |
418 | else | |
419 | return Elmts.Table (Elmt).Node; | |
420 | end if; | |
421 | end Node; | |
422 | ||
423 | ---------------- | |
424 | -- Num_Elists -- | |
425 | ---------------- | |
426 | ||
427 | function Num_Elists return Nat is | |
428 | begin | |
429 | return Int (Elmts.Last) - Int (Elmts.First) + 1; | |
430 | end Num_Elists; | |
431 | ||
432 | ------------------ | |
433 | -- Prepend_Elmt -- | |
434 | ------------------ | |
435 | ||
87ace727 | 436 | procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is |
70482933 RK |
437 | F : constant Elmt_Id := Elists.Table (To).First; |
438 | ||
439 | begin | |
440 | Elmts.Increment_Last; | |
87ace727 | 441 | Elmts.Table (Elmts.Last).Node := N; |
70482933 RK |
442 | |
443 | if F = No_Elmt then | |
444 | Elists.Table (To).Last := Elmts.Last; | |
445 | Elmts.Table (Elmts.Last).Next := Union_Id (To); | |
446 | else | |
447 | Elmts.Table (Elmts.Last).Next := Union_Id (F); | |
448 | end if; | |
449 | ||
450 | Elists.Table (To).First := Elmts.Last; | |
70482933 RK |
451 | end Prepend_Elmt; |
452 | ||
b619c88e AC |
453 | ------------------------- |
454 | -- Prepend_Unique_Elmt -- | |
455 | ------------------------- | |
456 | ||
457 | procedure Prepend_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is | |
458 | begin | |
459 | if not Contains (To, N) then | |
460 | Prepend_Elmt (N, To); | |
461 | end if; | |
462 | end Prepend_Unique_Elmt; | |
463 | ||
70482933 RK |
464 | ------------- |
465 | -- Present -- | |
466 | ------------- | |
467 | ||
468 | function Present (List : Elist_Id) return Boolean is | |
469 | begin | |
470 | return List /= No_Elist; | |
471 | end Present; | |
472 | ||
473 | function Present (Elmt : Elmt_Id) return Boolean is | |
474 | begin | |
475 | return Elmt /= No_Elmt; | |
476 | end Present; | |
477 | ||
ab8843fa HK |
478 | ------------ |
479 | -- Remove -- | |
480 | ------------ | |
481 | ||
482 | procedure Remove (List : Elist_Id; N : Node_Or_Entity_Id) is | |
483 | Elmt : Elmt_Id; | |
484 | ||
485 | begin | |
486 | if Present (List) then | |
487 | Elmt := First_Elmt (List); | |
488 | while Present (Elmt) loop | |
489 | if Node (Elmt) = N then | |
490 | Remove_Elmt (List, Elmt); | |
491 | exit; | |
492 | end if; | |
493 | ||
494 | Next_Elmt (Elmt); | |
495 | end loop; | |
496 | end if; | |
497 | end Remove; | |
498 | ||
70482933 RK |
499 | ----------------- |
500 | -- Remove_Elmt -- | |
501 | ----------------- | |
502 | ||
503 | procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is | |
504 | Nxt : Elmt_Id; | |
505 | Prv : Elmt_Id; | |
506 | ||
507 | begin | |
508 | Nxt := Elists.Table (List).First; | |
509 | ||
510 | -- Case of removing only element in the list | |
511 | ||
512 | if Elmts.Table (Nxt).Next in Elist_Range then | |
70482933 RK |
513 | pragma Assert (Nxt = Elmt); |
514 | ||
515 | Elists.Table (List).First := No_Elmt; | |
516 | Elists.Table (List).Last := No_Elmt; | |
517 | ||
518 | -- Case of removing the first element in the list | |
519 | ||
520 | elsif Nxt = Elmt then | |
521 | Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next); | |
522 | ||
523 | -- Case of removing second or later element in the list | |
524 | ||
525 | else | |
526 | loop | |
527 | Prv := Nxt; | |
528 | Nxt := Elmt_Id (Elmts.Table (Prv).Next); | |
529 | exit when Nxt = Elmt | |
530 | or else Elmts.Table (Nxt).Next in Elist_Range; | |
531 | end loop; | |
532 | ||
533 | pragma Assert (Nxt = Elmt); | |
534 | ||
535 | Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; | |
536 | ||
537 | if Elmts.Table (Prv).Next in Elist_Range then | |
538 | Elists.Table (List).Last := Prv; | |
539 | end if; | |
540 | end if; | |
541 | end Remove_Elmt; | |
542 | ||
543 | ---------------------- | |
544 | -- Remove_Last_Elmt -- | |
545 | ---------------------- | |
546 | ||
547 | procedure Remove_Last_Elmt (List : Elist_Id) is | |
548 | Nxt : Elmt_Id; | |
549 | Prv : Elmt_Id; | |
550 | ||
551 | begin | |
552 | Nxt := Elists.Table (List).First; | |
553 | ||
554 | -- Case of removing only element in the list | |
555 | ||
556 | if Elmts.Table (Nxt).Next in Elist_Range then | |
557 | Elists.Table (List).First := No_Elmt; | |
558 | Elists.Table (List).Last := No_Elmt; | |
559 | ||
560 | -- Case of at least two elements in list | |
561 | ||
562 | else | |
563 | loop | |
564 | Prv := Nxt; | |
565 | Nxt := Elmt_Id (Elmts.Table (Prv).Next); | |
566 | exit when Elmts.Table (Nxt).Next in Elist_Range; | |
567 | end loop; | |
568 | ||
569 | Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; | |
570 | Elists.Table (List).Last := Prv; | |
571 | end if; | |
572 | end Remove_Last_Elmt; | |
573 | ||
574 | ------------------ | |
575 | -- Replace_Elmt -- | |
576 | ------------------ | |
577 | ||
87ace727 | 578 | procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is |
70482933 RK |
579 | begin |
580 | Elmts.Table (Elmt).Node := New_Node; | |
581 | end Replace_Elmt; | |
582 | ||
583 | --------------- | |
584 | -- Tree_Read -- | |
585 | --------------- | |
586 | ||
587 | procedure Tree_Read is | |
588 | begin | |
589 | Elists.Tree_Read; | |
590 | Elmts.Tree_Read; | |
591 | end Tree_Read; | |
592 | ||
593 | ---------------- | |
594 | -- Tree_Write -- | |
595 | ---------------- | |
596 | ||
597 | procedure Tree_Write is | |
598 | begin | |
599 | Elists.Tree_Write; | |
600 | Elmts.Tree_Write; | |
601 | end Tree_Write; | |
602 | ||
1c28fe3a RD |
603 | ------------ |
604 | -- Unlock -- | |
605 | ------------ | |
606 | ||
607 | procedure Unlock is | |
608 | begin | |
609 | Elists.Locked := False; | |
610 | Elmts.Locked := False; | |
611 | end Unlock; | |
612 | ||
70482933 | 613 | end Elists; |