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-2023, 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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  WARNING: There is a C version of this package. Any changes to this
  27 --  source file must be properly reflected in the C header a-elists.h.
  28
  29 with Alloc;
  30 with Debug;  use Debug;
  31 with Output; use Output;
  32 with Table;
  33
  34 package body Elists is
  35
  36    -------------------------------------
  37    -- Implementation of Element Lists --
  38    -------------------------------------
  39
  40    --  Element lists are composed of three types of entities. The element
  41    --  list header, which references the first and last elements of the
  42    --  list, the elements themselves which are singly linked and also
  43    --  reference the nodes on the list, and finally the nodes themselves.
  44    --  The following diagram shows how an element list is represented:
  45
  46    --       +----------------------------------------------------+
  47    --       |  +------------------------------------------+      |
  48    --       |  |                                          |      |
  49    --       V  |                                          V      |
  50    --    +-----|--+    +-------+    +-------+         +-------+  |
  51    --    |  Elmt  |    |  1st  |    |  2nd  |         |  Last |  |
  52    --    |  List  |--->|  Elmt |--->|  Elmt  ---...-->|  Elmt ---+
  53    --    | Header |    |   |   |    |   |   |         |   |   |
  54    --    +--------+    +---|---+    +---|---+         +---|---+
  55    --                      |            |                 |
  56    --                      V            V                 V
  57    --                  +-------+    +-------+         +-------+
  58    --                  |       |    |       |         |       |
  59    --                  | Node1 |    | Node2 |         | Node3 |
  60    --                  |       |    |       |         |       |
  61    --                  +-------+    +-------+         +-------+
  62
  63    --  The list header is an entry in the Elists table. The values used for
  64    --  the type Elist_Id are subscripts into this table. The First_Elmt field
  65    --  (Lfield1) points to the first element on the list, or to No_Elmt in the
  66    --  case of an empty list. Similarly the Last_Elmt field (Lfield2) points to
  67    --  the last element on the list or to No_Elmt in the case of an empty list.
  68
  69    --  The elements themselves are entries in the Elmts table. The Next field
  70    --  of each entry points to the next element, or to the Elist header if this
  71    --  is the last item in the list. The Node field points to the node which
  72    --  is referenced by the corresponding list entry.
  73
  74    -------------------------
  75    -- Element List Tables --
  76    -------------------------
  77
  78    type Elist_Header is record
  79       First : Elmt_Id;
  80       Last  : Elmt_Id;
  81    end record;
  82
  83    package Elists is new Table.Table (
  84      Table_Component_Type => Elist_Header,
  85      Table_Index_Type     => Elist_Id'Base,
  86      Table_Low_Bound      => First_Elist_Id,
  87      Table_Initial        => Alloc.Elists_Initial,
  88      Table_Increment      => Alloc.Elists_Increment,
  89      Table_Name           => "Elists");
  90
  91    type Elmt_Item is record
  92       Node : Node_Or_Entity_Id;
  93       Next : Union_Id;
  94    end record;
  95
  96    package Elmts is new Table.Table (
  97      Table_Component_Type => Elmt_Item,
  98      Table_Index_Type     => Elmt_Id'Base,
  99      Table_Low_Bound      => First_Elmt_Id,
 100      Table_Initial        => Alloc.Elmts_Initial,
 101      Table_Increment      => Alloc.Elmts_Increment,
 102      Table_Name           => "Elmts");
 103
 104    -----------------
 105    -- Append_Elmt --
 106    -----------------
 107
 108    procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
 109       L : constant Elmt_Id := Elists.Table (To).Last;
 110
 111    begin
 112       Elmts.Increment_Last;
 113       Elmts.Table (Elmts.Last).Node := N;
 114       Elmts.Table (Elmts.Last).Next := Union_Id (To);
 115
 116       if L = No_Elmt then
 117          Elists.Table (To).First := Elmts.Last;
 118       else
 119          Elmts.Table (L).Next := Union_Id (Elmts.Last);
 120       end if;
 121
 122       Elists.Table (To).Last  := Elmts.Last;
 123
 124       if Debug_Flag_N then
 125          Write_Str ("Append new element Elmt_Id = ");
 126          Write_Int (Int (Elmts.Last));
 127          Write_Str (" to list Elist_Id = ");
 128          Write_Int (Int (To));
 129          Write_Str (" referencing Node_Or_Entity_Id = ");
 130          Write_Int (Int (N));
 131          Write_Eol;
 132       end if;
 133    end Append_Elmt;
 134
 135    ---------------------
 136    -- Append_New_Elmt --
 137    ---------------------
 138
 139    procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is
 140    begin
 141       if To = No_Elist then
 142          To := New_Elmt_List;
 143       end if;
 144
 145       Append_Elmt (N, To);
 146    end Append_New_Elmt;
 147
 148    ------------------------
 149    -- Append_Unique_Elmt --
 150    ------------------------
 151
 152    procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
 153       Elmt : Elmt_Id;
 154    begin
 155       Elmt := First_Elmt (To);
 156       loop
 157          if No (Elmt) then
 158             Append_Elmt (N, To);
 159             return;
 160          elsif Node (Elmt) = N then
 161             return;
 162          else
 163             Next_Elmt (Elmt);
 164          end if;
 165       end loop;
 166    end Append_Unique_Elmt;
 167
 168    --------------
 169    -- Contains --
 170    --------------
 171
 172    function Contains (List : Elist_Id; N : Node_Or_Entity_Id) return Boolean is
 173       Elmt : Elmt_Id;
 174
 175    begin
 176       if Present (List) then
 177          Elmt := First_Elmt (List);
 178          while Present (Elmt) loop
 179             if Node (Elmt) = N then
 180                return True;
 181             end if;
 182
 183             Next_Elmt (Elmt);
 184          end loop;
 185       end if;
 186
 187       return False;
 188    end Contains;
 189
 190    --------------------
 191    -- Elists_Address --
 192    --------------------
 193
 194    function Elists_Address return System.Address is
 195    begin
 196       return Elists.Table (First_Elist_Id)'Address;
 197    end Elists_Address;
 198
 199    -------------------
 200    -- Elmts_Address --
 201    -------------------
 202
 203    function Elmts_Address return System.Address is
 204    begin
 205       return Elmts.Table (First_Elmt_Id)'Address;
 206    end Elmts_Address;
 207
 208    ----------------
 209    -- First_Elmt --
 210    ----------------
 211
 212    function First_Elmt (List : Elist_Id) return Elmt_Id is
 213    begin
 214       pragma Assert (List > Elist_Low_Bound);
 215       return Elists.Table (List).First;
 216    end First_Elmt;
 217
 218    ----------------
 219    -- Initialize --
 220    ----------------
 221
 222    procedure Initialize is
 223    begin
 224       Elists.Init;
 225       Elmts.Init;
 226    end Initialize;
 227
 228    -----------------------
 229    -- Insert_Elmt_After --
 230    -----------------------
 231
 232    procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is
 233       Nxt : constant Union_Id := Elmts.Table (Elmt).Next;
 234
 235    begin
 236       pragma Assert (Elmt /= No_Elmt);
 237
 238       Elmts.Increment_Last;
 239       Elmts.Table (Elmts.Last).Node := N;
 240       Elmts.Table (Elmts.Last).Next := Nxt;
 241
 242       Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);
 243
 244       if Nxt in Elist_Range then
 245          Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;
 246       end if;
 247    end Insert_Elmt_After;
 248
 249    ------------------------
 250    -- Is_Empty_Elmt_List --
 251    ------------------------
 252
 253    function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is
 254    begin
 255       return Elists.Table (List).First = No_Elmt;
 256    end Is_Empty_Elmt_List;
 257
 258    -------------------
 259    -- Last_Elist_Id --
 260    -------------------
 261
 262    function Last_Elist_Id return Elist_Id is
 263    begin
 264       return Elists.Last;
 265    end Last_Elist_Id;
 266
 267    ---------------
 268    -- Last_Elmt --
 269    ---------------
 270
 271    function Last_Elmt (List : Elist_Id) return Elmt_Id is
 272    begin
 273       return Elists.Table (List).Last;
 274    end Last_Elmt;
 275
 276    ------------------
 277    -- Last_Elmt_Id --
 278    ------------------
 279
 280    function Last_Elmt_Id return Elmt_Id is
 281    begin
 282       return Elmts.Last;
 283    end Last_Elmt_Id;
 284
 285    -----------------
 286    -- List_Length --
 287    -----------------
 288
 289    function List_Length (List : Elist_Id) return Nat is
 290       Elmt : Elmt_Id;
 291       N    : Nat;
 292
 293    begin
 294       if List = No_Elist then
 295          return 0;
 296
 297       else
 298          N := 0;
 299          Elmt := First_Elmt (List);
 300          loop
 301             if No (Elmt) then
 302                return N;
 303             else
 304                N := N + 1;
 305                Next_Elmt (Elmt);
 306             end if;
 307          end loop;
 308       end if;
 309    end List_Length;
 310
 311    ----------
 312    -- Lock --
 313    ----------
 314
 315    procedure Lock is
 316    begin
 317       Elists.Release;
 318       Elists.Locked := True;
 319       Elmts.Release;
 320       Elmts.Locked := True;
 321    end Lock;
 322
 323    --------------------
 324    -- New_Copy_Elist --
 325    --------------------
 326
 327    function New_Copy_Elist (List : Elist_Id) return Elist_Id is
 328       Result : Elist_Id;
 329       Elmt   : Elmt_Id;
 330
 331    begin
 332       if List = No_Elist then
 333          return No_Elist;
 334
 335       --  Replicate the contents of the input list while preserving the
 336       --  original order.
 337
 338       else
 339          Result := New_Elmt_List;
 340
 341          Elmt := First_Elmt (List);
 342          while Present (Elmt) loop
 343             Append_Elmt (Node (Elmt), Result);
 344             Next_Elmt (Elmt);
 345          end loop;
 346
 347          return Result;
 348       end if;
 349    end New_Copy_Elist;
 350
 351    -------------------
 352    -- New_Elmt_List --
 353    -------------------
 354
 355    function New_Elmt_List return Elist_Id is
 356    begin
 357       Elists.Increment_Last;
 358       Elists.Table (Elists.Last).First := No_Elmt;
 359       Elists.Table (Elists.Last).Last  := No_Elmt;
 360
 361       if Debug_Flag_N then
 362          Write_Str ("Allocate new element list, returned ID = ");
 363          Write_Int (Int (Elists.Last));
 364          Write_Eol;
 365       end if;
 366
 367       return Elists.Last;
 368    end New_Elmt_List;
 369
 370    -------------------
 371    -- New_Elmt_List --
 372    -------------------
 373
 374    function New_Elmt_List (Elmt1 : Node_Or_Entity_Id)
 375      return Elist_Id
 376    is
 377       L : constant Elist_Id := New_Elmt_List;
 378    begin
 379       Append_Elmt (Elmt1, L);
 380       return L;
 381    end New_Elmt_List;
 382
 383    -------------------
 384    -- New_Elmt_List --
 385    -------------------
 386
 387    function New_Elmt_List
 388      (Elmt1 : Node_Or_Entity_Id;
 389       Elmt2 : Node_Or_Entity_Id) return Elist_Id
 390    is
 391       L : constant Elist_Id := New_Elmt_List (Elmt1);
 392    begin
 393       Append_Elmt (Elmt2, L);
 394       return L;
 395    end New_Elmt_List;
 396
 397    -------------------
 398    -- New_Elmt_List --
 399    -------------------
 400
 401    function New_Elmt_List
 402      (Elmt1 : Node_Or_Entity_Id;
 403       Elmt2 : Node_Or_Entity_Id;
 404       Elmt3 : Node_Or_Entity_Id) return Elist_Id
 405    is
 406       L : constant Elist_Id := New_Elmt_List (Elmt1, Elmt2);
 407    begin
 408       Append_Elmt (Elmt3, L);
 409       return L;
 410    end New_Elmt_List;
 411
 412    -------------------
 413    -- New_Elmt_List --
 414    -------------------
 415
 416    function New_Elmt_List
 417      (Elmt1 : Node_Or_Entity_Id;
 418       Elmt2 : Node_Or_Entity_Id;
 419       Elmt3 : Node_Or_Entity_Id;
 420       Elmt4 : Node_Or_Entity_Id) return Elist_Id
 421    is
 422       L : constant Elist_Id := New_Elmt_List (Elmt1, Elmt2, Elmt3);
 423    begin
 424       Append_Elmt (Elmt4, L);
 425       return L;
 426    end New_Elmt_List;
 427
 428    ---------------
 429    -- Next_Elmt --
 430    ---------------
 431
 432    function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is
 433       N : constant Union_Id := Elmts.Table (Elmt).Next;
 434
 435    begin
 436       if N in Elist_Range then
 437          return No_Elmt;
 438       else
 439          return Elmt_Id (N);
 440       end if;
 441    end Next_Elmt;
 442
 443    procedure Next_Elmt (Elmt : in out Elmt_Id) is
 444    begin
 445       Elmt := Next_Elmt (Elmt);
 446    end Next_Elmt;
 447
 448    --------
 449    -- No --
 450    --------
 451
 452    function No (List : Elist_Id) return Boolean is
 453    begin
 454       return List = No_Elist;
 455    end No;
 456
 457    function No (Elmt : Elmt_Id) return Boolean is
 458    begin
 459       return Elmt = No_Elmt;
 460    end No;
 461
 462    ----------
 463    -- Node --
 464    ----------
 465
 466    function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is
 467    begin
 468       if Elmt = No_Elmt then
 469          return Empty;
 470       else
 471          return Elmts.Table (Elmt).Node;
 472       end if;
 473    end Node;
 474
 475    ----------------
 476    -- Num_Elists --
 477    ----------------
 478
 479    function Num_Elists return Nat is
 480    begin
 481       return Int (Elmts.Last) - Int (Elmts.First) + 1;
 482    end Num_Elists;
 483
 484    ------------------
 485    -- Prepend_Elmt --
 486    ------------------
 487
 488    procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
 489       F : constant Elmt_Id := Elists.Table (To).First;
 490
 491    begin
 492       Elmts.Increment_Last;
 493       Elmts.Table (Elmts.Last).Node := N;
 494
 495       if F = No_Elmt then
 496          Elists.Table (To).Last := Elmts.Last;
 497          Elmts.Table (Elmts.Last).Next := Union_Id (To);
 498       else
 499          Elmts.Table (Elmts.Last).Next := Union_Id (F);
 500       end if;
 501
 502       Elists.Table (To).First  := Elmts.Last;
 503    end Prepend_Elmt;
 504
 505    -------------------------
 506    -- Prepend_Unique_Elmt --
 507    -------------------------
 508
 509    procedure Prepend_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
 510    begin
 511       if not Contains (To, N) then
 512          Prepend_Elmt (N, To);
 513       end if;
 514    end Prepend_Unique_Elmt;
 515
 516    -------------
 517    -- Present --
 518    -------------
 519
 520    function Present (List : Elist_Id) return Boolean is
 521    begin
 522       return List /= No_Elist;
 523    end Present;
 524
 525    function Present (Elmt : Elmt_Id) return Boolean is
 526    begin
 527       return Elmt /= No_Elmt;
 528    end Present;
 529
 530    ------------
 531    -- Remove --
 532    ------------
 533
 534    procedure Remove (List : Elist_Id; N : Node_Or_Entity_Id) is
 535       Elmt : Elmt_Id;
 536
 537    begin
 538       if Present (List) then
 539          Elmt := First_Elmt (List);
 540          while Present (Elmt) loop
 541             if Node (Elmt) = N then
 542                Remove_Elmt (List, Elmt);
 543                exit;
 544             end if;
 545
 546             Next_Elmt (Elmt);
 547          end loop;
 548       end if;
 549    end Remove;
 550
 551    -----------------
 552    -- Remove_Elmt --
 553    -----------------
 554
 555    procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is
 556       Nxt : Elmt_Id;
 557       Prv : Elmt_Id;
 558
 559    begin
 560       Nxt := Elists.Table (List).First;
 561
 562       --  Case of removing only element in the list
 563
 564       if Elmts.Table (Nxt).Next in Elist_Range then
 565          pragma Assert (Nxt = Elmt);
 566
 567          Elists.Table (List).First := No_Elmt;
 568          Elists.Table (List).Last  := No_Elmt;
 569
 570       --  Case of removing the first element in the list
 571
 572       elsif Nxt = Elmt then
 573          Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);
 574
 575       --  Case of removing second or later element in the list
 576
 577       else
 578          loop
 579             Prv := Nxt;
 580             Nxt := Elmt_Id (Elmts.Table (Prv).Next);
 581             exit when Nxt = Elmt
 582               or else Elmts.Table (Nxt).Next in Elist_Range;
 583          end loop;
 584
 585          pragma Assert (Nxt = Elmt);
 586
 587          Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
 588
 589          if Elmts.Table (Prv).Next in Elist_Range then
 590             Elists.Table (List).Last := Prv;
 591          end if;
 592       end if;
 593    end Remove_Elmt;
 594
 595    ----------------------
 596    -- Remove_Last_Elmt --
 597    ----------------------
 598
 599    procedure Remove_Last_Elmt (List : Elist_Id) is
 600       Nxt : Elmt_Id;
 601       Prv : Elmt_Id;
 602
 603    begin
 604       Nxt := Elists.Table (List).First;
 605
 606       --  Case of removing only element in the list
 607
 608       if Elmts.Table (Nxt).Next in Elist_Range then
 609          Elists.Table (List).First := No_Elmt;
 610          Elists.Table (List).Last  := No_Elmt;
 611
 612       --  Case of at least two elements in list
 613
 614       else
 615          loop
 616             Prv := Nxt;
 617             Nxt := Elmt_Id (Elmts.Table (Prv).Next);
 618             exit when Elmts.Table (Nxt).Next in Elist_Range;
 619          end loop;
 620
 621          Elmts.Table (Prv).Next   := Elmts.Table (Nxt).Next;
 622          Elists.Table (List).Last := Prv;
 623       end if;
 624    end Remove_Last_Elmt;
 625
 626    ------------------
 627    -- Replace_Elmt --
 628    ------------------
 629
 630    procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
 631    begin
 632       Elmts.Table (Elmt).Node := New_Node;
 633    end Replace_Elmt;
 634
 635    ------------
 636    -- Unlock --
 637    ------------
 638
 639    procedure Unlock is
 640    begin
 641       Elists.Locked := False;
 642       Elmts.Locked := False;
 643    end Unlock;
 644
 645 end Elists;