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-2017, 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_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
 613 end Elists;