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-2013, 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_Unique_Elmt -- 143 ------------------------ 144 145 procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is 146 Elmt : Elmt_Id; 147 begin 148 Elmt := First_Elmt (To); 149 loop 150 if No (Elmt) then 151 Append_Elmt (N, To); 152 return; 153 elsif Node (Elmt) = N then 154 return; 155 else 156 Next_Elmt (Elmt); 157 end if; 158 end loop; 159 end Append_Unique_Elmt; 160 161 -------------- 162 -- Contains -- 163 -------------- 164 165 function Contains (List : Elist_Id; N : Node_Or_Entity_Id) return Boolean is 166 Elmt : Elmt_Id; 167 168 begin 169 if Present (List) then 170 Elmt := First_Elmt (List); 171 while Present (Elmt) loop 172 if Node (Elmt) = N then 173 return True; 174 end if; 175 176 Next_Elmt (Elmt); 177 end loop; 178 end if; 179 180 return False; 181 end Contains; 182 183 -------------------- 184 -- Elists_Address -- 185 -------------------- 186 187 function Elists_Address return System.Address is 188 begin 189 return Elists.Table (First_Elist_Id)'Address; 190 end Elists_Address; 191 192 ------------------- 193 -- Elmts_Address -- 194 ------------------- 195 196 function Elmts_Address return System.Address is 197 begin 198 return Elmts.Table (First_Elmt_Id)'Address; 199 end Elmts_Address; 200 201 ---------------- 202 -- First_Elmt -- 203 ---------------- 204 205 function First_Elmt (List : Elist_Id) return Elmt_Id is 206 begin 207 pragma Assert (List > Elist_Low_Bound); 208 return Elists.Table (List).First; 209 end First_Elmt; 210 211 ---------------- 212 -- Initialize -- 213 ---------------- 214 215 procedure Initialize is 216 begin 217 Elists.Init; 218 Elmts.Init; 219 end Initialize; 220 221 ----------------------- 222 -- Insert_Elmt_After -- 223 ----------------------- 224 225 procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is 226 Nxt : constant Union_Id := Elmts.Table (Elmt).Next; 227 228 begin 229 pragma Assert (Elmt /= No_Elmt); 230 231 Elmts.Increment_Last; 232 Elmts.Table (Elmts.Last).Node := N; 233 Elmts.Table (Elmts.Last).Next := Nxt; 234 235 Elmts.Table (Elmt).Next := Union_Id (Elmts.Last); 236 237 if Nxt in Elist_Range then 238 Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last; 239 end if; 240 end Insert_Elmt_After; 241 242 ------------------------ 243 -- Is_Empty_Elmt_List -- 244 ------------------------ 245 246 function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is 247 begin 248 return Elists.Table (List).First = No_Elmt; 249 end Is_Empty_Elmt_List; 250 251 ------------------- 252 -- Last_Elist_Id -- 253 ------------------- 254 255 function Last_Elist_Id return Elist_Id is 256 begin 257 return Elists.Last; 258 end Last_Elist_Id; 259 260 --------------- 261 -- Last_Elmt -- 262 --------------- 263 264 function Last_Elmt (List : Elist_Id) return Elmt_Id is 265 begin 266 return Elists.Table (List).Last; 267 end Last_Elmt; 268 269 ------------------ 270 -- Last_Elmt_Id -- 271 ------------------ 272 273 function Last_Elmt_Id return Elmt_Id is 274 begin 275 return Elmts.Last; 276 end Last_Elmt_Id; 277 278 ---------- 279 -- Lock -- 280 ---------- 281 282 procedure Lock is 283 begin 284 Elists.Locked := True; 285 Elmts.Locked := True; 286 Elists.Release; 287 Elmts.Release; 288 end Lock; 289 290 -------------------- 291 -- New_Copy_Elist -- 292 -------------------- 293 294 function New_Copy_Elist (List : Elist_Id) return Elist_Id is 295 Result : Elist_Id; 296 Elmt : Elmt_Id; 297 298 begin 299 if List = No_Elist then 300 return No_Elist; 301 302 -- Replicate the contents of the input list while preserving the 303 -- original order. 304 305 else 306 Result := New_Elmt_List; 307 308 Elmt := First_Elmt (List); 309 while Present (Elmt) loop 310 Append_Elmt (Node (Elmt), Result); 311 Next_Elmt (Elmt); 312 end loop; 313 314 return Result; 315 end if; 316 end New_Copy_Elist; 317 318 ------------------- 319 -- New_Elmt_List -- 320 ------------------- 321 322 function New_Elmt_List return Elist_Id is 323 begin 324 Elists.Increment_Last; 325 Elists.Table (Elists.Last).First := No_Elmt; 326 Elists.Table (Elists.Last).Last := No_Elmt; 327 328 if Debug_Flag_N then 329 Write_Str ("Allocate new element list, returned ID = "); 330 Write_Int (Int (Elists.Last)); 331 Write_Eol; 332 end if; 333 334 return Elists.Last; 335 end New_Elmt_List; 336 337 --------------- 338 -- Next_Elmt -- 339 --------------- 340 341 function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is 342 N : constant Union_Id := Elmts.Table (Elmt).Next; 343 344 begin 345 if N in Elist_Range then 346 return No_Elmt; 347 else 348 return Elmt_Id (N); 349 end if; 350 end Next_Elmt; 351 352 procedure Next_Elmt (Elmt : in out Elmt_Id) is 353 begin 354 Elmt := Next_Elmt (Elmt); 355 end Next_Elmt; 356 357 -------- 358 -- No -- 359 -------- 360 361 function No (List : Elist_Id) return Boolean is 362 begin 363 return List = No_Elist; 364 end No; 365 366 function No (Elmt : Elmt_Id) return Boolean is 367 begin 368 return Elmt = No_Elmt; 369 end No; 370 371 ---------- 372 -- Node -- 373 ---------- 374 375 function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is 376 begin 377 if Elmt = No_Elmt then 378 return Empty; 379 else 380 return Elmts.Table (Elmt).Node; 381 end if; 382 end Node; 383 384 ---------------- 385 -- Num_Elists -- 386 ---------------- 387 388 function Num_Elists return Nat is 389 begin 390 return Int (Elmts.Last) - Int (Elmts.First) + 1; 391 end Num_Elists; 392 393 ------------------ 394 -- Prepend_Elmt -- 395 ------------------ 396 397 procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is 398 F : constant Elmt_Id := Elists.Table (To).First; 399 400 begin 401 Elmts.Increment_Last; 402 Elmts.Table (Elmts.Last).Node := N; 403 404 if F = No_Elmt then 405 Elists.Table (To).Last := Elmts.Last; 406 Elmts.Table (Elmts.Last).Next := Union_Id (To); 407 else 408 Elmts.Table (Elmts.Last).Next := Union_Id (F); 409 end if; 410 411 Elists.Table (To).First := Elmts.Last; 412 end Prepend_Elmt; 413 414 ------------- 415 -- Present -- 416 ------------- 417 418 function Present (List : Elist_Id) return Boolean is 419 begin 420 return List /= No_Elist; 421 end Present; 422 423 function Present (Elmt : Elmt_Id) return Boolean is 424 begin 425 return Elmt /= No_Elmt; 426 end Present; 427 428 ------------ 429 -- Remove -- 430 ------------ 431 432 procedure Remove (List : Elist_Id; N : Node_Or_Entity_Id) is 433 Elmt : Elmt_Id; 434 435 begin 436 if Present (List) then 437 Elmt := First_Elmt (List); 438 while Present (Elmt) loop 439 if Node (Elmt) = N then 440 Remove_Elmt (List, Elmt); 441 exit; 442 end if; 443 444 Next_Elmt (Elmt); 445 end loop; 446 end if; 447 end Remove; 448 449 ----------------- 450 -- Remove_Elmt -- 451 ----------------- 452 453 procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is 454 Nxt : Elmt_Id; 455 Prv : Elmt_Id; 456 457 begin 458 Nxt := Elists.Table (List).First; 459 460 -- Case of removing only element in the list 461 462 if Elmts.Table (Nxt).Next in Elist_Range then 463 pragma Assert (Nxt = Elmt); 464 465 Elists.Table (List).First := No_Elmt; 466 Elists.Table (List).Last := No_Elmt; 467 468 -- Case of removing the first element in the list 469 470 elsif Nxt = Elmt then 471 Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next); 472 473 -- Case of removing second or later element in the list 474 475 else 476 loop 477 Prv := Nxt; 478 Nxt := Elmt_Id (Elmts.Table (Prv).Next); 479 exit when Nxt = Elmt 480 or else Elmts.Table (Nxt).Next in Elist_Range; 481 end loop; 482 483 pragma Assert (Nxt = Elmt); 484 485 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; 486 487 if Elmts.Table (Prv).Next in Elist_Range then 488 Elists.Table (List).Last := Prv; 489 end if; 490 end if; 491 end Remove_Elmt; 492 493 ---------------------- 494 -- Remove_Last_Elmt -- 495 ---------------------- 496 497 procedure Remove_Last_Elmt (List : Elist_Id) is 498 Nxt : Elmt_Id; 499 Prv : Elmt_Id; 500 501 begin 502 Nxt := Elists.Table (List).First; 503 504 -- Case of removing only element in the list 505 506 if Elmts.Table (Nxt).Next in Elist_Range then 507 Elists.Table (List).First := No_Elmt; 508 Elists.Table (List).Last := No_Elmt; 509 510 -- Case of at least two elements in list 511 512 else 513 loop 514 Prv := Nxt; 515 Nxt := Elmt_Id (Elmts.Table (Prv).Next); 516 exit when Elmts.Table (Nxt).Next in Elist_Range; 517 end loop; 518 519 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next; 520 Elists.Table (List).Last := Prv; 521 end if; 522 end Remove_Last_Elmt; 523 524 ------------------ 525 -- Replace_Elmt -- 526 ------------------ 527 528 procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is 529 begin 530 Elmts.Table (Elmt).Node := New_Node; 531 end Replace_Elmt; 532 533 --------------- 534 -- Tree_Read -- 535 --------------- 536 537 procedure Tree_Read is 538 begin 539 Elists.Tree_Read; 540 Elmts.Tree_Read; 541 end Tree_Read; 542 543 ---------------- 544 -- Tree_Write -- 545 ---------------- 546 547 procedure Tree_Write is 548 begin 549 Elists.Tree_Write; 550 Elmts.Tree_Write; 551 end Tree_Write; 552 553 ------------ 554 -- Unlock -- 555 ------------ 556 557 procedure Unlock is 558 begin 559 Elists.Locked := False; 560 Elmts.Locked := False; 561 end Unlock; 562 563end Elists; 564