gcc/ada/nlists.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               N L I S T S                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2020, 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 source
  27 --  file must be properly reflected in the corresponding C header a-nlists.h
  28
  29 with Alloc;
  30 with Atree;  use Atree;
  31 with Debug;  use Debug;
  32 with Output; use Output;
  33 with Sinfo;  use Sinfo;
  34 with Table;
  35
  36 package body Nlists is
  37    Locked : Boolean := False;
  38    --  Compiling with assertions enabled, list contents modifications are
  39    --  permitted only when this switch is set to False; compiling without
  40    --  assertions this lock has no effect.
  41
  42    use Atree_Private_Part;
  43    --  Get access to Nodes table
  44
  45    ----------------------------------
  46    -- Implementation of Node Lists --
  47    ----------------------------------
  48
  49    --  A node list is represented by a list header which contains
  50    --  three fields:
  51
  52    type List_Header is record
  53       First : Node_Or_Entity_Id;
  54       --  Pointer to first node in list. Empty if list is empty
  55
  56       Last : Node_Or_Entity_Id;
  57       --  Pointer to last node in list. Empty if list is empty
  58
  59       Parent : Node_Id;
  60       --  Pointer to parent of list. Empty if list has no parent
  61    end record;
  62
  63    --  The node lists are stored in a table indexed by List_Id values
  64
  65    package Lists is new Table.Table (
  66      Table_Component_Type => List_Header,
  67      Table_Index_Type     => List_Id'Base,
  68      Table_Low_Bound      => First_List_Id,
  69      Table_Initial        => Alloc.Lists_Initial,
  70      Table_Increment      => Alloc.Lists_Increment,
  71      Table_Name           => "Lists");
  72
  73    --  The nodes in the list all have the In_List flag set, and their Link
  74    --  fields (which otherwise point to the parent) contain the List_Id of
  75    --  the list header giving immediate access to the list containing the
  76    --  node, and its parent and first and last elements.
  77
  78    --  Two auxiliary tables, indexed by Node_Id values and built in parallel
  79    --  with the main nodes table and always having the same size contain the
  80    --  list link values that allow locating the previous and next node in a
  81    --  list. The entries in these tables are valid only if the In_List flag
  82    --  is set in the corresponding node. Next_Node is Empty at the end of a
  83    --  list and Prev_Node is Empty at the start of a list.
  84
  85    package Next_Node is new Table.Table (
  86       Table_Component_Type => Node_Or_Entity_Id,
  87       Table_Index_Type     => Node_Or_Entity_Id'Base,
  88       Table_Low_Bound      => First_Node_Id,
  89       Table_Initial        => Alloc.Nodes_Initial,
  90       Table_Increment      => Alloc.Nodes_Increment,
  91       Release_Threshold    => Alloc.Nodes_Release_Threshold,
  92       Table_Name           => "Next_Node");
  93
  94    package Prev_Node is new Table.Table (
  95       Table_Component_Type => Node_Or_Entity_Id,
  96       Table_Index_Type     => Node_Or_Entity_Id'Base,
  97       Table_Low_Bound      => First_Node_Id,
  98       Table_Initial        => Alloc.Nodes_Initial,
  99       Table_Increment      => Alloc.Nodes_Increment,
 100       Table_Name           => "Prev_Node");
 101
 102    -----------------------
 103    -- Local Subprograms --
 104    -----------------------
 105
 106    procedure Set_First (List : List_Id; To : Node_Or_Entity_Id);
 107    pragma Inline (Set_First);
 108    --  Sets First field of list header List to reference To
 109
 110    procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id);
 111    pragma Inline (Set_Last);
 112    --  Sets Last field of list header List to reference To
 113
 114    procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id);
 115    pragma Inline (Set_List_Link);
 116    --  Sets list link of Node to list header To
 117
 118    procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
 119    pragma Inline (Set_Next);
 120    --  Sets the Next_Node pointer for Node to reference To
 121
 122    procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id);
 123    pragma Inline (Set_Prev);
 124    --  Sets the Prev_Node pointer for Node to reference To
 125
 126    --------------------------
 127    -- Allocate_List_Tables --
 128    --------------------------
 129
 130    procedure Allocate_List_Tables (N : Node_Or_Entity_Id) is
 131       Old_Last : constant Node_Or_Entity_Id'Base := Next_Node.Last;
 132
 133    begin
 134       pragma Assert (N >= Old_Last);
 135       Next_Node.Set_Last (N);
 136       Prev_Node.Set_Last (N);
 137
 138       --  Make sure we have no uninitialized junk in any new entries added.
 139
 140       for J in Old_Last + 1 .. N loop
 141          Next_Node.Table (J) := Empty;
 142          Prev_Node.Table (J) := Empty;
 143       end loop;
 144    end Allocate_List_Tables;
 145
 146    ------------
 147    -- Append --
 148    ------------
 149
 150    procedure Append (Node : Node_Or_Entity_Id; To : List_Id) is
 151       L : constant Node_Or_Entity_Id := Last (To);
 152
 153       procedure Append_Debug;
 154       pragma Inline (Append_Debug);
 155       --  Output debug information if Debug_Flag_N set
 156
 157       ------------------
 158       -- Append_Debug --
 159       ------------------
 160
 161       procedure Append_Debug is
 162       begin
 163          if Debug_Flag_N then
 164             Write_Str ("Append node ");
 165             Write_Int (Int (Node));
 166             Write_Str (" to list ");
 167             Write_Int (Int (To));
 168             Write_Eol;
 169          end if;
 170       end Append_Debug;
 171
 172    --  Start of processing for Append
 173
 174    begin
 175       pragma Assert (not Is_List_Member (Node));
 176
 177       if Node = Error then
 178          return;
 179       end if;
 180
 181       pragma Debug (Append_Debug);
 182
 183       if No (L) then
 184          Set_First (To, Node);
 185       else
 186          Set_Next (L, Node);
 187       end if;
 188
 189       Set_Last (To, Node);
 190
 191       Nodes.Table (Node).In_List := True;
 192
 193       Set_Next      (Node, Empty);
 194       Set_Prev      (Node, L);
 195       Set_List_Link (Node, To);
 196    end Append;
 197
 198    -----------------
 199    -- Append_List --
 200    -----------------
 201
 202    procedure Append_List (List : List_Id; To : List_Id) is
 203       procedure Append_List_Debug;
 204       pragma Inline (Append_List_Debug);
 205       --  Output debug information if Debug_Flag_N set
 206
 207       -----------------------
 208       -- Append_List_Debug --
 209       -----------------------
 210
 211       procedure Append_List_Debug is
 212       begin
 213          if Debug_Flag_N then
 214             Write_Str ("Append list ");
 215             Write_Int (Int (List));
 216             Write_Str (" to list ");
 217             Write_Int (Int (To));
 218             Write_Eol;
 219          end if;
 220       end Append_List_Debug;
 221
 222    --  Start of processing for Append_List
 223
 224    begin
 225       if Is_Empty_List (List) then
 226          return;
 227
 228       else
 229          declare
 230             L : constant Node_Or_Entity_Id := Last (To);
 231             F : constant Node_Or_Entity_Id := First (List);
 232             N : Node_Or_Entity_Id;
 233
 234          begin
 235             pragma Debug (Append_List_Debug);
 236
 237             N := F;
 238             loop
 239                Set_List_Link (N, To);
 240                Next (N);
 241                exit when No (N);
 242             end loop;
 243
 244             if No (L) then
 245                Set_First (To, F);
 246             else
 247                Set_Next (L, F);
 248             end if;
 249
 250             Set_Prev (F, L);
 251             Set_Last (To, Last (List));
 252
 253             Set_First (List, Empty);
 254             Set_Last  (List, Empty);
 255          end;
 256       end if;
 257    end Append_List;
 258
 259    --------------------
 260    -- Append_List_To --
 261    --------------------
 262
 263    procedure Append_List_To (To : List_Id; List : List_Id) is
 264    begin
 265       Append_List (List, To);
 266    end Append_List_To;
 267
 268    ----------------
 269    -- Append_New --
 270    ----------------
 271
 272    procedure Append_New (Node : Node_Or_Entity_Id; To : in out List_Id) is
 273    begin
 274       if No (To) then
 275          To := New_List;
 276       end if;
 277
 278       Append (Node, To);
 279    end Append_New;
 280
 281    -------------------
 282    -- Append_New_To --
 283    -------------------
 284
 285    procedure Append_New_To (To : in out List_Id; Node : Node_Or_Entity_Id) is
 286    begin
 287       Append_New (Node, To);
 288    end Append_New_To;
 289
 290    ---------------
 291    -- Append_To --
 292    ---------------
 293
 294    procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id) is
 295    begin
 296       Append (Node, To);
 297    end Append_To;
 298
 299    -----------
 300    -- First --
 301    -----------
 302
 303    function First (List : List_Id) return Node_Or_Entity_Id is
 304    begin
 305       if List = No_List then
 306          return Empty;
 307       else
 308          pragma Assert (List <= Lists.Last);
 309          return Lists.Table (List).First;
 310       end if;
 311    end First;
 312
 313    ----------------------
 314    -- First_Non_Pragma --
 315    ----------------------
 316
 317    function First_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
 318       N : constant Node_Or_Entity_Id := First (List);
 319    begin
 320       if Nkind (N) /= N_Pragma
 321            and then
 322          Nkind (N) /= N_Null_Statement
 323       then
 324          return N;
 325       else
 326          return Next_Non_Pragma (N);
 327       end if;
 328    end First_Non_Pragma;
 329
 330    ----------------
 331    -- Initialize --
 332    ----------------
 333
 334    procedure Initialize is
 335    begin
 336       Lists.Init;
 337       Next_Node.Init;
 338       Prev_Node.Init;
 339
 340       --  Allocate Error_List list header
 341
 342       Lists.Increment_Last;
 343       Set_Parent (Error_List, Empty);
 344       Set_First  (Error_List, Empty);
 345       Set_Last   (Error_List, Empty);
 346    end Initialize;
 347
 348    ------------------
 349    -- In_Same_List --
 350    ------------------
 351
 352    function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean is
 353    begin
 354       return List_Containing (N1) = List_Containing (N2);
 355    end In_Same_List;
 356
 357    ------------------
 358    -- Insert_After --
 359    ------------------
 360
 361    procedure Insert_After
 362      (After : Node_Or_Entity_Id;
 363       Node  : Node_Or_Entity_Id)
 364    is
 365       procedure Insert_After_Debug;
 366       pragma Inline (Insert_After_Debug);
 367       --  Output debug information if Debug_Flag_N set
 368
 369       ------------------------
 370       -- Insert_After_Debug --
 371       ------------------------
 372
 373       procedure Insert_After_Debug is
 374       begin
 375          if Debug_Flag_N then
 376             Write_Str ("Insert node");
 377             Write_Int (Int (Node));
 378             Write_Str (" after node ");
 379             Write_Int (Int (After));
 380             Write_Eol;
 381          end if;
 382       end Insert_After_Debug;
 383
 384    --  Start of processing for Insert_After
 385
 386    begin
 387       pragma Assert
 388         (Is_List_Member (After) and then not Is_List_Member (Node));
 389
 390       if Node = Error then
 391          return;
 392       end if;
 393
 394       pragma Debug (Insert_After_Debug);
 395
 396       declare
 397          Before : constant Node_Or_Entity_Id := Next (After);
 398          LC     : constant List_Id           := List_Containing (After);
 399
 400       begin
 401          if Present (Before) then
 402             Set_Prev (Before, Node);
 403          else
 404             Set_Last (LC, Node);
 405          end if;
 406
 407          Set_Next (After, Node);
 408
 409          Nodes.Table (Node).In_List := True;
 410
 411          Set_Prev      (Node, After);
 412          Set_Next      (Node, Before);
 413          Set_List_Link (Node, LC);
 414       end;
 415    end Insert_After;
 416
 417    -------------------
 418    -- Insert_Before --
 419    -------------------
 420
 421    procedure Insert_Before
 422      (Before : Node_Or_Entity_Id;
 423       Node   : Node_Or_Entity_Id)
 424    is
 425       procedure Insert_Before_Debug;
 426       pragma Inline (Insert_Before_Debug);
 427       --  Output debug information if Debug_Flag_N set
 428
 429       -------------------------
 430       -- Insert_Before_Debug --
 431       -------------------------
 432
 433       procedure Insert_Before_Debug is
 434       begin
 435          if Debug_Flag_N then
 436             Write_Str ("Insert node");
 437             Write_Int (Int (Node));
 438             Write_Str (" before node ");
 439             Write_Int (Int (Before));
 440             Write_Eol;
 441          end if;
 442       end Insert_Before_Debug;
 443
 444    --  Start of processing for Insert_Before
 445
 446    begin
 447       pragma Assert
 448         (Is_List_Member (Before) and then not Is_List_Member (Node));
 449
 450       if Node = Error then
 451          return;
 452       end if;
 453
 454       pragma Debug (Insert_Before_Debug);
 455
 456       declare
 457          After : constant Node_Or_Entity_Id := Prev (Before);
 458          LC    : constant List_Id           := List_Containing (Before);
 459
 460       begin
 461          if Present (After) then
 462             Set_Next (After, Node);
 463          else
 464             Set_First (LC, Node);
 465          end if;
 466
 467          Set_Prev (Before, Node);
 468
 469          Nodes.Table (Node).In_List := True;
 470
 471          Set_Prev      (Node, After);
 472          Set_Next      (Node, Before);
 473          Set_List_Link (Node, LC);
 474       end;
 475    end Insert_Before;
 476
 477    -----------------------
 478    -- Insert_List_After --
 479    -----------------------
 480
 481    procedure Insert_List_After (After : Node_Or_Entity_Id; List : List_Id) is
 482
 483       procedure Insert_List_After_Debug;
 484       pragma Inline (Insert_List_After_Debug);
 485       --  Output debug information if Debug_Flag_N set
 486
 487       -----------------------------
 488       -- Insert_List_After_Debug --
 489       -----------------------------
 490
 491       procedure Insert_List_After_Debug is
 492       begin
 493          if Debug_Flag_N then
 494             Write_Str ("Insert list ");
 495             Write_Int (Int (List));
 496             Write_Str (" after node ");
 497             Write_Int (Int (After));
 498             Write_Eol;
 499          end if;
 500       end Insert_List_After_Debug;
 501
 502    --  Start of processing for Insert_List_After
 503
 504    begin
 505       pragma Assert (Is_List_Member (After));
 506
 507       if Is_Empty_List (List) then
 508          return;
 509
 510       else
 511          declare
 512             Before : constant Node_Or_Entity_Id := Next (After);
 513             LC     : constant List_Id           := List_Containing (After);
 514             F      : constant Node_Or_Entity_Id := First (List);
 515             L      : constant Node_Or_Entity_Id := Last (List);
 516             N      : Node_Or_Entity_Id;
 517
 518          begin
 519             pragma Debug (Insert_List_After_Debug);
 520
 521             N := F;
 522             loop
 523                Set_List_Link (N, LC);
 524                exit when N = L;
 525                Next (N);
 526             end loop;
 527
 528             if Present (Before) then
 529                Set_Prev (Before, L);
 530             else
 531                Set_Last (LC, L);
 532             end if;
 533
 534             Set_Next (After, F);
 535             Set_Prev (F, After);
 536             Set_Next (L, Before);
 537
 538             Set_First (List, Empty);
 539             Set_Last  (List, Empty);
 540          end;
 541       end if;
 542    end Insert_List_After;
 543
 544    ------------------------
 545    -- Insert_List_Before --
 546    ------------------------
 547
 548    procedure Insert_List_Before (Before : Node_Or_Entity_Id; List : List_Id) is
 549
 550       procedure Insert_List_Before_Debug;
 551       pragma Inline (Insert_List_Before_Debug);
 552       --  Output debug information if Debug_Flag_N set
 553
 554       ------------------------------
 555       -- Insert_List_Before_Debug --
 556       ------------------------------
 557
 558       procedure Insert_List_Before_Debug is
 559       begin
 560          if Debug_Flag_N then
 561             Write_Str ("Insert list ");
 562             Write_Int (Int (List));
 563             Write_Str (" before node ");
 564             Write_Int (Int (Before));
 565             Write_Eol;
 566          end if;
 567       end Insert_List_Before_Debug;
 568
 569    --  Start of processing for Insert_List_Before
 570
 571    begin
 572       pragma Assert (Is_List_Member (Before));
 573
 574       if Is_Empty_List (List) then
 575          return;
 576
 577       else
 578          declare
 579             After : constant Node_Or_Entity_Id := Prev (Before);
 580             LC    : constant List_Id           := List_Containing (Before);
 581             F     : constant Node_Or_Entity_Id := First (List);
 582             L     : constant Node_Or_Entity_Id := Last (List);
 583             N     : Node_Or_Entity_Id;
 584
 585          begin
 586             pragma Debug (Insert_List_Before_Debug);
 587
 588             N := F;
 589             loop
 590                Set_List_Link (N, LC);
 591                exit when N = L;
 592                Next (N);
 593             end loop;
 594
 595             if Present (After) then
 596                Set_Next (After, F);
 597             else
 598                Set_First (LC, F);
 599             end if;
 600
 601             Set_Prev (Before, L);
 602             Set_Prev (F, After);
 603             Set_Next (L, Before);
 604
 605             Set_First (List, Empty);
 606             Set_Last  (List, Empty);
 607          end;
 608       end if;
 609    end Insert_List_Before;
 610
 611    -------------------
 612    -- Is_Empty_List --
 613    -------------------
 614
 615    function Is_Empty_List (List : List_Id) return Boolean is
 616    begin
 617       return First (List) = Empty;
 618    end Is_Empty_List;
 619
 620    --------------------
 621    -- Is_List_Member --
 622    --------------------
 623
 624    function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean is
 625    begin
 626       return Nodes.Table (Node).In_List;
 627    end Is_List_Member;
 628
 629    -----------------------
 630    -- Is_Non_Empty_List --
 631    -----------------------
 632
 633    function Is_Non_Empty_List (List : List_Id) return Boolean is
 634    begin
 635       return First (List) /= Empty;
 636    end Is_Non_Empty_List;
 637
 638    ----------
 639    -- Last --
 640    ----------
 641
 642    function Last (List : List_Id) return Node_Or_Entity_Id is
 643    begin
 644       pragma Assert (List <= Lists.Last);
 645       return Lists.Table (List).Last;
 646    end Last;
 647
 648    ------------------
 649    -- Last_List_Id --
 650    ------------------
 651
 652    function Last_List_Id return List_Id is
 653    begin
 654       return Lists.Last;
 655    end Last_List_Id;
 656
 657    ---------------------
 658    -- Last_Non_Pragma --
 659    ---------------------
 660
 661    function Last_Non_Pragma (List : List_Id) return Node_Or_Entity_Id is
 662       N : constant Node_Or_Entity_Id := Last (List);
 663    begin
 664       if Nkind (N) /= N_Pragma then
 665          return N;
 666       else
 667          return Prev_Non_Pragma (N);
 668       end if;
 669    end Last_Non_Pragma;
 670
 671    ---------------------
 672    -- List_Containing --
 673    ---------------------
 674
 675    function List_Containing (Node : Node_Or_Entity_Id) return List_Id is
 676    begin
 677       pragma Assert (Is_List_Member (Node));
 678       return List_Id (Nodes.Table (Node).Link);
 679    end List_Containing;
 680
 681    -----------------
 682    -- List_Length --
 683    -----------------
 684
 685    function List_Length (List : List_Id) return Nat is
 686       Result : Nat;
 687       Node   : Node_Or_Entity_Id;
 688
 689    begin
 690       Result := 0;
 691       Node := First (List);
 692       while Present (Node) loop
 693          Result := Result + 1;
 694          Next (Node);
 695       end loop;
 696
 697       return Result;
 698    end List_Length;
 699
 700    -------------------
 701    -- Lists_Address --
 702    -------------------
 703
 704    function Lists_Address return System.Address is
 705    begin
 706       return Lists.Table (First_List_Id)'Address;
 707    end Lists_Address;
 708
 709    ----------
 710    -- Lock --
 711    ----------
 712
 713    procedure Lock is
 714    begin
 715       Lists.Release;
 716       Lists.Locked := True;
 717       Prev_Node.Release;
 718       Prev_Node.Locked := True;
 719       Next_Node.Release;
 720       Next_Node.Locked := True;
 721    end Lock;
 722
 723    ----------------
 724    -- Lock_Lists --
 725    ----------------
 726
 727    procedure Lock_Lists is
 728    begin
 729       pragma Assert (not Locked);
 730       Locked := True;
 731    end Lock_Lists;
 732
 733    -------------------
 734    -- New_Copy_List --
 735    -------------------
 736
 737    function New_Copy_List (List : List_Id) return List_Id is
 738       NL : List_Id;
 739       E  : Node_Or_Entity_Id;
 740
 741    begin
 742       if List = No_List then
 743          return No_List;
 744
 745       else
 746          NL := New_List;
 747          E := First (List);
 748
 749          while Present (E) loop
 750             Append (New_Copy (E), NL);
 751             Next (E);
 752          end loop;
 753
 754          return NL;
 755       end if;
 756    end New_Copy_List;
 757
 758    ----------------------------
 759    -- New_Copy_List_Original --
 760    ----------------------------
 761
 762    function New_Copy_List_Original (List : List_Id) return List_Id is
 763       NL : List_Id;
 764       E  : Node_Or_Entity_Id;
 765
 766    begin
 767       if List = No_List then
 768          return No_List;
 769
 770       else
 771          NL := New_List;
 772
 773          E := First (List);
 774          while Present (E) loop
 775             if Comes_From_Source (E) then
 776                Append (New_Copy (E), NL);
 777             end if;
 778
 779             Next (E);
 780          end loop;
 781
 782          return NL;
 783       end if;
 784    end New_Copy_List_Original;
 785
 786    --------------
 787    -- New_List --
 788    --------------
 789
 790    function New_List return List_Id is
 791
 792       procedure New_List_Debug;
 793       pragma Inline (New_List_Debug);
 794       --  Output debugging information if Debug_Flag_N is set
 795
 796       --------------------
 797       -- New_List_Debug --
 798       --------------------
 799
 800       procedure New_List_Debug is
 801       begin
 802          if Debug_Flag_N then
 803             Write_Str ("Allocate new list, returned ID = ");
 804             Write_Int (Int (Lists.Last));
 805             Write_Eol;
 806          end if;
 807       end New_List_Debug;
 808
 809    --  Start of processing for New_List
 810
 811    begin
 812       Lists.Increment_Last;
 813
 814       declare
 815          List : constant List_Id := Lists.Last;
 816
 817       begin
 818          Set_Parent (List, Empty);
 819          Set_First  (List, Empty);
 820          Set_Last   (List, Empty);
 821
 822          pragma Debug (New_List_Debug);
 823          return (List);
 824       end;
 825    end New_List;
 826
 827    --  Since the one argument case is common, we optimize to build the right
 828    --  list directly, rather than first building an empty list and then doing
 829    --  the insertion, which results in some unnecessary work.
 830
 831    function New_List (Node : Node_Or_Entity_Id) return List_Id is
 832
 833       procedure New_List_Debug;
 834       pragma Inline (New_List_Debug);
 835       --  Output debugging information if Debug_Flag_N is set
 836
 837       --------------------
 838       -- New_List_Debug --
 839       --------------------
 840
 841       procedure New_List_Debug is
 842       begin
 843          if Debug_Flag_N then
 844             Write_Str ("Allocate new list, returned ID = ");
 845             Write_Int (Int (Lists.Last));
 846             Write_Eol;
 847          end if;
 848       end New_List_Debug;
 849
 850    --  Start of processing for New_List
 851
 852    begin
 853       if Node = Error then
 854          return New_List;
 855
 856       else
 857          pragma Assert (not Is_List_Member (Node));
 858
 859          Lists.Increment_Last;
 860
 861          declare
 862             List : constant List_Id := Lists.Last;
 863
 864          begin
 865             Set_Parent (List, Empty);
 866             Set_First  (List, Node);
 867             Set_Last   (List, Node);
 868
 869             Nodes.Table (Node).In_List := True;
 870             Set_List_Link (Node, List);
 871             Set_Prev (Node, Empty);
 872             Set_Next (Node, Empty);
 873             pragma Debug (New_List_Debug);
 874             return List;
 875          end;
 876       end if;
 877    end New_List;
 878
 879    function New_List
 880      (Node1 : Node_Or_Entity_Id;
 881       Node2 : Node_Or_Entity_Id) return List_Id
 882    is
 883       L : constant List_Id := New_List (Node1);
 884    begin
 885       Append (Node2, L);
 886       return L;
 887    end New_List;
 888
 889    function New_List
 890      (Node1 : Node_Or_Entity_Id;
 891       Node2 : Node_Or_Entity_Id;
 892       Node3 : Node_Or_Entity_Id) return List_Id
 893    is
 894       L : constant List_Id := New_List (Node1);
 895    begin
 896       Append (Node2, L);
 897       Append (Node3, L);
 898       return L;
 899    end New_List;
 900
 901    function New_List
 902      (Node1 : Node_Or_Entity_Id;
 903       Node2 : Node_Or_Entity_Id;
 904       Node3 : Node_Or_Entity_Id;
 905       Node4 : Node_Or_Entity_Id) return List_Id
 906    is
 907       L : constant List_Id := New_List (Node1);
 908    begin
 909       Append (Node2, L);
 910       Append (Node3, L);
 911       Append (Node4, L);
 912       return L;
 913    end New_List;
 914
 915    function New_List
 916      (Node1 : Node_Or_Entity_Id;
 917       Node2 : Node_Or_Entity_Id;
 918       Node3 : Node_Or_Entity_Id;
 919       Node4 : Node_Or_Entity_Id;
 920       Node5 : Node_Or_Entity_Id) return List_Id
 921    is
 922       L : constant List_Id := New_List (Node1);
 923    begin
 924       Append (Node2, L);
 925       Append (Node3, L);
 926       Append (Node4, L);
 927       Append (Node5, L);
 928       return L;
 929    end New_List;
 930
 931    function New_List
 932      (Node1 : Node_Or_Entity_Id;
 933       Node2 : Node_Or_Entity_Id;
 934       Node3 : Node_Or_Entity_Id;
 935       Node4 : Node_Or_Entity_Id;
 936       Node5 : Node_Or_Entity_Id;
 937       Node6 : Node_Or_Entity_Id) return List_Id
 938    is
 939       L : constant List_Id := New_List (Node1);
 940    begin
 941       Append (Node2, L);
 942       Append (Node3, L);
 943       Append (Node4, L);
 944       Append (Node5, L);
 945       Append (Node6, L);
 946       return L;
 947    end New_List;
 948
 949    ----------
 950    -- Next --
 951    ----------
 952
 953    function Next (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
 954    begin
 955       pragma Assert (Is_List_Member (Node));
 956       return Next_Node.Table (Node);
 957    end Next;
 958
 959    procedure Next (Node : in out Node_Or_Entity_Id) is
 960    begin
 961       Node := Next (Node);
 962    end Next;
 963
 964    -----------------------
 965    -- Next_Node_Address --
 966    -----------------------
 967
 968    function Next_Node_Address return System.Address is
 969    begin
 970       return Next_Node.Table (First_Node_Id)'Address;
 971    end Next_Node_Address;
 972
 973    ---------------------
 974    -- Next_Non_Pragma --
 975    ---------------------
 976
 977    function Next_Non_Pragma
 978      (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
 979    is
 980       N : Node_Or_Entity_Id;
 981
 982    begin
 983       N := Node;
 984       loop
 985          Next (N);
 986          exit when Nkind (N) not in N_Pragma | N_Null_Statement;
 987       end loop;
 988
 989       return N;
 990    end Next_Non_Pragma;
 991
 992    procedure Next_Non_Pragma (Node : in out Node_Or_Entity_Id) is
 993    begin
 994       Node := Next_Non_Pragma (Node);
 995    end Next_Non_Pragma;
 996
 997    --------
 998    -- No --
 999    --------
1000
1001    function No (List : List_Id) return Boolean is
1002    begin
1003       return List = No_List;
1004    end No;
1005
1006    ---------------
1007    -- Num_Lists --
1008    ---------------
1009
1010    function Num_Lists return Nat is
1011    begin
1012       return Int (Lists.Last) - Int (Lists.First) + 1;
1013    end Num_Lists;
1014
1015    ------------
1016    -- Parent --
1017    ------------
1018
1019    function Parent (List : List_Id) return Node_Or_Entity_Id is
1020    begin
1021       pragma Assert (List <= Lists.Last);
1022       return Lists.Table (List).Parent;
1023    end Parent;
1024
1025    ----------
1026    -- Pick --
1027    ----------
1028
1029    function Pick (List : List_Id; Index : Pos) return Node_Or_Entity_Id is
1030       Elmt : Node_Or_Entity_Id;
1031
1032    begin
1033       Elmt := First (List);
1034       for J in 1 .. Index - 1 loop
1035          Next (Elmt);
1036       end loop;
1037
1038       return Elmt;
1039    end Pick;
1040
1041    -------------
1042    -- Prepend --
1043    -------------
1044
1045    procedure Prepend (Node : Node_Or_Entity_Id; To : List_Id) is
1046       F : constant Node_Or_Entity_Id := First (To);
1047
1048       procedure Prepend_Debug;
1049       pragma Inline (Prepend_Debug);
1050       --  Output debug information if Debug_Flag_N set
1051
1052       -------------------
1053       -- Prepend_Debug --
1054       -------------------
1055
1056       procedure Prepend_Debug is
1057       begin
1058          if Debug_Flag_N then
1059             Write_Str ("Prepend node ");
1060             Write_Int (Int (Node));
1061             Write_Str (" to list ");
1062             Write_Int (Int (To));
1063             Write_Eol;
1064          end if;
1065       end Prepend_Debug;
1066
1067    --  Start of processing for Prepend_Debug
1068
1069    begin
1070       pragma Assert (not Is_List_Member (Node));
1071
1072       if Node = Error then
1073          return;
1074       end if;
1075
1076       pragma Debug (Prepend_Debug);
1077
1078       if No (F) then
1079          Set_Last (To, Node);
1080       else
1081          Set_Prev (F, Node);
1082       end if;
1083
1084       Set_First (To, Node);
1085
1086       Nodes.Table (Node).In_List := True;
1087
1088       Set_Next      (Node, F);
1089       Set_Prev      (Node, Empty);
1090       Set_List_Link (Node, To);
1091    end Prepend;
1092
1093    ------------------
1094    -- Prepend_List --
1095    ------------------
1096
1097    procedure Prepend_List (List : List_Id; To : List_Id) is
1098
1099       procedure Prepend_List_Debug;
1100       pragma Inline (Prepend_List_Debug);
1101       --  Output debug information if Debug_Flag_N set
1102
1103       ------------------------
1104       -- Prepend_List_Debug --
1105       ------------------------
1106
1107       procedure Prepend_List_Debug is
1108       begin
1109          if Debug_Flag_N then
1110             Write_Str ("Prepend list ");
1111             Write_Int (Int (List));
1112             Write_Str (" to list ");
1113             Write_Int (Int (To));
1114             Write_Eol;
1115          end if;
1116       end Prepend_List_Debug;
1117
1118    --  Start of processing for Prepend_List
1119
1120    begin
1121       if Is_Empty_List (List) then
1122          return;
1123
1124       else
1125          declare
1126             F : constant Node_Or_Entity_Id := First (To);
1127             L : constant Node_Or_Entity_Id := Last (List);
1128             N : Node_Or_Entity_Id;
1129
1130          begin
1131             pragma Debug (Prepend_List_Debug);
1132
1133             N := L;
1134             loop
1135                Set_List_Link (N, To);
1136                N := Prev (N);
1137                exit when No (N);
1138             end loop;
1139
1140             if No (F) then
1141                Set_Last (To, L);
1142             else
1143                Set_Next (L, F);
1144             end if;
1145
1146             Set_Prev (F, L);
1147             Set_First (To, First (List));
1148
1149             Set_First (List, Empty);
1150             Set_Last  (List, Empty);
1151          end;
1152       end if;
1153    end Prepend_List;
1154
1155    ---------------------
1156    -- Prepend_List_To --
1157    ---------------------
1158
1159    procedure Prepend_List_To (To : List_Id; List : List_Id) is
1160    begin
1161       Prepend_List (List, To);
1162    end Prepend_List_To;
1163
1164    -----------------
1165    -- Prepend_New --
1166    -----------------
1167
1168    procedure Prepend_New (Node : Node_Or_Entity_Id; To : in out List_Id) is
1169    begin
1170       if No (To) then
1171          To := New_List;
1172       end if;
1173
1174       Prepend (Node, To);
1175    end Prepend_New;
1176
1177    --------------------
1178    -- Prepend_New_To --
1179    --------------------
1180
1181    procedure Prepend_New_To (To : in out List_Id; Node : Node_Or_Entity_Id) is
1182    begin
1183       Prepend_New (Node, To);
1184    end Prepend_New_To;
1185
1186    ----------------
1187    -- Prepend_To --
1188    ----------------
1189
1190    procedure Prepend_To (To : List_Id; Node : Node_Or_Entity_Id) is
1191    begin
1192       Prepend (Node, To);
1193    end Prepend_To;
1194
1195    -------------
1196    -- Present --
1197    -------------
1198
1199    function Present (List : List_Id) return Boolean is
1200    begin
1201       return List /= No_List;
1202    end Present;
1203
1204    ----------
1205    -- Prev --
1206    ----------
1207
1208    function Prev (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id is
1209    begin
1210       pragma Assert (Is_List_Member (Node));
1211       return Prev_Node.Table (Node);
1212    end Prev;
1213
1214    procedure Prev (Node : in out Node_Or_Entity_Id) is
1215    begin
1216       Node := Prev (Node);
1217    end Prev;
1218
1219    -----------------------
1220    -- Prev_Node_Address --
1221    -----------------------
1222
1223    function Prev_Node_Address return System.Address is
1224    begin
1225       return Prev_Node.Table (First_Node_Id)'Address;
1226    end Prev_Node_Address;
1227
1228    ---------------------
1229    -- Prev_Non_Pragma --
1230    ---------------------
1231
1232    function Prev_Non_Pragma
1233      (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
1234    is
1235       N : Node_Or_Entity_Id;
1236
1237    begin
1238       N := Node;
1239       loop
1240          N := Prev (N);
1241          exit when Nkind (N) /= N_Pragma;
1242       end loop;
1243
1244       return N;
1245    end Prev_Non_Pragma;
1246
1247    procedure Prev_Non_Pragma (Node : in out Node_Or_Entity_Id) is
1248    begin
1249       Node := Prev_Non_Pragma (Node);
1250    end Prev_Non_Pragma;
1251
1252    ------------
1253    -- Remove --
1254    ------------
1255
1256    procedure Remove (Node : Node_Or_Entity_Id) is
1257       Lst : constant List_Id           := List_Containing (Node);
1258       Prv : constant Node_Or_Entity_Id := Prev (Node);
1259       Nxt : constant Node_Or_Entity_Id := Next (Node);
1260
1261       procedure Remove_Debug;
1262       pragma Inline (Remove_Debug);
1263       --  Output debug information if Debug_Flag_N set
1264
1265       ------------------
1266       -- Remove_Debug --
1267       ------------------
1268
1269       procedure Remove_Debug is
1270       begin
1271          if Debug_Flag_N then
1272             Write_Str ("Remove node ");
1273             Write_Int (Int (Node));
1274             Write_Eol;
1275          end if;
1276       end Remove_Debug;
1277
1278    --  Start of processing for Remove
1279
1280    begin
1281       pragma Debug (Remove_Debug);
1282
1283       if No (Prv) then
1284          Set_First (Lst, Nxt);
1285       else
1286          Set_Next (Prv, Nxt);
1287       end if;
1288
1289       if No (Nxt) then
1290          Set_Last (Lst, Prv);
1291       else
1292          Set_Prev (Nxt, Prv);
1293       end if;
1294
1295       Nodes.Table (Node).In_List := False;
1296       Set_Parent (Node, Empty);
1297    end Remove;
1298
1299    -----------------
1300    -- Remove_Head --
1301    -----------------
1302
1303    function Remove_Head (List : List_Id) return Node_Or_Entity_Id is
1304       Frst : constant Node_Or_Entity_Id := First (List);
1305
1306       procedure Remove_Head_Debug;
1307       pragma Inline (Remove_Head_Debug);
1308       --  Output debug information if Debug_Flag_N set
1309
1310       -----------------------
1311       -- Remove_Head_Debug --
1312       -----------------------
1313
1314       procedure Remove_Head_Debug is
1315       begin
1316          if Debug_Flag_N then
1317             Write_Str ("Remove head of list ");
1318             Write_Int (Int (List));
1319             Write_Eol;
1320          end if;
1321       end Remove_Head_Debug;
1322
1323    --  Start of processing for Remove_Head
1324
1325    begin
1326       pragma Debug (Remove_Head_Debug);
1327
1328       if Frst = Empty then
1329          return Empty;
1330
1331       else
1332          declare
1333             Nxt : constant Node_Or_Entity_Id := Next (Frst);
1334
1335          begin
1336             Set_First (List, Nxt);
1337
1338             if No (Nxt) then
1339                Set_Last (List, Empty);
1340             else
1341                Set_Prev (Nxt, Empty);
1342             end if;
1343
1344             Nodes.Table (Frst).In_List := False;
1345             Set_Parent (Frst, Empty);
1346             return Frst;
1347          end;
1348       end if;
1349    end Remove_Head;
1350
1351    -----------------
1352    -- Remove_Next --
1353    -----------------
1354
1355    function Remove_Next
1356      (Node : Node_Or_Entity_Id) return Node_Or_Entity_Id
1357    is
1358       Nxt : constant Node_Or_Entity_Id := Next (Node);
1359
1360       procedure Remove_Next_Debug;
1361       pragma Inline (Remove_Next_Debug);
1362       --  Output debug information if Debug_Flag_N set
1363
1364       -----------------------
1365       -- Remove_Next_Debug --
1366       -----------------------
1367
1368       procedure Remove_Next_Debug is
1369       begin
1370          if Debug_Flag_N then
1371             Write_Str ("Remove next node after ");
1372             Write_Int (Int (Node));
1373             Write_Eol;
1374          end if;
1375       end Remove_Next_Debug;
1376
1377    --  Start of processing for Remove_Next
1378
1379    begin
1380       if Present (Nxt) then
1381          declare
1382             Nxt2 : constant Node_Or_Entity_Id := Next (Nxt);
1383             LC   : constant List_Id           := List_Containing (Node);
1384
1385          begin
1386             pragma Debug (Remove_Next_Debug);
1387             Set_Next (Node, Nxt2);
1388
1389             if No (Nxt2) then
1390                Set_Last (LC, Node);
1391             else
1392                Set_Prev (Nxt2, Node);
1393             end if;
1394
1395             Nodes.Table (Nxt).In_List := False;
1396             Set_Parent (Nxt, Empty);
1397          end;
1398       end if;
1399
1400       return Nxt;
1401    end Remove_Next;
1402
1403    ---------------
1404    -- Set_First --
1405    ---------------
1406
1407    procedure Set_First (List : List_Id; To : Node_Or_Entity_Id) is
1408    begin
1409       pragma Assert (not Locked);
1410       Lists.Table (List).First := To;
1411    end Set_First;
1412
1413    --------------
1414    -- Set_Last --
1415    --------------
1416
1417    procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id) is
1418    begin
1419       pragma Assert (not Locked);
1420       Lists.Table (List).Last := To;
1421    end Set_Last;
1422
1423    -------------------
1424    -- Set_List_Link --
1425    -------------------
1426
1427    procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is
1428    begin
1429       pragma Assert (not Locked);
1430       Nodes.Table (Node).Link := Union_Id (To);
1431    end Set_List_Link;
1432
1433    --------------
1434    -- Set_Next --
1435    --------------
1436
1437    procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
1438    begin
1439       pragma Assert (not Locked);
1440       Next_Node.Table (Node) := To;
1441    end Set_Next;
1442
1443    ----------------
1444    -- Set_Parent --
1445    ----------------
1446
1447    procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id) is
1448    begin
1449       pragma Assert (not Locked);
1450       pragma Assert (List <= Lists.Last);
1451       Lists.Table (List).Parent := Node;
1452    end Set_Parent;
1453
1454    --------------
1455    -- Set_Prev --
1456    --------------
1457
1458    procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
1459    begin
1460       pragma Assert (not Locked);
1461       Prev_Node.Table (Node) := To;
1462    end Set_Prev;
1463
1464    ------------
1465    -- Unlock --
1466    ------------
1467
1468    procedure Unlock is
1469    begin
1470       Lists.Locked := False;
1471       Prev_Node.Locked := False;
1472       Next_Node.Locked := False;
1473    end Unlock;
1474
1475    ------------------
1476    -- Unlock_Lists --
1477    ------------------
1478
1479    procedure Unlock_Lists is
1480    begin
1481       pragma Assert (Locked);
1482       Locked := False;
1483    end Unlock_Lists;
1484
1485 end Nlists;