Skip various cmp-mem-const tests on lp64 hppa*-*-*
[official-gcc.git] / gcc / ada / elists.adb
blob6af7228d90a560767f402f1faeaccc6928219dfe
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E L I S T S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 -- WARNING: There is a C version of this package. Any changes to this
27 -- source file must be properly reflected in the C header a-elists.h.
29 with Alloc;
30 with Debug; use Debug;
31 with Output; use Output;
32 with Table;
34 package body Elists is
36 -------------------------------------
37 -- Implementation of Element Lists --
38 -------------------------------------
40 -- Element lists are composed of three types of entities. The element
41 -- list header, which references the first and last elements of the
42 -- list, the elements themselves which are singly linked and also
43 -- reference the nodes on the list, and finally the nodes themselves.
44 -- The following diagram shows how an element list is represented:
46 -- +----------------------------------------------------+
47 -- | +------------------------------------------+ |
48 -- | | | |
49 -- V | V |
50 -- +-----|--+ +-------+ +-------+ +-------+ |
51 -- | Elmt | | 1st | | 2nd | | Last | |
52 -- | List |--->| Elmt |--->| Elmt ---...-->| Elmt ---+
53 -- | Header | | | | | | | | | |
54 -- +--------+ +---|---+ +---|---+ +---|---+
55 -- | | |
56 -- V V V
57 -- +-------+ +-------+ +-------+
58 -- | | | | | |
59 -- | Node1 | | Node2 | | Node3 |
60 -- | | | | | |
61 -- +-------+ +-------+ +-------+
63 -- The list header is an entry in the Elists table. The values used for
64 -- the type Elist_Id are subscripts into this table. The First_Elmt field
65 -- (Lfield1) points to the first element on the list, or to No_Elmt in the
66 -- case of an empty list. Similarly the Last_Elmt field (Lfield2) points to
67 -- the last element on the list or to No_Elmt in the case of an empty list.
69 -- The elements themselves are entries in the Elmts table. The Next field
70 -- of each entry points to the next element, or to the Elist header if this
71 -- is the last item in the list. The Node field points to the node which
72 -- is referenced by the corresponding list entry.
74 -------------------------
75 -- Element List Tables --
76 -------------------------
78 type Elist_Header is record
79 First : Elmt_Id;
80 Last : Elmt_Id;
81 end record;
83 package Elists is new Table.Table (
84 Table_Component_Type => Elist_Header,
85 Table_Index_Type => Elist_Id'Base,
86 Table_Low_Bound => First_Elist_Id,
87 Table_Initial => Alloc.Elists_Initial,
88 Table_Increment => Alloc.Elists_Increment,
89 Table_Name => "Elists");
91 type Elmt_Item is record
92 Node : Node_Or_Entity_Id;
93 Next : Union_Id;
94 end record;
96 package Elmts is new Table.Table (
97 Table_Component_Type => Elmt_Item,
98 Table_Index_Type => Elmt_Id'Base,
99 Table_Low_Bound => First_Elmt_Id,
100 Table_Initial => Alloc.Elmts_Initial,
101 Table_Increment => Alloc.Elmts_Increment,
102 Table_Name => "Elmts");
104 -----------------
105 -- Append_Elmt --
106 -----------------
108 procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
109 L : constant Elmt_Id := Elists.Table (To).Last;
111 begin
112 Elmts.Increment_Last;
113 Elmts.Table (Elmts.Last).Node := N;
114 Elmts.Table (Elmts.Last).Next := Union_Id (To);
116 if L = No_Elmt then
117 Elists.Table (To).First := Elmts.Last;
118 else
119 Elmts.Table (L).Next := Union_Id (Elmts.Last);
120 end if;
122 Elists.Table (To).Last := Elmts.Last;
124 if Debug_Flag_N then
125 Write_Str ("Append new element Elmt_Id = ");
126 Write_Int (Int (Elmts.Last));
127 Write_Str (" to list Elist_Id = ");
128 Write_Int (Int (To));
129 Write_Str (" referencing Node_Or_Entity_Id = ");
130 Write_Int (Int (N));
131 Write_Eol;
132 end if;
133 end Append_Elmt;
135 ---------------------
136 -- Append_New_Elmt --
137 ---------------------
139 procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is
140 begin
141 if To = No_Elist then
142 To := New_Elmt_List;
143 end if;
145 Append_Elmt (N, To);
146 end Append_New_Elmt;
148 ------------------------
149 -- Append_Unique_Elmt --
150 ------------------------
152 procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
153 Elmt : Elmt_Id;
154 begin
155 Elmt := First_Elmt (To);
156 loop
157 if No (Elmt) then
158 Append_Elmt (N, To);
159 return;
160 elsif Node (Elmt) = N then
161 return;
162 else
163 Next_Elmt (Elmt);
164 end if;
165 end loop;
166 end Append_Unique_Elmt;
168 --------------
169 -- Contains --
170 --------------
172 function Contains (List : Elist_Id; N : Node_Or_Entity_Id) return Boolean is
173 Elmt : Elmt_Id;
175 begin
176 if Present (List) then
177 Elmt := First_Elmt (List);
178 while Present (Elmt) loop
179 if Node (Elmt) = N then
180 return True;
181 end if;
183 Next_Elmt (Elmt);
184 end loop;
185 end if;
187 return False;
188 end Contains;
190 --------------------
191 -- Elists_Address --
192 --------------------
194 function Elists_Address return System.Address is
195 begin
196 return Elists.Table (First_Elist_Id)'Address;
197 end Elists_Address;
199 -------------------
200 -- Elmts_Address --
201 -------------------
203 function Elmts_Address return System.Address is
204 begin
205 return Elmts.Table (First_Elmt_Id)'Address;
206 end Elmts_Address;
208 ----------------
209 -- First_Elmt --
210 ----------------
212 function First_Elmt (List : Elist_Id) return Elmt_Id is
213 begin
214 pragma Assert (List > Elist_Low_Bound);
215 return Elists.Table (List).First;
216 end First_Elmt;
218 ----------------
219 -- Initialize --
220 ----------------
222 procedure Initialize is
223 begin
224 Elists.Init;
225 Elmts.Init;
226 end Initialize;
228 -----------------------
229 -- Insert_Elmt_After --
230 -----------------------
232 procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is
233 Nxt : constant Union_Id := Elmts.Table (Elmt).Next;
235 begin
236 pragma Assert (Elmt /= No_Elmt);
238 Elmts.Increment_Last;
239 Elmts.Table (Elmts.Last).Node := N;
240 Elmts.Table (Elmts.Last).Next := Nxt;
242 Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);
244 if Nxt in Elist_Range then
245 Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;
246 end if;
247 end Insert_Elmt_After;
249 ------------------------
250 -- Is_Empty_Elmt_List --
251 ------------------------
253 function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is
254 begin
255 return Elists.Table (List).First = No_Elmt;
256 end Is_Empty_Elmt_List;
258 -------------------
259 -- Last_Elist_Id --
260 -------------------
262 function Last_Elist_Id return Elist_Id is
263 begin
264 return Elists.Last;
265 end Last_Elist_Id;
267 ---------------
268 -- Last_Elmt --
269 ---------------
271 function Last_Elmt (List : Elist_Id) return Elmt_Id is
272 begin
273 return Elists.Table (List).Last;
274 end Last_Elmt;
276 ------------------
277 -- Last_Elmt_Id --
278 ------------------
280 function Last_Elmt_Id return Elmt_Id is
281 begin
282 return Elmts.Last;
283 end Last_Elmt_Id;
285 -----------------
286 -- List_Length --
287 -----------------
289 function List_Length (List : Elist_Id) return Nat is
290 Elmt : Elmt_Id;
291 N : Nat;
293 begin
294 if List = No_Elist then
295 return 0;
297 else
298 N := 0;
299 Elmt := First_Elmt (List);
300 loop
301 if No (Elmt) then
302 return N;
303 else
304 N := N + 1;
305 Next_Elmt (Elmt);
306 end if;
307 end loop;
308 end if;
309 end List_Length;
311 ----------
312 -- Lock --
313 ----------
315 procedure Lock is
316 begin
317 Elists.Release;
318 Elists.Locked := True;
319 Elmts.Release;
320 Elmts.Locked := True;
321 end Lock;
323 --------------------
324 -- New_Copy_Elist --
325 --------------------
327 function New_Copy_Elist (List : Elist_Id) return Elist_Id is
328 Result : Elist_Id;
329 Elmt : Elmt_Id;
331 begin
332 if List = No_Elist then
333 return No_Elist;
335 -- Replicate the contents of the input list while preserving the
336 -- original order.
338 else
339 Result := New_Elmt_List;
341 Elmt := First_Elmt (List);
342 while Present (Elmt) loop
343 Append_Elmt (Node (Elmt), Result);
344 Next_Elmt (Elmt);
345 end loop;
347 return Result;
348 end if;
349 end New_Copy_Elist;
351 -------------------
352 -- New_Elmt_List --
353 -------------------
355 function New_Elmt_List return Elist_Id is
356 begin
357 Elists.Increment_Last;
358 Elists.Table (Elists.Last).First := No_Elmt;
359 Elists.Table (Elists.Last).Last := No_Elmt;
361 if Debug_Flag_N then
362 Write_Str ("Allocate new element list, returned ID = ");
363 Write_Int (Int (Elists.Last));
364 Write_Eol;
365 end if;
367 return Elists.Last;
368 end New_Elmt_List;
370 -------------------
371 -- New_Elmt_List --
372 -------------------
374 function New_Elmt_List (Elmt1 : Node_Or_Entity_Id)
375 return Elist_Id
377 L : constant Elist_Id := New_Elmt_List;
378 begin
379 Append_Elmt (Elmt1, L);
380 return L;
381 end New_Elmt_List;
383 -------------------
384 -- New_Elmt_List --
385 -------------------
387 function New_Elmt_List
388 (Elmt1 : Node_Or_Entity_Id;
389 Elmt2 : Node_Or_Entity_Id) return Elist_Id
391 L : constant Elist_Id := New_Elmt_List (Elmt1);
392 begin
393 Append_Elmt (Elmt2, L);
394 return L;
395 end New_Elmt_List;
397 -------------------
398 -- New_Elmt_List --
399 -------------------
401 function New_Elmt_List
402 (Elmt1 : Node_Or_Entity_Id;
403 Elmt2 : Node_Or_Entity_Id;
404 Elmt3 : Node_Or_Entity_Id) return Elist_Id
406 L : constant Elist_Id := New_Elmt_List (Elmt1, Elmt2);
407 begin
408 Append_Elmt (Elmt3, L);
409 return L;
410 end New_Elmt_List;
412 -------------------
413 -- New_Elmt_List --
414 -------------------
416 function New_Elmt_List
417 (Elmt1 : Node_Or_Entity_Id;
418 Elmt2 : Node_Or_Entity_Id;
419 Elmt3 : Node_Or_Entity_Id;
420 Elmt4 : Node_Or_Entity_Id) return Elist_Id
422 L : constant Elist_Id := New_Elmt_List (Elmt1, Elmt2, Elmt3);
423 begin
424 Append_Elmt (Elmt4, L);
425 return L;
426 end New_Elmt_List;
428 ---------------
429 -- Next_Elmt --
430 ---------------
432 function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is
433 N : constant Union_Id := Elmts.Table (Elmt).Next;
435 begin
436 if N in Elist_Range then
437 return No_Elmt;
438 else
439 return Elmt_Id (N);
440 end if;
441 end Next_Elmt;
443 procedure Next_Elmt (Elmt : in out Elmt_Id) is
444 begin
445 Elmt := Next_Elmt (Elmt);
446 end Next_Elmt;
448 --------
449 -- No --
450 --------
452 function No (List : Elist_Id) return Boolean is
453 begin
454 return List = No_Elist;
455 end No;
457 function No (Elmt : Elmt_Id) return Boolean is
458 begin
459 return Elmt = No_Elmt;
460 end No;
462 ----------
463 -- Node --
464 ----------
466 function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is
467 begin
468 if Elmt = No_Elmt then
469 return Empty;
470 else
471 return Elmts.Table (Elmt).Node;
472 end if;
473 end Node;
475 ----------------
476 -- Num_Elists --
477 ----------------
479 function Num_Elists return Nat is
480 begin
481 return Int (Elmts.Last) - Int (Elmts.First) + 1;
482 end Num_Elists;
484 ------------------
485 -- Prepend_Elmt --
486 ------------------
488 procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
489 F : constant Elmt_Id := Elists.Table (To).First;
491 begin
492 Elmts.Increment_Last;
493 Elmts.Table (Elmts.Last).Node := N;
495 if F = No_Elmt then
496 Elists.Table (To).Last := Elmts.Last;
497 Elmts.Table (Elmts.Last).Next := Union_Id (To);
498 else
499 Elmts.Table (Elmts.Last).Next := Union_Id (F);
500 end if;
502 Elists.Table (To).First := Elmts.Last;
503 end Prepend_Elmt;
505 -------------------------
506 -- Prepend_Unique_Elmt --
507 -------------------------
509 procedure Prepend_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
510 begin
511 if not Contains (To, N) then
512 Prepend_Elmt (N, To);
513 end if;
514 end Prepend_Unique_Elmt;
516 -------------
517 -- Present --
518 -------------
520 function Present (List : Elist_Id) return Boolean is
521 begin
522 return List /= No_Elist;
523 end Present;
525 function Present (Elmt : Elmt_Id) return Boolean is
526 begin
527 return Elmt /= No_Elmt;
528 end Present;
530 ------------
531 -- Remove --
532 ------------
534 procedure Remove (List : Elist_Id; N : Node_Or_Entity_Id) is
535 Elmt : Elmt_Id;
537 begin
538 if Present (List) then
539 Elmt := First_Elmt (List);
540 while Present (Elmt) loop
541 if Node (Elmt) = N then
542 Remove_Elmt (List, Elmt);
543 exit;
544 end if;
546 Next_Elmt (Elmt);
547 end loop;
548 end if;
549 end Remove;
551 -----------------
552 -- Remove_Elmt --
553 -----------------
555 procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is
556 Nxt : Elmt_Id;
557 Prv : Elmt_Id;
559 begin
560 Nxt := Elists.Table (List).First;
562 -- Case of removing only element in the list
564 if Elmts.Table (Nxt).Next in Elist_Range then
565 pragma Assert (Nxt = Elmt);
567 Elists.Table (List).First := No_Elmt;
568 Elists.Table (List).Last := No_Elmt;
570 -- Case of removing the first element in the list
572 elsif Nxt = Elmt then
573 Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);
575 -- Case of removing second or later element in the list
577 else
578 loop
579 Prv := Nxt;
580 Nxt := Elmt_Id (Elmts.Table (Prv).Next);
581 exit when Nxt = Elmt
582 or else Elmts.Table (Nxt).Next in Elist_Range;
583 end loop;
585 pragma Assert (Nxt = Elmt);
587 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
589 if Elmts.Table (Prv).Next in Elist_Range then
590 Elists.Table (List).Last := Prv;
591 end if;
592 end if;
593 end Remove_Elmt;
595 ----------------------
596 -- Remove_Last_Elmt --
597 ----------------------
599 procedure Remove_Last_Elmt (List : Elist_Id) is
600 Nxt : Elmt_Id;
601 Prv : Elmt_Id;
603 begin
604 Nxt := Elists.Table (List).First;
606 -- Case of removing only element in the list
608 if Elmts.Table (Nxt).Next in Elist_Range then
609 Elists.Table (List).First := No_Elmt;
610 Elists.Table (List).Last := No_Elmt;
612 -- Case of at least two elements in list
614 else
615 loop
616 Prv := Nxt;
617 Nxt := Elmt_Id (Elmts.Table (Prv).Next);
618 exit when Elmts.Table (Nxt).Next in Elist_Range;
619 end loop;
621 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
622 Elists.Table (List).Last := Prv;
623 end if;
624 end Remove_Last_Elmt;
626 ------------------
627 -- Replace_Elmt --
628 ------------------
630 procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
631 begin
632 Elmts.Table (Elmt).Node := New_Node;
633 end Replace_Elmt;
635 ------------
636 -- Unlock --
637 ------------
639 procedure Unlock is
640 begin
641 Elists.Locked := False;
642 Elmts.Locked := False;
643 end Unlock;
645 end Elists;