This restores cross-unit inlining for user-defined internal inline subprograms
invoked from public inline subprograms.   This also reworks the algorithm used
to compute the list of inlined subprograms passed to gigi.  The old algorithm
attempts to compute a topological order on the list, and thus stops when there
is a cycle (issuing a warning that is apparently not printed by the compiler),
because of the old requirement that callees be put before callers on the list.

The above requirement is obsolete now, as the back-end works in unit-at-a-time 
mode.  So we can drop the topological order, allowing cycles in the call graph,
and compute the transitive closure while still reducing the complexity of the
implementation.

Accepting cycles means that we now optimize away cases like:

with B; use B;

procedure A is
begin
  Proc1 (1);
end;

package B is

  procedure Proc1 (I : Integer);
  pragma Inline (Proc1);

end B;

package body B is

  procedure Proc2;
  pragma Inline (Proc2);

  procedure Proc1 (I : Integer) is
  begin
    if I /= 0 then
      Proc2;
    end if;
  end;

  procedure Proc2 is
  begin
    Proc1 (0);
  end;

end B;

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-05-15  Eric Botcazou  <ebotca...@adacore.com>

        * inline.adb (Subp_Info): Remove Count and Next_Nopred
        components, add Processed component and move around Next component.
        (Add_Call): Reverse meaning of Successors table to the natural one.
        (Add_Inlined_Body): Do not inline a package if it is in the main unit.
        (Add_Inlined_Subprogram): Do not add the subprogram to the list if the
        package is in the main unit. Do not recurse on the successors.
        (Add_Subp): Adjust to new contents of Subp_Info.
        (Analyze_Inlined_Bodies): Do not attempt
        to compute a topological order on the list of inlined subprograms,
        but compute the transitive closure from the main unit instead.
        (Get_Code_Unit_Entity): Always return the spec for a package.

Index: inline.adb
===================================================================
--- inline.adb  (revision 187522)
+++ inline.adb  (working copy)
@@ -70,15 +70,12 @@
    -----------------------
 
    --  For each call to an inlined subprogram, we make entries in a table
-   --  that stores caller and callee, and indicates a prerequisite from
+   --  that stores caller and callee, and indicates the call direction from
    --  one to the other. We also record the compilation unit that contains
    --  the callee. After analyzing the bodies of all such compilation units,
-   --  we produce a list of subprograms in  topological order, for use by the
-   --  back-end. If P2 is a prerequisite of P1, then P1 calls P2, and for
-   --  proper inlining the back-end must analyze the body of P2 before that of
-   --  P1. The code below guarantees that the transitive closure of inlined
-   --  subprograms called from the main compilation unit is made available to
-   --  the code generator.
+   --  we compute the transitive closure of inlined subprograms called from
+   --  the main compilation unit and make it available to the code generator
+   --  in no particular order, thus allowing cycles in the call graph.
 
    Last_Inlined : Entity_Id := Empty;
 
@@ -117,12 +114,11 @@
 
    type Subp_Info is record
       Name        : Entity_Id  := Empty;
+      Next        : Subp_Index := No_Subp;
       First_Succ  : Succ_Index := No_Succ;
-      Count       : Integer    := 0;
       Listed      : Boolean    := False;
       Main_Call   : Boolean    := False;
-      Next        : Subp_Index := No_Subp;
-      Next_Nopred : Subp_Index := No_Subp;
+      Processed   : Boolean    := False;
    end record;
 
    package Inlined is new Table.Table (
@@ -139,7 +135,8 @@
 
    function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id;
    pragma Inline (Get_Code_Unit_Entity);
-   --  Return the entity node for the unit containing E
+   --  Return the entity node for the unit containing E. Always return
+   --  the spec for a package.
 
    function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean;
    --  Return True if Scop is in the main unit or its spec
@@ -166,9 +163,7 @@
    --  example, an initialization procedure).
 
    procedure Add_Inlined_Subprogram (Index : Subp_Index);
-   --  Add subprogram to Inlined List once all of its predecessors have been
-   --  placed on the list. Decrement the count of all its successors, and
-   --  add them to list (recursively) if count drops to zero.
+   --  Add the subprogram to the list of inlined subprogram for the unit
 
    ------------------------------
    -- Deferred Cleanup Actions --
@@ -203,29 +198,26 @@
       if Present (Caller) then
          P2 := Add_Subp (Caller);
 
-         --  Add P2 to the list of successors of P1, if not already there.
+         --  Add P1 to the list of successors of P2, if not already there.
          --  Note that P2 may contain more than one call to P1, and only
          --  one needs to be recorded.
 
