gcc/ada/elists.adb

   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
  35 with Alloc;
  36 with Debug;  use Debug;
  37 with Output; use Output;
  38 with Table;
  39
  40 package 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
 563 end Elists;