gcc/ada/inline.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               I N L I N E                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Einfo;    use Einfo;
  29 with Elists;   use Elists;
  30 with Errout;   use Errout;
  31 with Exp_Ch7;  use Exp_Ch7;
  32 with Exp_Tss;  use Exp_Tss;
  33 with Fname;    use Fname;
  34 with Fname.UF; use Fname.UF;
  35 with Lib;      use Lib;
  36 with Namet;    use Namet;
  37 with Nlists;   use Nlists;
  38 with Opt;      use Opt;
  39 with Sem_Ch8;  use Sem_Ch8;
  40 with Sem_Ch10; use Sem_Ch10;
  41 with Sem_Ch12; use Sem_Ch12;
  42 with Sem_Util; use Sem_Util;
  43 with Sinfo;    use Sinfo;
  44 with Snames;   use Snames;
  45 with Stand;    use Stand;
  46 with Uname;    use Uname;
  47
  48 package body Inline is
  49
  50    --------------------
  51    -- Inlined Bodies --
  52    --------------------
  53
  54    --  Inlined functions are actually placed in line by the backend if the
  55    --  corresponding bodies are available (i.e. compiled). Whenever we find
  56    --  a call to an inlined subprogram, we add the name of the enclosing
  57    --  compilation unit to a worklist. After all compilation, and after
  58    --  expansion of generic bodies, we traverse the list of pending bodies
  59    --  and compile them as well.
  60
  61    package Inlined_Bodies is new Table.Table (
  62      Table_Component_Type => Entity_Id,
  63      Table_Index_Type     => Int,
  64      Table_Low_Bound      => 0,
  65      Table_Initial        => Alloc.Inlined_Bodies_Initial,
  66      Table_Increment      => Alloc.Inlined_Bodies_Increment,
  67      Table_Name           => "Inlined_Bodies");
  68
  69    -----------------------
  70    -- Inline Processing --
  71    -----------------------
  72
  73    --  For each call to an inlined subprogram, we make entries in a table
  74    --  that stores caller and callee, and indicates a prerequisite from
  75    --  one to the other. We also record the compilation unit that contains
  76    --  the callee. After analyzing the bodies of all such compilation units,
  77    --  we produce a list of subprograms in  topological order, for use by the
  78    --  back-end. If P2 is a prerequisite of P1, then P1 calls P2, and for
  79    --  proper inlining the back-end must analyze the body of P2 before that of
  80    --  P1. The code below guarantees that the transitive closure of inlined
  81    --  subprograms called from the main compilation unit is made available to
  82    --  the code generator.
  83
  84    Last_Inlined : Entity_Id := Empty;
  85
  86    --  For each entry in the table we keep a list of successors in topological
  87    --  order, i.e. callers of the current subprogram.
  88
  89    type Subp_Index is new Nat;
  90    No_Subp : constant Subp_Index := 0;
  91
  92    --  The subprogram entities are hashed into the Inlined table
  93
  94    Num_Hash_Headers : constant := 512;
  95
  96    Hash_Headers : array (Subp_Index range 0 .. Num_Hash_Headers - 1)
  97                                                           of Subp_Index;
  98
  99    type Succ_Index is new Nat;
 100    No_Succ : constant Succ_Index := 0;
 101
 102    type Succ_Info is record
 103       Subp : Subp_Index;
 104       Next : Succ_Index;
 105    end record;
 106
 107    --  The following table stores list elements for the successor lists.
 108    --  These lists cannot be chained directly through entries in the Inlined
 109    --  table, because a given subprogram can appear in several such lists.
 110
 111    package Successors is new Table.Table (
 112       Table_Component_Type => Succ_Info,
 113       Table_Index_Type     => Succ_Index,
 114       Table_Low_Bound      => 1,
 115       Table_Initial        => Alloc.Successors_Initial,
 116       Table_Increment      => Alloc.Successors_Increment,
 117       Table_Name           => "Successors");
 118
 119    type Subp_Info is record
 120       Name        : Entity_Id  := Empty;
 121       First_Succ  : Succ_Index := No_Succ;
 122       Count       : Integer    := 0;
 123       Listed      : Boolean    := False;
 124       Main_Call   : Boolean    := False;
 125       Next        : Subp_Index := No_Subp;
 126       Next_Nopred : Subp_Index := No_Subp;
 127    end record;
 128
 129    package Inlined is new Table.Table (
 130       Table_Component_Type => Subp_Info,
 131       Table_Index_Type     => Subp_Index,
 132       Table_Low_Bound      => 1,
 133       Table_Initial        => Alloc.Inlined_Initial,
 134       Table_Increment      => Alloc.Inlined_Increment,
 135       Table_Name           => "Inlined");
 136
 137    -----------------------
 138    -- Local Subprograms --
 139    -----------------------
 140
 141    function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean;
 142    --  Return True if Scop is in the main unit or its spec, or in a
 143    --  parent of the main unit if it is a child unit.
 144
 145    procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);
 146    --  Make two entries in Inlined table, for an inlined subprogram being
 147    --  called, and for the inlined subprogram that contains the call. If
 148    --  the call is in the main compilation unit, Caller is Empty.
 149
 150    function Add_Subp (E : Entity_Id) return Subp_Index;
 151    --  Make entry in Inlined table for subprogram E, or return table index
 152    --  that already holds E.
 153
 154    function Has_Initialized_Type (E : Entity_Id) return Boolean;
 155    --  If a candidate for inlining contains type declarations for types with
 156    --  non-trivial initialization procedures, they are not worth inlining.
 157
 158    function Is_Nested (E : Entity_Id) return Boolean;
 159    --  If the function is nested inside some other function, it will
 160    --  always be compiled if that function is, so don't add it to the
 161    --  inline list. We cannot compile a nested function outside the
 162    --  scope of the containing function anyway. This is also the case if
 163    --  the function is defined in a task body or within an entry (for
 164    --  example, an initialization procedure).
 165
 166    procedure Add_Inlined_Subprogram (Index : Subp_Index);
 167    --  Add subprogram to Inlined List once all of its predecessors have been
 168    --  placed on the list. Decrement the count of all its successors, and
 169    --  add them to list (recursively) if count drops to zero.
 170
 171    ------------------------------
 172    -- Deferred Cleanup Actions --
 173    ------------------------------
 174
 175    --  The cleanup actions for scopes that contain instantiations is delayed
 176    --  until after expansion of those instantiations, because they may
 177    --  contain finalizable objects or tasks that affect the cleanup code.
 178    --  A scope that contains instantiations only needs to be finalized once,
 179    --  even if it contains more than one instance. We keep a list of scopes
 180    --  that must still be finalized, and call cleanup_actions after all the
 181    --  instantiations have been completed.
 182
 183    To_Clean : Elist_Id;
 184
 185    procedure Add_Scope_To_Clean (Inst : Entity_Id);
 186    --  Build set of scopes on which cleanup actions must be performed
 187
 188    procedure Cleanup_Scopes;
 189    --  Complete cleanup actions on scopes that need it
 190
 191    --------------
 192    -- Add_Call --
 193    --------------
 194
 195    procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty) is
 196       P1 : constant Subp_Index := Add_Subp (Called);
 197       P2 : Subp_Index;
 198       J  : Succ_Index;
 199
 200    begin
 201       if Present (Caller) then
 202          P2 := Add_Subp (Caller);
 203
 204          --  Add P2 to the list of successors of P1, if not already there.
 205          --  Note that P2 may contain more than one call to P1, and only
 206          --  one needs to be recorded.
 207
 208          J := Inlined.Table (P1).First_Succ;
 209
 210          while J /= No_Succ loop
 211
 212             if Successors.Table (J).Subp = P2 then
 213                return;
 214             end if;
 215
 216             J := Successors.Table (J).Next;
 217          end loop;
 218
 219          --  On exit, make a successor entry for P2
 220
 221          Successors.Increment_Last;
 222          Successors.Table (Successors.Last).Subp := P2;
 223          Successors.Table (Successors.Last).Next :=
 224                              Inlined.Table (P1).First_Succ;
 225          Inlined.Table (P1).First_Succ := Successors.Last;
 226
 227          Inlined.Table (P2).Count := Inlined.Table (P2).Count + 1;
 228
 229       else
 230          Inlined.Table (P1).Main_Call := True;
 231       end if;
 232    end Add_Call;
 233
 234    ----------------------
 235    -- Add_Inlined_Body --
 236    ----------------------
 237
 238    procedure Add_Inlined_Body (E : Entity_Id) is
 239       Pack : Entity_Id;
 240
 241       function Must_Inline return Boolean;
 242       --  Inlining is only done if the call statement N is in the main unit,
 243       --  or within the body of another inlined subprogram.
 244
 245       -----------------
 246       -- Must_Inline --
 247       -----------------
 248
 249       function Must_Inline return Boolean is
 250          Scop : Entity_Id;
 251          Comp : Node_Id;
 252
 253       begin
 254          --  Check if call is in main unit
 255
 256          Scop := Current_Scope;
 257
 258          --  Do not try to inline if scope is standard. This could happen, for
 259          --  example, for a call to Add_Global_Declaration, and it causes
 260          --  trouble to try to inline at this level.
 261
 262          if Scop = Standard_Standard then
 263             return False;
 264          end if;
 265
 266          --  Otherwise lookup scope stack to outer scope
 267
 268          while Scope (Scop) /= Standard_Standard
 269            and then not Is_Child_Unit (Scop)
 270          loop
 271             Scop := Scope (Scop);
 272          end loop;
 273
 274          Comp := Parent (Scop);
 275          while Nkind (Comp) /= N_Compilation_Unit loop
 276             Comp := Parent (Comp);
 277          end loop;
 278
 279          if Comp = Cunit (Main_Unit)
 280            or else Comp = Library_Unit (Cunit (Main_Unit))
 281          then
 282             Add_Call (E);
 283             return True;
 284          end if;
 285
 286          --  Call is not in main unit. See if it's in some inlined subprogram
 287
 288          Scop := Current_Scope;
 289          while Scope (Scop) /= Standard_Standard
 290            and then not Is_Child_Unit (Scop)
 291          loop
 292             if Is_Overloadable (Scop)
 293               and then Is_Inlined (Scop)
 294             then
 295                Add_Call (E, Scop);
 296                return True;
 297             end if;
 298
 299             Scop := Scope (Scop);
 300          end loop;
 301
 302          return False;
 303       end Must_Inline;
 304
 305    --  Start of processing for Add_Inlined_Body
 306
 307    begin
 308       --  Find unit containing E, and add to list of inlined bodies if needed.
 309       --  If the body is already present, no need to load any other unit. This
 310       --  is the case for an initialization procedure, which appears in the
 311       --  package declaration that contains the type. It is also the case if
 312       --  the body has already been analyzed. Finally, if the unit enclosing
 313       --  E is an instance, the instance body will be analyzed in any case,
 314       --  and there is no need to add the enclosing unit (whose body might not
 315       --  be available).
 316
 317       --  Library-level functions must be handled specially, because there is
 318       --  no enclosing package to retrieve. In this case, it is the body of
 319       --  the function that will have to be loaded.
 320
 321       if not Is_Abstract_Subprogram (E) and then not Is_Nested (E)
 322         and then Convention (E) /= Convention_Protected
 323       then
 324          Pack := Scope (E);
 325
 326          if Must_Inline
 327            and then Ekind (Pack) = E_Package
 328          then
 329             Set_Is_Called (E);
 330
 331             if Pack = Standard_Standard then
 332
 333                --  Library-level inlined function. Add function iself to
 334                --  list of needed units.
 335
 336                Inlined_Bodies.Increment_Last;
 337                Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
 338
 339             elsif Is_Generic_Instance (Pack) then
 340                null;
 341
 342             elsif not Is_Inlined (Pack)
 343               and then not Has_Completion (E)
 344               and then not Scope_In_Main_Unit (Pack)
 345             then
 346                Set_Is_Inlined (Pack);
 347                Inlined_Bodies.Increment_Last;
 348                Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
 349             end if;
 350          end if;
 351       end if;
 352    end Add_Inlined_Body;
 353
 354    ----------------------------
 355    -- Add_Inlined_Subprogram --
 356    ----------------------------
 357
 358    procedure Add_Inlined_Subprogram (Index : Subp_Index) is
 359       E    : constant Entity_Id := Inlined.Table (Index).Name;
 360       Succ : Succ_Index;
 361       Subp : Subp_Index;
 362
 363       function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean;
 364       --  There are various conditions under which back-end inlining cannot
 365       --  be done reliably:
 366       --
 367       --    a) If a body has handlers, it must not be inlined, because this
 368       --    may violate program semantics, and because in zero-cost exception
 369       --    mode it will lead to undefined symbols at link time.
 370       --
 371       --    b) If a body contains inlined function instances, it cannot be
 372       --    inlined under ZCX because the numerix suffix generated by gigi
 373       --    will be different in the body and the place of the inlined call.
 374       --
 375       --  This procedure must be carefully coordinated with the back end
 376
 377       ----------------------------
 378       -- Back_End_Cannot_Inline --
 379       ----------------------------
 380
 381       function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is
 382          Decl     : constant Node_Id := Unit_Declaration_Node (Subp);
 383          Body_Ent : Entity_Id;
 384          Ent      : Entity_Id;
 385
 386       begin
 387          if Nkind (Decl) = N_Subprogram_Declaration
 388            and then Present (Corresponding_Body (Decl))
 389          then
 390             Body_Ent := Corresponding_Body (Decl);
 391          else
 392             return False;
 393          end if;
 394
 395          --  If subprogram is marked Inline_Always, inlining is mandatory
 396
 397          if Is_Always_Inlined (Subp) then
 398             return False;
 399          end if;
 400
 401          if Present
 402           (Exception_Handlers
 403             (Handled_Statement_Sequence
 404                  (Unit_Declaration_Node (Corresponding_Body (Decl)))))
 405          then
 406             return True;
 407          end if;
 408
 409          Ent := First_Entity (Body_Ent);
 410
 411          while Present (Ent) loop
 412             if Is_Subprogram (Ent)
 413               and then Is_Generic_Instance (Ent)
 414             then
 415                return True;
 416             end if;
 417
 418             Next_Entity (Ent);
 419          end loop;
 420          return False;
 421       end Back_End_Cannot_Inline;
 422
 423    --  Start of processing for Add_Inlined_Subprogram
 424
 425    begin
 426       --  Insert the current subprogram in the list of inlined subprograms,
 427       --  if it can actually be inlined by the back-end.
 428
 429       if not Scope_In_Main_Unit (E)
 430         and then Is_Inlined (E)
 431         and then not Is_Nested (E)
 432         and then not Has_Initialized_Type (E)
 433       then
 434          if Back_End_Cannot_Inline (E) then
 435             Set_Is_Inlined (E, False);
 436
 437          else
 438             if No (Last_Inlined) then
 439                Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
 440             else
 441                Set_Next_Inlined_Subprogram (Last_Inlined, E);
 442             end if;
 443
 444             Last_Inlined := E;
 445          end if;
 446       end if;
 447
 448       Inlined.Table (Index).Listed := True;
 449       Succ := Inlined.Table (Index).First_Succ;
 450
 451       while Succ /= No_Succ loop
 452          Subp := Successors.Table (Succ).Subp;
 453          Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
 454
 455          if Inlined.Table (Subp).Count = 0 then
 456             Add_Inlined_Subprogram (Subp);
 457          end if;
 458
 459          Succ := Successors.Table (Succ).Next;
 460       end loop;
 461    end Add_Inlined_Subprogram;
 462
 463    ------------------------
 464    -- Add_Scope_To_Clean --
 465    ------------------------
 466
 467    procedure Add_Scope_To_Clean (Inst : Entity_Id) is
 468       Scop : constant Entity_Id := Enclosing_Dynamic_Scope (Inst);
 469       Elmt : Elmt_Id;
 470
 471    begin
 472       --  If the instance appears in a library-level package declaration,
 473       --  all finalization is global, and nothing needs doing here.
 474
 475       if Scop = Standard_Standard then
 476          return;
 477       end if;
 478
 479       --  If the instance appears within a generic subprogram there is nothing
 480       --  to finalize either.
 481
 482       declare
 483          S : Entity_Id;
 484       begin
 485          S := Scope (Inst);
 486          while Present (S) and then S /= Standard_Standard loop
 487             if Is_Generic_Subprogram (S) then
 488                return;
 489             end if;
 490
 491             S := Scope (S);
 492          end loop;
 493       end;
 494
 495       Elmt := First_Elmt (To_Clean);
 496
 497       while Present (Elmt) loop
 498
 499          if Node (Elmt) = Scop then
 500             return;
 501          end if;
 502
 503          Elmt := Next_Elmt (Elmt);
 504       end loop;
 505
 506       Append_Elmt (Scop, To_Clean);
 507    end Add_Scope_To_Clean;
 508
 509    --------------
 510    -- Add_Subp --
 511    --------------
 512
 513    function Add_Subp (E : Entity_Id) return Subp_Index is
 514       Index : Subp_Index := Subp_Index (E) mod Num_Hash_Headers;
 515       J     : Subp_Index;
 516
 517       procedure New_Entry;
 518       --  Initialize entry in Inlined table
 519
 520       procedure New_Entry is
 521       begin
 522          Inlined.Increment_Last;
 523          Inlined.Table (Inlined.Last).Name        := E;
 524          Inlined.Table (Inlined.Last).First_Succ  := No_Succ;
 525          Inlined.Table (Inlined.Last).Count       := 0;
 526          Inlined.Table (Inlined.Last).Listed      := False;
 527          Inlined.Table (Inlined.Last).Main_Call   := False;
 528          Inlined.Table (Inlined.Last).Next        := No_Subp;
 529          Inlined.Table (Inlined.Last).Next_Nopred := No_Subp;
 530       end New_Entry;
 531
 532    --  Start of processing for Add_Subp
 533
 534    begin
 535       if Hash_Headers (Index) = No_Subp then
 536          New_Entry;
 537          Hash_Headers (Index) := Inlined.Last;
 538          return Inlined.Last;
 539
 540       else
 541          J := Hash_Headers (Index);
 542
 543          while J /= No_Subp loop
 544
 545             if Inlined.Table (J).Name = E then
 546                return J;
 547             else
 548                Index := J;
 549                J := Inlined.Table (J).Next;
 550             end if;
 551          end loop;
 552
 553          --  On exit, subprogram was not found. Enter in table. Index is
 554          --  the current last entry on the hash chain.
 555
 556          New_Entry;
 557          Inlined.Table (Index).Next := Inlined.Last;
 558          return Inlined.Last;
 559       end if;
 560    end Add_Subp;
 561
 562    ----------------------------
 563    -- Analyze_Inlined_Bodies --
 564    ----------------------------
 565
 566    procedure Analyze_Inlined_Bodies is
 567       Comp_Unit : Node_Id;
 568       J         : Int;
 569       Pack      : Entity_Id;
 570       S         : Succ_Index;
 571
 572    begin
 573       Analyzing_Inlined_Bodies := False;
 574
 575       if Serious_Errors_Detected = 0 then
 576          Push_Scope (Standard_Standard);
 577
 578          J := 0;
 579          while J <= Inlined_Bodies.Last
 580            and then Serious_Errors_Detected = 0
 581          loop
 582             Pack := Inlined_Bodies.Table (J);
 583
 584             while Present (Pack)
 585               and then Scope (Pack) /= Standard_Standard
 586               and then not Is_Child_Unit (Pack)
 587             loop
 588                Pack := Scope (Pack);
 589             end loop;
 590
 591             Comp_Unit := Parent (Pack);
 592             while Present (Comp_Unit)
 593               and then Nkind (Comp_Unit) /= N_Compilation_Unit
 594             loop
 595                Comp_Unit := Parent (Comp_Unit);
 596             end loop;
 597
 598             --  Load the body, unless it the main unit, or is an instance
 599             --  whose body has already been analyzed.
 600
 601             if Present (Comp_Unit)
 602               and then Comp_Unit /= Cunit (Main_Unit)
 603               and then Body_Required (Comp_Unit)
 604               and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration
 605                          or else No (Corresponding_Body (Unit (Comp_Unit))))
 606             then
 607                declare
 608                   Bname : constant Unit_Name_Type :=
 609                             Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit)));
 610
 611                   OK : Boolean;
 612
 613                begin
 614                   if not Is_Loaded (Bname) then
 615                      Load_Needed_Body (Comp_Unit, OK);
 616
 617                      if not OK then
 618                         Error_Msg_Unit_1 := Bname;
 619                         Error_Msg_N
 620                           ("one or more inlined subprograms accessed in $!",
 621                            Comp_Unit);
 622                         Error_Msg_File_1 :=
 623                           Get_File_Name (Bname, Subunit => False);
 624                         Error_Msg_N ("\but file{ was not found!", Comp_Unit);
 625                         raise Unrecoverable_Error;
 626                      end if;
 627                   end if;
 628                end;
 629             end if;
 630
 631             J := J + 1;
 632          end loop;
 633
 634          --  The analysis of required bodies may have produced additional
 635          --  generic instantiations. To obtain further inlining, we perform
 636          --  another round of generic body instantiations. Establishing a
 637          --  fully recursive loop between inlining and generic instantiations
 638          --  is unlikely to yield more than this one additional pass.
 639
 640          Instantiate_Bodies;
 641
 642          --  The list of inlined subprograms is an overestimate, because
 643          --  it includes inlined functions called from functions that are
 644          --  compiled as part of an inlined package, but are not themselves
 645          --  called. An accurate computation of just those subprograms that
 646          --  are needed requires that we perform a transitive closure over
 647          --  the call graph, starting from calls in the main program. Here
 648          --  we do one step of the inverse transitive closure, and reset
 649          --  the Is_Called flag on subprograms all of whose callers are not.
 650
 651          for Index in Inlined.First .. Inlined.Last loop
 652             S := Inlined.Table (Index).First_Succ;
 653
 654             if S /= No_Succ
 655               and then not Inlined.Table (Index).Main_Call
 656             then
 657                Set_Is_Called (Inlined.Table (Index).Name, False);
 658
 659                while S /= No_Succ loop
 660
 661                   if Is_Called
 662                     (Inlined.Table (Successors.Table (S).Subp).Name)
 663                    or else Inlined.Table (Successors.Table (S).Subp).Main_Call
 664                   then
 665                      Set_Is_Called (Inlined.Table (Index).Name);
 666                      exit;
 667                   end if;
 668
 669                   S := Successors.Table (S).Next;
 670                end loop;
 671             end if;
 672          end loop;
 673
 674          --  Now that the units are compiled, chain the subprograms within
 675          --  that are called and inlined. Produce list of inlined subprograms
 676          --  sorted in  topological order. Start with all subprograms that
 677          --  have no prerequisites, i.e. inlined subprograms that do not call
 678          --  other inlined subprograms.
 679
 680          for Index in Inlined.First .. Inlined.Last loop
 681
 682             if Is_Called (Inlined.Table (Index).Name)
 683               and then Inlined.Table (Index).Count = 0
 684               and then not Inlined.Table (Index).Listed
 685             then
 686                Add_Inlined_Subprogram (Index);
 687             end if;
 688          end loop;
 689
 690          --  Because Add_Inlined_Subprogram treats recursively nodes that have
 691          --  no prerequisites left, at the end of the loop all subprograms
 692          --  must have been listed. If there are any unlisted subprograms
 693          --  left, there must be some recursive chains that cannot be inlined.
 694
 695          for Index in Inlined.First .. Inlined.Last loop
 696             if Is_Called (Inlined.Table (Index).Name)
 697               and then Inlined.Table (Index).Count /= 0
 698               and then not Is_Predefined_File_Name
 699                 (Unit_File_Name
 700                   (Get_Source_Unit (Inlined.Table (Index).Name)))
 701             then
 702                Error_Msg_N
 703                  ("& cannot be inlined?", Inlined.Table (Index).Name);
 704
 705                --  A warning on the first one might be sufficient ???
 706             end if;
 707          end loop;
 708
 709          Pop_Scope;
 710       end if;
 711    end Analyze_Inlined_Bodies;
 712
 713    -----------------------------
 714    -- Check_Body_For_Inlining --
 715    -----------------------------
 716
 717    procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
 718       Bname : Unit_Name_Type;
 719       E     : Entity_Id;
 720       OK    : Boolean;
 721
 722    begin
 723       if Is_Compilation_Unit (P)
 724         and then not Is_Generic_Instance (P)
 725       then
 726          Bname := Get_Body_Name (Get_Unit_Name (Unit (N)));
 727          E := First_Entity (P);
 728
 729          while Present (E) loop
 730             if Is_Always_Inlined (E)
 731               or else (Front_End_Inlining and then Has_Pragma_Inline (E))
 732             then
 733                if not Is_Loaded (Bname) then
 734                   Load_Needed_Body (N, OK);
 735
 736                   if OK then
 737
 738                      --  Check that we are not trying to inline a parent
 739                      --  whose body depends on a child, when we are compiling
 740                      --  the body of the child. Otherwise we have a potential
 741                      --  elaboration circularity with inlined subprograms and
 742                      --  with Taft-Amendment types.
 743
 744                      declare
 745                         Comp        : Node_Id;      --  Body just compiled
 746                         Child_Spec  : Entity_Id;    --  Spec of main unit
 747                         Ent         : Entity_Id;    --  For iteration
 748                         With_Clause : Node_Id;      --  Context of body.
 749
 750                      begin
 751                         if Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body
 752                           and then Present (Body_Entity (P))
 753                         then
 754                            Child_Spec :=
 755                              Defining_Entity (
 756                                (Unit (Library_Unit (Cunit (Main_Unit)))));
 757
 758                            Comp :=
 759                              Parent (Unit_Declaration_Node (Body_Entity (P)));
 760
 761                            With_Clause := First (Context_Items (Comp));
 762
 763                            --  Check whether the context of the body just
 764                            --  compiled includes a child of itself, and that
 765                            --  child is the spec of the main compilation.
 766
 767                            while Present (With_Clause) loop
 768                               if Nkind (With_Clause) = N_With_Clause
 769                                 and then
 770                                   Scope (Entity (Name (With_Clause))) = P
 771                                 and then
 772                                   Entity (Name (With_Clause)) = Child_Spec
 773                               then
 774                                  Error_Msg_Node_2 := Child_Spec;
 775                                  Error_Msg_NE
 776                                    ("body of & depends on child unit&?",
 777                                       With_Clause, P);
 778                                  Error_Msg_N
 779                                    ("\subprograms in body cannot be inlined?",
 780                                       With_Clause);
 781
 782                                  --  Disable further inlining from this unit,
 783                                  --  and keep Taft-amendment types incomplete.
 784
 785                                  Ent := First_Entity (P);
 786
 787                                  while Present (Ent) loop
 788                                     if Is_Type (Ent)
 789                                        and then Has_Completion_In_Body (Ent)
 790                                     then
 791                                        Set_Full_View (Ent, Empty);
 792
 793                                     elsif Is_Subprogram (Ent) then
 794                                        Set_Is_Inlined (Ent, False);
 795                                     end if;
 796
 797                                     Next_Entity (Ent);
 798                                  end loop;
 799
 800                                  return;
 801                               end if;
 802
 803                               Next (With_Clause);
 804                            end loop;
 805                         end if;
 806                      end;
 807
 808                   elsif Ineffective_Inline_Warnings then
 809                      Error_Msg_Unit_1 := Bname;
 810                      Error_Msg_N
 811                        ("unable to inline subprograms defined in $?", P);
 812                      Error_Msg_N ("\body not found?", P);
 813                      return;
 814                   end if;
 815                end if;
 816
 817                return;
 818             end if;
 819
 820             Next_Entity (E);
 821          end loop;
 822       end if;
 823    end Check_Body_For_Inlining;
 824
 825    --------------------
 826    -- Cleanup_Scopes --
 827    --------------------
 828
 829    procedure Cleanup_Scopes is
 830       Elmt : Elmt_Id;
 831       Decl : Node_Id;
 832       Scop : Entity_Id;
 833
 834    begin
 835       Elmt := First_Elmt (To_Clean);
 836
 837       while Present (Elmt) loop
 838          Scop := Node (Elmt);
 839
 840          if Ekind (Scop) = E_Entry then
 841             Scop := Protected_Body_Subprogram (Scop);
 842
 843          elsif Is_Subprogram (Scop)
 844            and then Is_Protected_Type (Scope (Scop))
 845            and then Present (Protected_Body_Subprogram (Scop))
 846          then
 847             --  If a protected operation contains an instance, its
 848             --  cleanup operations have been delayed, and the subprogram
 849             --  has been rewritten in the expansion of the enclosing
 850             --  protected body. It is the corresponding subprogram that
 851             --  may require the cleanup operations.
 852
 853             Set_Uses_Sec_Stack
 854               (Protected_Body_Subprogram (Scop),
 855                 Uses_Sec_Stack (Scop));
 856             Scop := Protected_Body_Subprogram (Scop);
 857          end if;
 858
 859          if Ekind (Scop) = E_Block then
 860             Decl := Parent (Block_Node (Scop));
 861
 862          else
 863             Decl := Unit_Declaration_Node (Scop);
 864
 865             if Nkind (Decl) = N_Subprogram_Declaration
 866               or else Nkind (Decl) = N_Task_Type_Declaration
 867               or else Nkind (Decl) = N_Subprogram_Body_Stub
 868             then
 869                Decl := Unit_Declaration_Node (Corresponding_Body (Decl));
 870             end if;
 871          end if;
 872
 873          Push_Scope (Scop);
 874          Expand_Cleanup_Actions (Decl);
 875          End_Scope;
 876
 877          Elmt := Next_Elmt (Elmt);
 878       end loop;
 879    end Cleanup_Scopes;
 880
 881    --------------------------
 882    -- Has_Initialized_Type --
 883    --------------------------
 884
 885    function Has_Initialized_Type (E : Entity_Id) return Boolean is
 886       E_Body : constant Node_Id := Get_Subprogram_Body (E);
 887       Decl   : Node_Id;
 888
 889    begin
 890       if No (E_Body) then        --  imported subprogram
 891          return False;
 892
 893       else
 894          Decl := First (Declarations (E_Body));
 895
 896          while Present (Decl) loop
 897
 898             if Nkind (Decl) = N_Full_Type_Declaration
 899               and then Present (Init_Proc (Defining_Identifier (Decl)))
 900             then
 901                return True;
 902             end if;
 903
 904             Next (Decl);
 905          end loop;
 906       end if;
 907
 908       return False;
 909    end Has_Initialized_Type;
 910
 911    ----------------
 912    -- Initialize --
 913    ----------------
 914
 915    procedure Initialize is
 916    begin
 917       Analyzing_Inlined_Bodies := False;
 918       Pending_Descriptor.Init;
 919       Pending_Instantiations.Init;
 920       Inlined_Bodies.Init;
 921       Successors.Init;
 922       Inlined.Init;
 923
 924       for J in Hash_Headers'Range loop
 925          Hash_Headers (J) := No_Subp;
 926       end loop;
 927    end Initialize;
 928
 929    ------------------------
 930    -- Instantiate_Bodies --
 931    ------------------------
 932
 933    --  Generic bodies contain all the non-local references, so an
 934    --  instantiation does not need any more context than Standard
 935    --  itself, even if the instantiation appears in an inner scope.
 936    --  Generic associations have verified that the contract model is
 937    --  satisfied, so that any error that may occur in the analysis of
 938    --  the body is an internal error.
 939
 940    procedure Instantiate_Bodies is
 941       J    : Int;
 942       Info : Pending_Body_Info;
 943
 944    begin
 945       if Serious_Errors_Detected = 0 then
 946
 947          Expander_Active := (Operating_Mode = Opt.Generate_Code);
 948          Push_Scope (Standard_Standard);
 949          To_Clean := New_Elmt_List;
 950
 951          if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
 952             Start_Generic;
 953          end if;
 954
 955          --  A body instantiation may generate additional instantiations, so
 956          --  the following loop must scan to the end of a possibly expanding
 957          --  set (that's why we can't simply use a FOR loop here).
 958
 959          J := 0;
 960          while J <= Pending_Instantiations.Last
 961            and then Serious_Errors_Detected = 0
 962          loop
 963             Info := Pending_Instantiations.Table (J);
 964
 965             --  If the instantiation node is absent, it has been removed
 966             --  as part of unreachable code.
 967
 968             if No (Info.Inst_Node) then
 969                null;
 970
 971             elsif Nkind (Info.Act_Decl) = N_Package_Declaration then
 972                Instantiate_Package_Body (Info);
 973                Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
 974
 975             else
 976                Instantiate_Subprogram_Body (Info);
 977             end if;
 978
 979             J := J + 1;
 980          end loop;
 981
 982          --  Reset the table of instantiations. Additional instantiations
 983          --  may be added through inlining, when additional bodies are
 984          --  analyzed.
 985
 986          Pending_Instantiations.Init;
 987
 988          --  We can now complete the cleanup actions of scopes that contain
 989          --  pending instantiations (skipped for generic units, since we
 990          --  never need any cleanups in generic units).
 991          --  pending instantiations.
 992
 993          if Expander_Active
 994            and then not Is_Generic_Unit (Main_Unit_Entity)
 995          then
 996             Cleanup_Scopes;
 997          elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
 998             End_Generic;
 999          end if;