-         J := Inlined.Table (P1).First_Succ;
+         J := Inlined.Table (P2).First_Succ;
          while J /= No_Succ loop
-            if Successors.Table (J).Subp = P2 then
+            if Successors.Table (J).Subp = P1 then
                return;
             end if;
 
             J := Successors.Table (J).Next;
          end loop;
 
-         --  On exit, make a successor entry for P2
+         --  On exit, make a successor entry for P1
 
          Successors.Increment_Last;
-         Successors.Table (Successors.Last).Subp := P2;
+         Successors.Table (Successors.Last).Subp := P1;
          Successors.Table (Successors.Last).Next :=
-                             Inlined.Table (P1).First_Succ;
-         Inlined.Table (P1).First_Succ := Successors.Last;
-
-         Inlined.Table (P2).Count := Inlined.Table (P2).Count + 1;
-
+                             Inlined.Table (P2).First_Succ;
+         Inlined.Table (P2).First_Succ := Successors.Last;
       else
          Inlined.Table (P1).Main_Call := True;
       end if;
@@ -345,9 +337,11 @@
                --  or other internally generated subprogram, because in that
                --  case the subprogram body appears in the same unit that
                --  declares the type, and that body is visible to the back end.
+               --  Do not inline it either if it is in the main unit.
 
                elsif not Is_Inlined (Pack)
                  and then Comes_From_Source (E)
+                 and then not Scope_In_Main_Unit (Pack)
                then
                   Set_Is_Inlined (Pack);
                   Inlined_Bodies.Increment_Last;
@@ -365,8 +359,6 @@
    procedure Add_Inlined_Subprogram (Index : Subp_Index) is
       E    : constant Entity_Id := Inlined.Table (Index).Name;
       Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
-      Succ : Succ_Index;
-      Subp : Subp_Index;
 
       function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean;
       --  There are various conditions under which back-end inlining cannot
@@ -441,7 +433,7 @@
         and then (Is_Inlined (Pack)
                     or else Is_Generic_Instance (Pack)
                     or else Is_Internal (E))
-        and then not Scope_In_Main_Unit (E)
+        and then not Scope_In_Main_Unit (Pack)
         and then not Is_Nested (E)
         and then not Has_Initialized_Type (E)
       then
@@ -460,27 +452,6 @@
       end if;
 
       Inlined.Table (Index).Listed := True;
-
-      --  Now add to the list those callers of the current subprogram that
-      --  are themselves called. They may appear on the graph as callers
-      --  of the current one, even if they are themselves not called, and
-      --  there is no point in including them in the list for the backend.
-      --  Furthermore, they might not even be public, in which case the
-      --  back-end cannot handle them at all.
-
-      Succ := Inlined.Table (Index).First_Succ;
-      while Succ /= No_Succ loop
-         Subp := Successors.Table (Succ).Subp;
-         Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
-
-         if Inlined.Table (Subp).Count = 0
-           and then Is_Called (Inlined.Table (Subp).Name)
-         then
-            Add_Inlined_Subprogram (Subp);
-         end if;
-
-         Succ := Successors.Table (Succ).Next;
-      end loop;
    end Add_Inlined_Subprogram;
 
    ------------------------
@@ -545,12 +516,11 @@
       begin
          Inlined.Increment_Last;
          Inlined.Table (Inlined.Last).Name        := E;
+         Inlined.Table (Inlined.Last).Next        := No_Subp;
          Inlined.Table (Inlined.Last).First_Succ  := No_Succ;
-         Inlined.Table (Inlined.Last).Count       := 0;
          Inlined.Table (Inlined.Last).Listed      := False;
          Inlined.Table (Inlined.Last).Main_Call   := False;
-         Inlined.Table (Inlined.Last).Next        := No_Subp;
-         Inlined.Table (Inlined.Last).Next_Nopred := No_Subp;
+         Inlined.Table (Inlined.Last).Processed   := False;
       end New_Entry;
 
    --  Start of processing for Add_Subp
@@ -589,8 +559,20 @@
       Comp_Unit : Node_Id;
       J         : Int;
       Pack      : Entity_Id;
+      Subp      : Subp_Index;
       S         : Succ_Index;
 
+      type Pending_Index is new Nat;
+
+      package Pending_Inlined is new Table.Table (
+         Table_Component_Type => Subp_Index,
+         Table_Index_Type     => Pending_Index,
+         Table_Low_Bound      => 1,
+         Table_Initial        => Alloc.Inlined_Initial,
+         Table_Increment      => Alloc.Inlined_Increment,
+         Table_Name           => "Pending_Inlined");
+      --  The workpile used to compute the transitive closure
+
       function Is_Ancestor_Of_Main
         (U_Name : Entity_Id;
          Nam    : Node_Id) return Boolean;
