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-2019, 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. -- 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/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 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 35with Alloc; 36with Debug; use Debug; 37with Output; use Output; 38with Table; 39 40package 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 80 ------------------------- 81 -- Element List Tables -- 82 ------------------------- 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, 91 Table_Index_Type => Elist_Id'Base, 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 98 Node : Node_Or_Entity_Id; 99 Next : Union_Id; 100 end record; 101 102 package Elmts is new Table.Table ( 103 Table_Component_Type => Elmt_Item, 104 Table_Index_Type => Elmt_Id'Base, 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 114 procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is 115 L : constant Elmt_Id := Elists.Table (To).Last; 116 117 begin 118 Elmts.Increment_Last; 119 Elmts.Table (Elmts.Last).Node := N; 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)); 135 Write_Str (" referencing Node_Or_Entity_Id = "); 136 Write_Int (Int (N)); 137 Write_Eol; 138 end if; 139 end Append_Elmt; 140 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 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 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 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 238 procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is 239 Nxt : constant Union_Id := Elmts.Table (Elmt).Next; 240 241 begin 242 pragma Assert (Elmt /= No_Elmt); 243 244 Elmts.Increment_Last; 245 Elmts.Table (Elmts.Last).Node := N; 246 Elmts.Table (Elmts.Last).Next := Nxt; 247 248 Elmts.Table (Elmt).Next := Union_Id (Elmts.Last); 249 250 if Nxt in Elist_Range then 251 Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last; 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 291 ----------------- 292 -- List_Length -- 293 ----------------- 294 295 function List_Length (List : Elist_Id) return Nat is 296 Elmt : Elmt_Id; 297 N : Nat; 298 299 begin 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; 315 end List_Length; 316 317 ---------- 318 -- Lock -- 319 ---------- 320 321 procedure Lock is 322 begin 323 Elists.Release; 324 Elists.Locked := True; 325 Elmts.Release; 326 Elmts.Locked := True; 327 end Lock; 328 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 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 410 ---------- 411 -- Node -- 412 ---------- 413 414 function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is 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 436 procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is 437 F : constant Elmt_Id := Elists.Table (To).First; 438 439 begin 440 Elmts.Increment_Last; 441 Elmts.Table (Elmts.Last).Node := N; 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; 451 end Prepend_Elmt; 452 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 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 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 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 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 578 procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is 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 603 ------------ 604 -- Unlock -- 605 ------------ 606 607 procedure Unlock is 608 begin 609 Elists.Locked := False; 610 Elmts.Locked := False; 611 end Unlock; 612 613end Elists; 614