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-2003 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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_Ch11; use Exp_Ch11;
  33 with Exp_Tss;  use Exp_Tss;
  34 with Fname;    use Fname;
  35 with Fname.UF; use Fname.UF;
  36 with Lib;      use Lib;
  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 := Current_Scope;
 251          Comp : Node_Id;
 252
 253       begin
 254          --  Check if call is in main unit
 255
 256          while Scope (Scop) /= Standard_Standard
 257            and then not Is_Child_Unit (Scop)
 258          loop
 259             Scop := Scope (Scop);
 260          end loop;
 261
 262          Comp := Parent (Scop);
 263
 264          while Nkind (Comp) /= N_Compilation_Unit loop
 265             Comp := Parent (Comp);
 266          end loop;
 267
 268          if Comp = Cunit (Main_Unit)
 269            or else Comp = Library_Unit (Cunit (Main_Unit))
 270          then
 271             Add_Call (E);
 272             return True;
 273          end if;
 274
 275          --  Call is not in main unit. See if it's in some inlined
 276          --  subprogram.
 277
 278          Scop := Current_Scope;
 279          while Scope (Scop) /= Standard_Standard
 280            and then not Is_Child_Unit (Scop)
 281          loop
 282             if Is_Overloadable (Scop)
 283               and then Is_Inlined (Scop)
 284             then
 285                Add_Call (E, Scop);
 286                return True;
 287             end if;
 288
 289             Scop := Scope (Scop);
 290          end loop;
 291
 292          return False;
 293
 294       end Must_Inline;
 295
 296    --  Start of processing for Add_Inlined_Body
 297
 298    begin
 299       --  Find unit containing E, and add to list of inlined bodies if needed.
 300       --  If the body is already present, no need to load any other unit. This
 301       --  is the case for an initialization procedure, which appears in the
 302       --  package declaration that contains the type. It is also the case if
 303       --  the body has already been analyzed. Finally, if the unit enclosing
 304       --  E is an instance, the instance body will be analyzed in any case,
 305       --  and there is no need to add the enclosing unit (whose body might not
 306       --  be available).
 307
 308       --  Library-level functions must be handled specially, because there is
 309       --  no enclosing package to retrieve. In this case, it is the body of
 310       --  the function that will have to be loaded.
 311
 312       if not Is_Abstract (E) and then not Is_Nested (E)
 313         and then Convention (E) /= Convention_Protected
 314       then
 315          Pack := Scope (E);
 316
 317          if Must_Inline
 318            and then Ekind (Pack) = E_Package
 319          then
 320             Set_Is_Called (E);
 321
 322             if Pack = Standard_Standard then
 323
 324                --  Library-level inlined function. Add function iself to
 325                --  list of needed units.
 326
 327                Inlined_Bodies.Increment_Last;
 328                Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
 329
 330             elsif Is_Generic_Instance (Pack) then
 331                null;
 332
 333             elsif not Is_Inlined (Pack)
 334               and then not Has_Completion (E)
 335               and then not Scope_In_Main_Unit (Pack)
 336             then
 337                Set_Is_Inlined (Pack);
 338                Inlined_Bodies.Increment_Last;
 339                Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
 340             end if;
 341          end if;
 342       end if;
 343    end Add_Inlined_Body;
 344
 345    ----------------------------
 346    -- Add_Inlined_Subprogram --
 347    ----------------------------
 348
 349    procedure Add_Inlined_Subprogram (Index : Subp_Index) is
 350       E    : constant Entity_Id := Inlined.Table (Index).Name;
 351       Succ : Succ_Index;
 352       Subp : Subp_Index;
 353
 354       function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean;
 355       --  There are various conditions under which back-end inlining cannot
 356       --  be done reliably:
 357       --
 358       --    a) If a body has handlers, it must not be inlined, because this
 359       --    may violate program semantics, and because in zero-cost exception
 360       --    mode it will lead to undefined symbols at link time.
 361       --
 362       --    b) If a body contains inlined function instances, it cannot be
 363       --    inlined under ZCX because the numerix suffix generated by gigi
 364       --    will be different in the body and the place of the inlined call.
 365       --
 366       --  This procedure must be carefully coordinated with the back end
 367
 368       ----------------------------
 369       -- Back_End_Cannot_Inline --
 370       ----------------------------
 371
 372       function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is
 373          Decl     : Node_Id := Unit_Declaration_Node (Subp);
 374          Body_Ent : Entity_Id;
 375          Ent      : Entity_Id;
 376
 377       begin
 378          if Nkind (Decl) = N_Subprogram_Declaration
 379            and then Present (Corresponding_Body (Decl))
 380          then
 381             Body_Ent := Corresponding_Body (Decl);
 382          else
 383             return False;
 384          end if;
 385
 386          --  If subprogram is marked Inline_Always, inlining is mandatory
 387
 388          if Is_Always_Inlined (Subp) then
 389             return False;
 390          end if;
 391
 392          if Present
 393           (Exception_Handlers
 394             (Handled_Statement_Sequence
 395                  (Unit_Declaration_Node (Corresponding_Body (Decl)))))
 396          then
 397             return True;
 398          end if;
 399
 400          Ent := First_Entity (Body_Ent);
 401
 402          while Present (Ent) loop
 403             if Is_Subprogram (Ent)
 404               and then Is_Generic_Instance (Ent)
 405             then
 406                return True;
 407             end if;
 408
 409             Next_Entity (Ent);
 410          end loop;
 411          return False;
 412       end Back_End_Cannot_Inline;
 413
 414    --  Start of processing for Add_Inlined_Subprogram
 415
 416    begin
 417       --  Insert the current subprogram in the list of inlined subprograms,
 418       --  if it can actually be inlined by the back-end.
 419
 420       if not Scope_In_Main_Unit (E)
 421         and then Is_Inlined (E)
 422         and then not Is_Nested (E)
 423         and then not Has_Initialized_Type (E)
 424       then
 425          if Back_End_Cannot_Inline (E) then
 426             Set_Is_Inlined (E, False);
 427
 428          else
 429             if No (Last_Inlined) then
 430                Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
 431             else
 432                Set_Next_Inlined_Subprogram (Last_Inlined, E);
 433             end if;
 434
 435             Last_Inlined := E;
 436          end if;
 437       end if;
 438
 439       Inlined.Table (Index).Listed := True;
 440       Succ := Inlined.Table (Index).First_Succ;
 441
 442       while Succ /= No_Succ loop
 443          Subp := Successors.Table (Succ).Subp;
 444          Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
 445
 446          if Inlined.Table (Subp).Count = 0 then
 447             Add_Inlined_Subprogram (Subp);
 448          end if;
 449
 450          Succ := Successors.Table (Succ).Next;
 451       end loop;
 452    end Add_Inlined_Subprogram;
 453
 454    ------------------------
 455    -- Add_Scope_To_Clean --
 456    ------------------------
 457
 458    procedure Add_Scope_To_Clean (Inst : Entity_Id) is
 459       Scop : constant Entity_Id := Enclosing_Dynamic_Scope (Inst);
 460       Elmt : Elmt_Id;
 461
 462    begin
 463       --  If the instance appears in a library-level package declaration,
 464       --  all finalization is global, and nothing needs doing here.
 465
 466       if Scop = Standard_Standard then
 467          return;
 468       end if;
 469
 470       Elmt := First_Elmt (To_Clean);
 471
 472       while Present (Elmt) loop
 473
 474          if Node (Elmt) = Scop then
 475             return;
 476          end if;
 477
 478          Elmt := Next_Elmt (Elmt);
 479       end loop;
 480
 481       Append_Elmt (Scop, To_Clean);
 482    end Add_Scope_To_Clean;
 483
 484    --------------
 485    -- Add_Subp --
 486    --------------
 487
 488    function Add_Subp (E : Entity_Id) return Subp_Index is
 489       Index : Subp_Index := Subp_Index (E) mod Num_Hash_Headers;
 490       J     : Subp_Index;
 491
 492       procedure New_Entry;
 493       --  Initialize entry in Inlined table.
 494
 495       procedure New_Entry is
 496       begin
 497          Inlined.Increment_Last;
 498          Inlined.Table (Inlined.Last).Name        := E;
 499          Inlined.Table (Inlined.Last).First_Succ  := No_Succ;
 500          Inlined.Table (Inlined.Last).Count       := 0;
 501          Inlined.Table (Inlined.Last).Listed      := False;
 502          Inlined.Table (Inlined.Last).Main_Call   := False;
 503          Inlined.Table (Inlined.Last).Next        := No_Subp;
 504          Inlined.Table (Inlined.Last).Next_Nopred := No_Subp;
 505       end New_Entry;
 506
 507    --  Start of processing for Add_Subp
 508
 509    begin
 510       if Hash_Headers (Index) = No_Subp then
 511          New_Entry;
 512          Hash_Headers (Index) := Inlined.Last;
 513          return Inlined.Last;
 514
 515       else
 516          J := Hash_Headers (Index);
 517
 518          while J /= No_Subp loop
 519
 520             if Inlined.Table (J).Name = E then
 521                return J;
 522             else
 523                Index := J;
 524                J := Inlined.Table (J).Next;
 525             end if;
 526          end loop;
 527
 528          --  On exit, subprogram was not found. Enter in table. Index is
 529          --  the current last entry on the hash chain.
 530
 531          New_Entry;
 532          Inlined.Table (Index).Next := Inlined.Last;
 533          return Inlined.Last;
 534       end if;
 535    end Add_Subp;
 536
 537    ----------------------------
 538    -- Analyze_Inlined_Bodies --
 539    ----------------------------
 540
 541    procedure Analyze_Inlined_Bodies is
 542       Comp_Unit : Node_Id;
 543       J         : Int;
 544       Pack      : Entity_Id;
 545       S         : Succ_Index;
 546
 547    begin
 548       Analyzing_Inlined_Bodies := False;
 549
 550       if Serious_Errors_Detected = 0 then
 551          New_Scope (Standard_Standard);
 552
 553          J := 0;
 554          while J <= Inlined_Bodies.Last
 555            and then Serious_Errors_Detected = 0
 556          loop
 557             Pack := Inlined_Bodies.Table (J);
 558
 559             while Present (Pack)
 560               and then Scope (Pack) /= Standard_Standard
 561               and then not Is_Child_Unit (Pack)
 562             loop
 563                Pack := Scope (Pack);
 564             end loop;
 565
 566             Comp_Unit := Parent (Pack);
 567
 568             while Present (Comp_Unit)
 569               and then Nkind (Comp_Unit) /= N_Compilation_Unit
 570             loop
 571                Comp_Unit := Parent (Comp_Unit);
 572             end loop;
 573
 574             --  Load the body, unless it the main unit, or is an instance
 575             --  whose body has already been analyzed.
 576
 577             if Present (Comp_Unit)
 578               and then Comp_Unit /= Cunit (Main_Unit)
 579               and then Body_Required (Comp_Unit)
 580               and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration
 581                          or else No (Corresponding_Body (Unit (Comp_Unit))))
 582             then
 583                declare
 584                   Bname : constant Unit_Name_Type :=
 585                             Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit)));
 586
 587                   OK : Boolean;
 588
 589                begin
 590                   if not Is_Loaded (Bname) then
 591                      Load_Needed_Body (Comp_Unit, OK);
 592
 593                      if not OK then
 594                         Error_Msg_Unit_1 := Bname;
 595                         Error_Msg_N
 596                           ("one or more inlined subprograms accessed in $!",
 597                            Comp_Unit);
 598                         Error_Msg_Name_1 :=
 599                           Get_File_Name (Bname, Subunit => False);
 600                         Error_Msg_N ("\but file{ was not found!", Comp_Unit);
 601                         raise Unrecoverable_Error;
 602                      end if;
 603                   end if;
 604                end;
 605             end if;
 606
 607             J := J + 1;
 608          end loop;
 609
 610          --  The analysis of required bodies may have produced additional
 611          --  generic instantiations. To obtain further inlining, we perform
 612          --  another round of generic body instantiations. Establishing a
 613          --  fully recursive loop between inlining and generic instantiations
 614          --  is unlikely to yield more than this one additional pass.
 615
 616          Instantiate_Bodies;
 617
 618          --  The list of inlined subprograms is an overestimate, because
 619          --  it includes inlined functions called from functions that are
 620          --  compiled as part of an inlined package, but are not themselves
 621          --  called. An accurate computation of just those subprograms that
 622          --  are needed requires that we perform a transitive closure over
 623          --  the call graph, starting from calls in the main program. Here
 624          --  we do one step of the inverse transitive closure, and reset
 625          --  the Is_Called flag on subprograms all of whose callers are not.
 626
 627          for Index in Inlined.First .. Inlined.Last loop
 628             S := Inlined.Table (Index).First_Succ;
 629
 630             if S /= No_Succ
 631               and then not Inlined.Table (Index).Main_Call
 632             then
 633                Set_Is_Called (Inlined.Table (Index).Name, False);
 634
 635                while S /= No_Succ loop
 636
 637                   if Is_Called
 638                     (Inlined.Table (Successors.Table (S).Subp).Name)
 639                    or else Inlined.Table (Successors.Table (S).Subp).Main_Call
 640                   then
 641                      Set_Is_Called (Inlined.Table (Index).Name);
 642                      exit;
 643                   end if;
 644
 645                   S := Successors.Table (S).Next;
 646                end loop;
 647             end if;
 648          end loop;
 649
 650          --  Now that the units are compiled, chain the subprograms within
 651          --  that are called and inlined. Produce list of inlined subprograms
 652          --  sorted in  topological order. Start with all subprograms that
 653          --  have no prerequisites, i.e. inlined subprograms that do not call
 654          --  other inlined subprograms.
 655
 656          for Index in Inlined.First .. Inlined.Last loop
 657
 658             if Is_Called (Inlined.Table (Index).Name)
 659               and then Inlined.Table (Index).Count = 0
 660               and then not Inlined.Table (Index).Listed
 661             then
 662                Add_Inlined_Subprogram (Index);
 663             end if;
 664          end loop;
 665
 666          --  Because Add_Inlined_Subprogram treats recursively nodes that have
 667          --  no prerequisites left, at the end of the loop all subprograms
 668          --  must have been listed. If there are any unlisted subprograms
 669          --  left, there must be some recursive chains that cannot be inlined.
 670
 671          for Index in Inlined.First .. Inlined.Last loop
 672             if Is_Called (Inlined.Table (Index).Name)
 673               and then Inlined.Table (Index).Count /= 0
 674               and then not Is_Predefined_File_Name
 675                 (Unit_File_Name
 676                   (Get_Source_Unit (Inlined.Table (Index).Name)))
 677             then
 678                Error_Msg_N
 679                  ("& cannot be inlined?", Inlined.Table (Index).Name);
 680                --  A warning on the first one might be sufficient.
 681             end if;
 682          end loop;
 683
 684          Pop_Scope;
 685       end if;
 686    end Analyze_Inlined_Bodies;
 687
 688    --------------------------------
 689    --  Check_Body_For_Inlining --
 690    --------------------------------
 691
 692    procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
 693       Bname : Unit_Name_Type;
 694       E     : Entity_Id;
 695       OK    : Boolean;
 696
 697    begin
 698       if Is_Compilation_Unit (P)
 699         and then not Is_Generic_Instance (P)
 700       then
 701          Bname := Get_Body_Name (Get_Unit_Name (Unit (N)));
 702          E := First_Entity (P);
 703
 704          while Present (E) loop
 705             if Is_Always_Inlined (E)
 706               or else (Front_End_Inlining and then Has_Pragma_Inline (E))
 707             then
 708                if not Is_Loaded (Bname) then
 709                   Load_Needed_Body (N, OK);
 710
 711                   if OK then
 712
 713                      --  Check that we are not trying to inline a parent
 714                      --  whose body depends on a child, when we are compiling
 715                      --  the body of the child. Otherwise we have a potential
 716                      --  elaboration circularity with inlined subprograms and
 717                      --  with Taft-Amendment types.
 718
 719                      declare
 720                         Comp        : Node_Id;      --  Body just compiled
 721                         Child_Spec  : Entity_Id;    --  Spec of main unit
 722                         Ent         : Entity_Id;    --  For iteration
 723                         With_Clause : Node_Id;      --  Context of body.
 724
 725                      begin
 726                         if Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body
 727                           and then Present (Body_Entity (P))
 728                         then
 729                            Child_Spec :=
 730                              Defining_Entity (
 731                                (Unit (Library_Unit (Cunit (Main_Unit)))));
 732
 733                            Comp :=
 734                              Parent (Unit_Declaration_Node (Body_Entity (P)));
 735
 736                            With_Clause := First (Context_Items (Comp));
 737
 738                            --  Check whether the context of the body just
 739                            --  compiled includes a child of itself, and that
 740                            --  child is the spec of the main compilation.
 741
 742                            while Present (With_Clause) loop
 743                               if Nkind (With_Clause) = N_With_Clause
 744                                 and then
 745                                   Scope (Entity (Name (With_Clause))) = P
 746                                 and then
 747                                   Entity (Name (With_Clause)) = Child_Spec
 748                               then
 749                                  Error_Msg_Node_2 := Child_Spec;
 750                                  Error_Msg_NE
 751                                    ("body of & depends on child unit&?",
 752                                       With_Clause, P);
 753                                  Error_Msg_N
 754                                    ("\subprograms in body cannot be inlined?",
 755                                       With_Clause);
 756
 757                                  --  Disable further inlining from this unit,
 758                                  --  and keep Taft-amendment types incomplete.
 759
 760                                  Ent := First_Entity (P);
 761
 762                                  while Present (Ent) loop
 763                                     if Is_Type (Ent)
 764                                        and then Has_Completion_In_Body (Ent)
 765                                     then
 766                                        Set_Full_View (Ent, Empty);
 767
 768                                     elsif Is_Subprogram (Ent) then
 769                                        Set_Is_Inlined (Ent, False);
 770                                     end if;
 771
 772                                     Next_Entity (Ent);
 773                                  end loop;
 774
 775                                  return;
 776                               end if;
 777
 778                               Next (With_Clause);
 779                            end loop;
 780                         end if;
 781                      end;
 782
 783                   elsif Ineffective_Inline_Warnings then
 784                      Error_Msg_Unit_1 := Bname;
 785                      Error_Msg_N
 786                        ("unable to inline subprograms defined in $?", P);
 787                      Error_Msg_N ("\body not found?", P);
 788                      return;
 789                   end if;
 790                end if;
 791
 792                return;
 793             end if;
 794
 795             Next_Entity (E);
 796          end loop;
 797       end if;
 798    end Check_Body_For_Inlining;
 799
 800    --------------------
 801    -- Cleanup_Scopes --
 802    --------------------
 803
 804    procedure Cleanup_Scopes is
 805       Elmt : Elmt_Id;
 806       Decl : Node_Id;
 807       Scop : Entity_Id;
 808
 809    begin
 810       Elmt := First_Elmt (To_Clean);
 811
 812       while Present (Elmt) loop
 813          Scop := Node (Elmt);
 814
 815          if Ekind (Scop) = E_Entry then
 816             Scop := Protected_Body_Subprogram (Scop);
 817
 818          elsif Is_Subprogram (Scop)
 819            and then Is_Protected_Type (Scope (Scop))
 820            and then Present (Protected_Body_Subprogram (Scop))
 821          then
 822             --  If a protected operation contains an instance, its
 823             --  cleanup operations have been delayed, and the subprogram
 824             --  has been rewritten in the expansion of the enclosing
 825             --  protected body. It is the corresponding subprogram that
 826             --  may require the cleanup operations.
 827
 828             Set_Uses_Sec_Stack
 829               (Protected_Body_Subprogram (Scop),
 830                 Uses_Sec_Stack (Scop));
 831             Scop := Protected_Body_Subprogram (Scop);
 832          end if;
 833
 834          if Ekind (Scop) = E_Block then
 835             Decl := Parent (Block_Node (Scop));
 836
 837          else
 838             Decl := Unit_Declaration_Node (Scop);
 839
 840             if Nkind (Decl) = N_Subprogram_Declaration
 841               or else Nkind (Decl) = N_Task_Type_Declaration
 842               or else Nkind (Decl) = N_Subprogram_Body_Stub
 843             then
 844                Decl := Unit_Declaration_Node (Corresponding_Body (Decl));
 845             end if;
 846          end if;
 847
 848          New_Scope (Scop);
 849          Expand_Cleanup_Actions (Decl);
 850          End_Scope;
 851
 852          Elmt := Next_Elmt (Elmt);
 853       end loop;
 854    end Cleanup_Scopes;
 855
 856    --------------------------
 857    -- Has_Initialized_Type --
 858    --------------------------
 859
 860    function Has_Initialized_Type (E : Entity_Id) return Boolean is
 861       E_Body : constant Node_Id := Get_Subprogram_Body (E);
 862       Decl   : Node_Id;
 863
 864    begin
 865       if No (E_Body) then        --  imported subprogram
 866          return False;
 867
 868       else
 869          Decl := First (Declarations (E_Body));
 870
 871          while Present (Decl) loop
 872
 873             if Nkind (Decl) = N_Full_Type_Declaration
 874               and then Present (Init_Proc (Defining_Identifier (Decl)))
 875             then
 876                return True;
 877             end if;
 878
 879             Next (Decl);
 880          end loop;
 881       end if;
 882
 883       return False;
 884    end Has_Initialized_Type;
 885
 886    ----------------
 887    -- Initialize --
 888    ----------------
 889
 890    procedure Initialize is
 891    begin
 892       Analyzing_Inlined_Bodies := False;
 893       Pending_Descriptor.Init;
 894       Pending_Instantiations.Init;
 895       Inlined_Bodies.Init;
 896       Successors.Init;
 897       Inlined.Init;
 898
 899       for J in Hash_Headers'Range loop
 900          Hash_Headers (J) := No_Subp;
 901       end loop;
 902    end Initialize;
 903
 904    ------------------------
 905    -- Instantiate_Bodies --
 906    ------------------------
 907
 908    --  Generic bodies contain all the non-local references, so an
 909    --  instantiation does not need any more context than Standard
 910    --  itself, even if the instantiation appears in an inner scope.
 911    --  Generic associations have verified that the contract model is
 912    --  satisfied, so that any error that may occur in the analysis of
 913    --  the body is an internal error.
 914
 915    procedure Instantiate_Bodies is
 916       J    : Int;
 917       Info : Pending_Body_Info;
 918
 919    begin
 920       if Serious_Errors_Detected = 0 then
 921
 922          Expander_Active := (Operating_Mode = Opt.Generate_Code);
 923          New_Scope (Standard_Standard);
 924          To_Clean := New_Elmt_List;
 925
 926          if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
 927             Start_Generic;
 928          end if;
 929
 930          --  A body instantiation may generate additional instantiations, so
 931          --  the following loop must scan to the end of a possibly expanding
 932          --  set (that's why we can't simply use a FOR loop here).
 933
 934          J := 0;
 935
 936          while J <= Pending_Instantiations.Last
 937            and then Serious_Errors_Detected = 0
 938          loop
 939             Info := Pending_Instantiations.Table (J);
 940
 941             --  If the instantiation node is absent, it has been removed
 942             --  as part of unreachable code.
 943
 944             if No (Info.Inst_Node) then
 945                null;
 946
 947             elsif Nkind (Info.Act_Decl) = N_Package_Declaration then
 948                Instantiate_Package_Body (Info);
 949                Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
 950
 951             else
 952                Instantiate_Subprogram_Body (Info);
 953             end if;
 954
 955             J := J + 1;
 956          end loop;
 957
 958          --  Reset the table of instantiations. Additional instantiations
 959          --  may be added through inlining, when additional bodies are
 960          --  analyzed.
 961
 962          Pending_Instantiations.Init;
 963
 964          --  We can now complete the cleanup actions of scopes that contain
 965          --  pending instantiations (skipped for generic units, since we
 966          --  never need any cleanups in generic units).
 967          --  pending instantiations.
 968
 969          if Expander_Active
 970            and then not Is_Generic_Unit (Main_Unit_Entity)
 971          then
 972             Cleanup_Scopes;
 973
 974             --  Also generate subprogram descriptors that were delayed
 975
 976             for J in Pending_Descriptor.First .. Pending_Descriptor.Last loop
 977                declare
 978                   Ent : constant Entity_Id := Pending_Descriptor.Table (J);
 979
 980                begin
 981                   if Is_Subprogram (Ent) then
 982                      Generate_Subprogram_Descriptor_For_Subprogram
 983                        (Get_Subprogram_Body (Ent), Ent);
 984
 985                   elsif Ekind (Ent) = E_Package then
 986                      Generate_Subprogram_Descriptor_For_Package
 987                        (Parent (Declaration_Node (Ent)), Ent);
 988
 989                   elsif Ekind (Ent) = E_Package_Body then
 990                      Generate_Subprogram_Descriptor_For_Package
 991                        (Declaration_Node (Ent), Ent);
 992                   end if;
 993                end;
 994             end loop;
 995
 996          elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
 997             End_Generic;
 998          end if;
 999
