[multiple changes]

2012-05-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Expand_With_Clause): In the context of a generic
	package declaration, a private with-clause on a child unit implies
	that the implicit with clauses on its parents are private as well.

2012-05-15  Javier Miranda  <miranda@adacore.com>

	* sem_ch6.adb (Is_Interface_Conformant): Add missing call to
	Base_Type to handle subtypes.
	* exp_ch6.adb (Expand_Call): For calls located in thunks handle
	unchecked conversions of access types found in actuals.
	* exp_disp.adb (Expand_Interface_Thunk): Add missing unchecked
	conversion to actuals whose type is an access type. Done to
	avoid reporting spurious errors.

2012-05-15  Vincent Celier  <celier@adacore.com>

	* prj-env.adb (Create_Mapping): Ignore sources that are
	suppressed (Create_Mapping_File.Process): Ditto
	* prj-nmsc.adb (Add_Source): Update to take into
	account suppressed files that may hide inherited sources.
	(Mark_Excluded_Sources): Mark excluded sources of the current
	project as suppressed.
	* prj.ads (Source_Data): New Boolean component Suppressed,
	defaulted to False

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* exp_intr.adb: Minor reformatting.

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* gnat_rm.texi: Document attribute Scalar_Storage_Order.

2012-05-15  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Build_Offset_To_Top): Modify the
	expansion of the offset_to_top functions to ensure that their
	profile is conformant with the profile specified in Ada.Tags. No
	change in functionality.

2012-05-15  Eric Botcazou  <ebotcazou@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.

From-SVN: r187526

1 files changed, 71 insertions, 95 deletions

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 4735535..86d2fdf 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -70,15 +70,12 @@ package body Inline is
    -----------------------
 
    --  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 @@ package body Inline is
 
    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 @@ package body Inline is
 
    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 @@ package body Inline is
    --  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 @@ package body Inline is
       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 @@ package body Inline is
                --  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 @@ package body Inline is
    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 @@ package body Inline is
         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 @@ package body Inline is
       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 @@ package body Inline is
       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 @@ package body Inline is
       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 @@ package body Inline is
          --  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 @@ package body Inline is
    --------------------------
 
    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;
 
    --------------------------