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