1000          Pop_Scope;
1001       end if;
1002    end Instantiate_Bodies;
1003
1004    ---------------
1005    -- Is_Nested --
1006    ---------------
1007
1008    function Is_Nested (E : Entity_Id) return Boolean is
1009       Scop : Entity_Id := Scope (E);
1010
1011    begin
1012       while Scop /= Standard_Standard loop
1013          if Ekind (Scop) in Subprogram_Kind then
1014             return True;
1015
1016          elsif Ekind (Scop) = E_Task_Type
1017            or else Ekind (Scop) = E_Entry
1018            or else Ekind (Scop) = E_Entry_Family then
1019             return True;
1020          end if;
1021
1022          Scop := Scope (Scop);
1023       end loop;
1024
1025       return False;
1026    end Is_Nested;
1027
1028    ----------
1029    -- Lock --
1030    ----------
1031
1032    procedure Lock is
1033    begin
1034       Pending_Instantiations.Locked := True;
1035       Inlined_Bodies.Locked := True;
1036       Successors.Locked := True;
1037       Inlined.Locked := True;
1038       Pending_Instantiations.Release;
1039       Inlined_Bodies.Release;
1040       Successors.Release;
1041       Inlined.Release;
1042    end Lock;
1043
1044    --------------------------
1045    -- Remove_Dead_Instance --
1046    --------------------------
1047
1048    procedure Remove_Dead_Instance (N : Node_Id) is
1049       J    : Int;
1050
1051    begin
1052       J := 0;
1053
1054       while J <= Pending_Instantiations.Last loop
1055
1056          if Pending_Instantiations.Table (J).Inst_Node = N then
1057             Pending_Instantiations.Table (J).Inst_Node := Empty;
1058             return;
1059          end if;
1060
1061          J := J + 1;
1062       end loop;
1063    end Remove_Dead_Instance;
1064
1065    ------------------------
1066    -- Scope_In_Main_Unit --
1067    ------------------------
1068
1069    function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is
1070       Comp : Node_Id;
1071       S    : Entity_Id := Scop;
1072       Ent  : Entity_Id := Cunit_Entity (Main_Unit);
1073
1074    begin
1075       --  The scope may be within the main unit, or it may be an ancestor
1076       --  of the main unit, if the main unit is a child unit. In both cases
1077       --  it makes no sense to process the body before the main unit. In
1078       --  the second case, this may lead to circularities if a parent body
1079       --  depends on a child spec, and we are analyzing the child.
1080
1081       while Scope (S) /= Standard_Standard
1082         and then not Is_Child_Unit (S)
1083       loop
1084          S := Scope (S);
1085       end loop;
1086
1087       Comp := Parent (S);
1088
1089       while Present (Comp)
1090         and then Nkind (Comp) /= N_Compilation_Unit
1091       loop
1092          Comp := Parent (Comp);
1093       end loop;
1094
1095       if Is_Child_Unit (Ent) then
1096
1097          while Present (Ent)
1098            and then Is_Child_Unit (Ent)
1099          loop
1100             if Scope (Ent) = S then
1101                return True;
1102             end if;
1103
1104             Ent := Scope (Ent);
1105          end loop;
1106       end if;
1107
1108       return
1109         Comp = Cunit (Main_Unit)
1110           or else Comp = Library_Unit (Cunit (Main_Unit));
1111    end Scope_In_Main_Unit;
1112
1113 end Inline;