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-2020, 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------------------------------------------------------------------------------ 25 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. 28 29with Alloc; 30with Debug; use Debug; 31with Output; use Output; 32with Table; 33 34package body Elists is 35 36 ------------------------------------- 37 -- Implementation of Element Lists -- 38 ------------------------------------- 39 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: 45 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 -- +-------+ +-------+ +-------+ 62 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. 68 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. 73 74 ------------------------- 75 -- Element List Tables -- 76 ------------------------- 77 78 type Elist_Header is record 79 First : Elmt_Id; 80 Last : Elmt_Id; 81 end record; 82 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"); 90 91 type Elmt_Item is record 92 Node : Node_Or_Entity_Id; 93 Next : Union_Id; 94 end record; 95 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"); 103 104 ----------------- 105 -- Append_Elmt -- 106 ----------------- 107 108 procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is 109 L : constant Elmt_Id := Elists.Table (To).Last; 110 111 begin 112 Elmts.Increment_Last; 113 Elmts.Table (Elmts.Last).Node := N; 114 Elmts.Table (Elmts.Last).Next := Union_Id (To); 115 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; 121 122 Elists.Table (To).Last := Elmts.Last; 123 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; 134 135 --------------------- 136 -- Append_New_Elmt -- 137 --------------------- 138 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; 144 145 Append_Elmt (N, To); 146 end Append_New_Elmt; 147 148 ------------------------ 149 -- Append_Unique_Elmt -- 150 ------------------------ 151 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; 167 168 -------------- 169 -- Contains -- 170 -------------- 171 172 function Contains (List : Elist_Id; N : Node_Or_Entity_Id) return Boolean is 173 Elmt : Elmt_Id; 174 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; 182 183 Next_Elmt (Elmt); 184 end loop; 185 end if; 186 187 return False; 188 end Contains; 189 190 -------------------- 191 -- Elists_Address -- 192 -------------------- 193 194 function Elists_Address return System.Address is 195 begin 196 return Elists.Table (First_Elist_Id)'Address; 197 end Elists_Address; 198 199 ------------------- 200 -- Elmts_Address -- 201 ------------------- 202 203 function Elmts_Address return System.Address is 204 begin 205 return Elmts.Table (First_Elmt_Id)'Address; 206 end Elmts_Address; 207 208 ---------------- 209 -- First_Elmt -- 210 ---------------- 211 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; 217 218 ---------------- 219 -- Initialize -- 220 ---------------- 221 222 procedure Initialize is 223 begin 224 Elists.Init; 225 Elmts.Init; 226 end Initialize; 227 228 ----------------------- 229 -- Insert_Elmt_After -- 230 ----------------------- 231 232 procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is 233 Nxt : constant Union_Id := Elmts.Table (Elmt).Next; 234 235 begin 236 pragma Assert (Elmt /= No_Elmt); 237 238 Elmts.Increment_Last; 239 Elmts.Table (Elmts.Last).Node := N; 240 Elmts.Table (Elmts.Last).Next := Nxt; 241 242 Elmts.Table (Elmt).Next := Union_Id (Elmts.Last); 243 244 if Nxt in Elist_Range then 245 Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last; 246 end if; 247 end Insert_Elmt_After; 248 249 ------------------------ 250 -- Is_Empty_Elmt_List -- 251 ------------------------ 252 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; 257 258 ------------------- 259 -- Last_Elist_Id -- 260 ------------------- 261 262 function Last_Elist_Id return Elist_Id is 263 begin 264 return Elists.Last; 265 end Last_Elist_Id; 266 267 --------------- 268 -- Last_Elmt -- 269 --------------- 270 271 function Last_Elmt (List : Elist_Id) return Elmt_Id is 272 begin 273 return Elists.Table (List).Last; 274 end Last_Elmt; 275 276 ------------------ 277 -- Last_Elmt_Id -- 278 ------------------ 279 280 function Last_Elmt_Id return Elmt_Id is 281 begin 282 return Elmts.Last; 283 end Last_Elmt_Id; 284 285 ----------------- 286 -- List_Length -- 287 ----------------- 288 289 function List_Length (List : Elist_Id) return Nat is 290 Elmt : Elmt_Id; 291 N : Nat; 292 293 begin 294 if List = No_Elist then 295 return 0; 296 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; 310 311 ---------- 312 -- Lock -- 313 ---------- 314 315 procedure Lock is 316 begin 317 Elists.Release; 318 Elists.Locked := True; 319 Elmts.Release; 320 Elmts.Locked := True; 321 end Lock; 322 323 -------------------- 324 -- New_Copy_Elist -- 325 -------------------- 326 327 function New_Copy_Elist (List : Elist_Id) return Elist_Id is 328 Result : Elist_Id; 329 Elmt : Elmt_Id; 330 331 begin 332 if List = No_Elist then 333 return No_Elist; 334 335 -- Replicate the contents of the input list while preserving the 336 -- original order. 337 338 else 339 Result := New_Elmt_List; 340 341 Elmt := First_Elmt (List); 342 while Present (Elmt) loop 343 Append_Elmt (Node (Elmt), Result); 344 Next_Elmt (Elmt); 345 end loop; 346 347 return Result; 348 end if; 349 end New_Copy_Elist; 350 351 ------------------- 352 -- New_Elmt_List -- 353 ------------------- 354 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; 360 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; 366 367 return Elists.Last; 368 end New_Elmt_List; 369 370 ------------------- 371 -- New_Elmt_List -- 372 ------------------- 373 374 function New_Elmt_List (Elmt1 : Node_Or_Entity_Id) 375 return Elist_Id 376 is 377 L : constant Elist_Id := New_Elmt_List; 378 begin 379 Append_Elmt (Elmt1, L); 380 return L; 381 end New_Elmt_List; 382 383 ------------------- 384 -- New_Elmt_List -- 385 ------------------- 386 387 function New_Elmt_List 388 (Elmt1 : Node_Or_Entity_Id; 389 Elmt2 : Node_Or_Entity_Id) return Elist_Id 390 is 391 L : constant Elist_Id := New_Elmt_List (Elmt1); 392 begin 393 Append_Elmt (Elmt2, L); 394 return L; 395 end New_Elmt_List; 396 397 ------------------- 398 -- New_Elmt_List -- 399 ------------------- 400 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 405 is 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; 411 412 ------------------- 413 -- New_Elmt_List -- 414 ------------------- 415 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 421 is 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; 427 428 --------------- 429 -- Next_Elmt -- 430 --------------- 431 432 function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is 433 N : constant Union_Id := Elmts.Table (Elmt).Next; 434 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; 442 443 procedure Next_Elmt (Elmt : in out Elmt_Id) is 444 begin 445 Elmt := Next_Elmt (Elmt); 446 end Next_Elmt; 447 448 -------- 449 -- No -- 450 -------- 451 452 function No (List : Elist_Id) return Boolean is 453 begin 454 return List = No_Elist; 455 end No; 456 457 function No (Elmt : Elmt_Id) return Boolean is 458 begin 459 return Elmt = No_Elmt; 460 end No; 461 462 ---------- 463 -- Node -- 464 ---------- 465 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; 474 475 ---------------- 476 -- Num_Elists -- 477 ---------------- 478 479 function Num_Elists return Nat is 480 begin 481 return Int (Elmts.Last) - Int (Elmts.First) + 1; 482 end Num_Elists; 483 484 ------------------ 485 -- Prepend_Elmt -- 486 ------------------ 487 488 procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is 489 F : constant Elmt_Id := Elists.Table (To).First; 490 491 begin 492 Elmts.Increment_Last; 493 Elmts.Table (Elmts.Last).Node := N; 494 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; 501 502 Elists.Table (To).First := Elmts.Last; 503 end Prepend_Elmt; 504 505 ------------------------- 506 -- Prepend_Unique_Elmt -- 507 ------------------------- 508 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; 515 516 ------------- 517 -- Present -- 518 ------------- 519 520 function Present (List : Elist_Id) return Boolean is 521 begin 522 return List /= No_Elist; 523 end Present; 524 525 function Present (Elmt : Elmt_Id) return Boolean is 526 begin 527 return Elmt /= No_Elmt; 528 end Present; 529 530 ------------ 531 -- Remove -- 532 ------------ 533 534 procedure Remove (List : Elist_Id; N : Node_Or_Entity_Id) is 535 Elmt : Elmt_Id; 536 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; 545 546 Next_Elmt (Elmt); 547 end loop; 548 end if; 549 end Remove; 550 551 ----------------- 552 -- Remove_Elmt -- 553 ----------------- 554 555 procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is 556 Nxt : Elmt_Id; 557 Prv : Elmt_Id; 558 559 begin 560 Nxt := Elists.Table (List).First; 561 562 -- Case of removing only element in the list 563 564 if Elmts.Table (Nxt).Next in Elist_Range then 565 pragma Assert (Nxt = Elmt); 566 567 Elists.Table (List).First := No_Elmt; 568 Elists.Table (List).Last := No_Elmt; 569 570 -- Case of removing the first element in the list 571 572 elsif Nxt = Elmt then 573 Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next); 574 575 -- Case of removing second or later element in the list 576 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; 584 585 pragma Assert (Nxt = Elmt); 586 587 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; 588 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; 594 595 ---------------------- 596 -- Remove_Last_Elmt -- 597 ---------------------- 598 599 procedure Remove_Last_Elmt (List : Elist_Id) is 600 Nxt : Elmt_Id; 601 Prv : Elmt_Id; 602 603 begin 604 Nxt := Elists.Table (List).First; 605 606 -- Case of removing only element in the list 607 608 if Elmts.Table (Nxt).Next in Elist_Range then 609 Elists.Table (List).First := No_Elmt; 610 Elists.Table (List).Last := No_Elmt; 611 612 -- Case of at least two elements in list 613 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; 620 621 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; 622 Elists.Table (List).Last := Prv; 623 end if; 624 end Remove_Last_Elmt; 625 626 ------------------ 627 -- Replace_Elmt -- 628 ------------------ 629 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; 634 635 ------------ 636 -- Unlock -- 637 ------------ 638 639 procedure Unlock is 640 begin 641 Elists.Locked := False; 642 Elmts.Locked := False; 643 end Unlock; 644 645end Elists; 646