1000
1001          Pop_Scope;
1002       end if;
1003    end Instantiate_Bodies;
1004
1005    ---------------
1006    -- Is_Nested --
1007    ---------------
1008
1009    function Is_Nested (E : Entity_Id) return Boolean is
1010       Scop : Entity_Id := Scope (E);
1011
1012    begin
1013       while Scop /= Standard_Standard loop
1014          if Ekind (Scop) in Subprogram_Kind then
1015             return True;
1016
1017          elsif Ekind (Scop) = E_Task_Type
1018            or else Ekind (Scop) = E_Entry
1019            or else Ekind (Scop) = E_Entry_Family then
1020             return True;
1021          end if;
1022
1023          Scop := Scope (Scop);
1024       end loop;
1025
1026       return False;
1027    end Is_Nested;
1028
1029    ----------
1030    -- Lock --
1031    ----------
1032
1033    procedure Lock is
1034    begin
1035       Pending_Instantiations.Locked := True;
1036       Inlined_Bodies.Locked := True;
1037       Successors.Locked := True;
1038       Inlined.Locked := True;
1039       Pending_Instantiations.Release;
1040       Inlined_Bodies.Release;
1041       Successors.Release;
1042       Inlined.Release;
1043    end Lock;
1044
1045    --------------------------
1046    -- Remove_Dead_Instance --
1047    --------------------------
1048
1049    procedure Remove_Dead_Instance (N : Node_Id) is
1050       J    : Int;
1051
1052    begin
1053       J := 0;
1054
1055       while J <= Pending_Instantiations.Last loop
1056
1057          if Pending_Instantiations.Table (J).Inst_Node = N then
1058             Pending_Instantiations.Table (J).Inst_Node := Empty;
1059             return;
1060          end if;
1061
1062          J := J + 1;
1063       end loop;
1064    end Remove_Dead_Instance;
1065
1066    ------------------------
1067    -- Scope_In_Main_Unit --
1068    ------------------------
1069
1070    function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is
1071       Comp : Node_Id;
1072       S    : Entity_Id := Scop;
1073       Ent  : Entity_Id := Cunit_Entity (Main_Unit);
1074
1075    begin
1076       --  The scope may be within the main unit, or it may be an ancestor
1077       --  of the main unit, if the main unit is a child unit. In both cases
1078       --  it makes no sense to process the body before the main unit. In
1079       --  the second case, this may lead to circularities if a parent body
1080       --  depends on a child spec, and we are analyzing the child.
1081
1082       while Scope (S) /= Standard_Standard
1083         and then not Is_Child_Unit (S)
1084       loop
1085          S := Scope (S);
1086       end loop;
1087
1088       Comp := Parent (S);
1089
1090       while Present (Comp)
1091         and then Nkind (Comp) /= N_Compilation_Unit
1092       loop
1093          Comp := Parent (Comp);
1094       end loop;
1095
1096       if Is_Child_Unit (Ent) then
1097
1098          while Present (Ent)
1099            and then Is_Child_Unit (Ent)
1100          loop
1101             if Scope (Ent) = S then
1102                return True;
1103             end if;
1104
1105             Ent := Scope (Ent);
1106          end loop;
1107       end if;
1108
1109       return
1110         Comp = Cunit (Main_Unit)
1111           or else Comp = Library_Unit (Cunit (Main_Unit));
1112    end Scope_In_Main_Unit;
1113
1114 end Inline;