@@ -757,64 +739,54 @@
          --  as part of an inlined package, but are not themselves called. An
          --  accurate computation of just those subprograms that are needed
          --  requires that we perform a transitive closure over the call graph,
-         --  starting from calls in the main program. Here we do one step of
-         --  the inverse transitive closure, and reset the Is_Called flag on
-         --  subprograms all of whose callers are not.
+         --  starting from calls in the main program.
 
          for Index in Inlined.First .. Inlined.Last loop
-            S := Inlined.Table (Index).First_Succ;
+            if not Is_Called (Inlined.Table (Index).Name) then
+               --  This means that Add_Inlined_Body added the subprogram to the
+               --  table but wasn't able to handle its code unit. Do nothing.
 
-            if S /= No_Succ
-              and then not Inlined.Table (Index).Main_Call
-            then
+               null;
+            elsif Inlined.Table (Index).Main_Call then
+               Pending_Inlined.Increment_Last;
+               Pending_Inlined.Table (Pending_Inlined.Last) := Index;
+               Inlined.Table (Index).Processed := True;
+            else
                Set_Is_Called (Inlined.Table (Index).Name, False);
-
-               while S /= No_Succ loop
-                  if Is_Called
-                    (Inlined.Table (Successors.Table (S).Subp).Name)
-                   or else Inlined.Table (Successors.Table (S).Subp).Main_Call
-                  then
-                     Set_Is_Called (Inlined.Table (Index).Name);
-                     exit;
-                  end if;
-
-                  S := Successors.Table (S).Next;
-               end loop;
             end if;
          end loop;
 
-         --  Now that the units are compiled, chain the subprograms within
-         --  that are called and inlined. Produce list of inlined subprograms
-         --  sorted in  topological order. Start with all subprograms that
-         --  have no prerequisites, i.e. inlined subprograms that do not call
-         --  other inlined subprograms.
+         --  Iterate over the workpile until it is emptied, propagating the
+         --  Is_Called flag to the successors of the processed subprogram.
 
-         for Index in Inlined.First .. Inlined.Last loop
+         while Pending_Inlined.Last >= Pending_Inlined.First loop
+            Subp := Pending_Inlined.Table (Pending_Inlined.Last);
+            Pending_Inlined.Decrement_Last;
 
-            if Is_Called (Inlined.Table (Index).Name)
-              and then Inlined.Table (Index).Count = 0
-              and then not Inlined.Table (Index).Listed
-            then
-               Add_Inlined_Subprogram (Index);
-            end if;
+            S := Inlined.Table (Subp).First_Succ;
+
+            while S /= No_Succ loop
+               Subp := Successors.Table (S).Subp;
+               Set_Is_Called (Inlined.Table (Subp).Name);
+
+               if not Inlined.Table (Subp).Processed then
+                  Pending_Inlined.Increment_Last;
+                  Pending_Inlined.Table (Pending_Inlined.Last) := Subp;
+                  Inlined.Table (Subp).Processed := True;
+               end if;
+
+               S := Successors.Table (S).Next;
+            end loop;
          end loop;
 
-         --  Because Add_Inlined_Subprogram treats recursively nodes that have
-         --  no prerequisites left, at the end of the loop all subprograms
-         --  must have been listed. If there are any unlisted subprograms
-         --  left, there must be some recursive chains that cannot be inlined.
+         --  Finally add the called subprograms to the list of inlined
+         --  subprograms for the unit.
 
          for Index in Inlined.First .. Inlined.Last loop
             if Is_Called (Inlined.Table (Index).Name)
-              and then Inlined.Table (Index).Count /= 0
-              and then not Is_Predefined_File_Name
-                (Unit_File_Name
-                  (Get_Source_Unit (Inlined.Table (Index).Name)))
+              and then not Inlined.Table (Index).Listed
             then
-               Error_Msg_N
-                 ("& cannot be inlined?", Inlined.Table (Index).Name);
-
-               --  A warning on the first one might be sufficient ???
+               Add_Inlined_Subprogram (Index);
             end if;
          end loop;
 
@@ -994,8 +966,12 @@
    --------------------------
 
    function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is
+      Unit : Entity_Id := Cunit_Entity (Get_Code_Unit (E));
    begin
-      return Cunit_Entity (Get_Code_Unit (E));
+      if Ekind (Unit) = E_Package_Body then
+         Unit := Spec_Entity (Unit);
+      end if;
+      return Unit;
    end Get_Code_Unit_Entity;
 
    --------------------------

Reply via email to