Patchwork [Ada] Adding new frontend support for inlining

login
register
mail settings
Submitter Arnaud Charlet
Date March 7, 2012, 2:56 p.m.
Message ID <20120307145658.GA5602@adacore.com>
Download mbox | patch
Permalink /patch/145308/
State New
Headers show

Comments

Arnaud Charlet - March 7, 2012, 2:56 p.m.
This patch incorporates in the frontend a new approach for inlining.
This new support is available for now using -gnatd.k pending further
refinments/testing.

 These are the rules:

  * At -O0 use fe inlining when inline_always is specified except if
    the function returns a controlled type.

  * At other optimization levels use the fe inlining for both inline
    and inline_always in the following cases:
      - function returning a known at compile time constant
      - function returning a call to an intrinsic function
      - function returning an unconstrained type through an Ada 2005
        extended return statement
      - function returning a call to a frontend-inlined function
    Use the back-end mechanism otherwise

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

2012-03-07  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): If the object
	declaration has an init expression then stop the analysis of the
	object declaration if the expression which initializes the object
	is a call to an inlined function which returns an unconstrained
	and has been expanded into a procedure call.
	* sem_ch5.adb (Has_Call_Using_Secondary_Stack): Add missing
	support to handle selected components.
	* sem_ch6.ads (Cannot_Inline): Adding parameter Is_Serious plus
	documentation.
	* sem_ch6.adb (Check_And_Build_Body_To_Inline): New
	subprogram which implements the checks required by the
	new rules for frontend inlining and builds the body to inline.
	(Analyze_Subprogram_Body_Helper): Move code that
	checks inlining of subprogram that has nested subprogram
	to Check_And_Build_Body_To_Inline.  Replace call to
	Build_Body_To_Inline by call to the new subprogram
	Check_And_Build_Body_To_Inline.
	(Cannot_Inline): New implementation.
	* sem_ch12.adb (Analyze_Package_Instantiation.Must_Inline_Subp):
	New subprogram.
	* sem_util.ad[sb] (Must_Inline): New subprogram.
	(Returns_Unconstrained_Type): New subprogram.
	* sem_res.adb (Resolve_Call): Do not create a transient scope
	for inlined calls.
	* inline.ads (Analyzing_Inlined_Bodies): Remove unreferenced variable.
	* inline.adb (Analyze_Inlined_Bodies, Initialize): Remove setting
	to false the variable Analyzing_Inlined_Bodies.  Fix comments.
	* exp_ch4.adb (Expand_N_Allocator): Fix handling of finalization master.
	* exp_ch6.ads (List_Inlining_Info): New subprogram.
	* exp_ch6.adb (Expand_Call.Do_Inline): New subprogram.
	(Expand_Call.Do_Inline_Always): New subprogram.
	(In_Unfrozen_Instance): Move the declaration of this subprogram.
	(Expand_Inlined_Call.Reset_Dispatching_Calls): New subprogram.
	(Expand_Inlined_Call): Adding new support for inlining functions
	that return unconstrained types.
	(List_Inlining_Info): New subprogram.
	* debug.adb Document flags -gnatd.j and -gnatd.k
	* gnat1drv.adb Add call to generate the new listing of inlined
	calls and calls passed to the backend.

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 185051)
+++ sem_ch3.adb	(working copy)
@@ -3163,6 +3163,24 @@ 
          Set_Etype (Id, T);
          Resolve (E, T);
 
+         --  No further action needed if E is a call to an inlined function
+         --  which returns an unconstrained type and it has been expanded into
+         --  a procedure call. In that case N has been replaced by an object
+         --  declaration without initializing expression and it has been
+         --  analyzed (see Expand_Inlined_Call).
+
+         if Debug_Flag_Dot_K
+           and then Expander_Active
+           and then Nkind (E) = N_Function_Call
+           and then Nkind (Name (E)) in N_Has_Entity
+           and then Is_Inlined (Entity (Name (E)))
+           and then not Is_Constrained (Etype (E))
+           and then Analyzed (N)
+           and then No (Expression (N))
+         then
+            return;
+         end if;
+
          --  If E is null and has been replaced by an N_Raise_Constraint_Error
          --  node (which was marked already-analyzed), we need to set the type
          --  to something other than Any_Access in order to keep gigi happy.
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb	(revision 185053)
+++ sem_ch5.adb	(working copy)
@@ -1852,8 +1852,14 @@ 
                if Nkind (Nam) = N_Explicit_Dereference then
                   Subp := Etype (Nam);
 
-               --  Normal case
+               --  Call using a selected component notation or Ada 2005 object
+               --  operation notation
 
+               elsif Nkind (Nam) = N_Selected_Component then
+                  Subp := Entity (Selector_Name (Nam));
+
+               --  Common case
+
                else
                   Subp := Entity (Nam);
                end if;
Index: inline.adb
===================================================================
--- inline.adb	(revision 185051)
+++ inline.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -642,11 +642,9 @@ 
          end if;
       end Is_Ancestor_Of_Main;
 
-   --  Start of processing for  Analyze_Inlined_Bodies
+   --  Start of processing for Analyze_Inlined_Bodies
 
    begin
-      Analyzing_Inlined_Bodies := False;
-
       if Serious_Errors_Detected = 0 then
          Push_Scope (Standard_Standard);
 
@@ -669,8 +667,8 @@ 
                Comp_Unit := Parent (Comp_Unit);
             end loop;
 
-            --  Load the body, unless it the main unit, or is an instance whose
-            --  body has already been analyzed.
+            --  Load the body, unless it is the main unit, or is an instance
+            --  whose body has already been analyzed.
 
             if Present (Comp_Unit)
               and then Comp_Unit /= Cunit (Main_Unit)
@@ -1035,7 +1033,6 @@ 
 
    procedure Initialize is
    begin
-      Analyzing_Inlined_Bodies := False;
       Pending_Descriptor.Init;
       Pending_Instantiations.Init;
       Inlined_Bodies.Init;
Index: inline.ads
===================================================================
--- inline.ads	(revision 185051)
+++ inline.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -110,11 +110,6 @@ 
      Table_Increment      => Alloc.Pending_Instantiations_Increment,
      Table_Name           => "Pending_Descriptor");
 
-   Analyzing_Inlined_Bodies : Boolean;
-   --  This flag is set False by the call to Initialize, and then is set
-   --  True by the call to Analyze_Inlined_Bodies. It is used to suppress
-   --  generation of subprogram descriptors for inlined bodies.
-
    -----------------
    -- Subprograms --
    -----------------
Index: debug.adb
===================================================================
--- debug.adb	(revision 185051)
+++ debug.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -100,8 +100,8 @@ 
    --  d.g  Enable conversion of raise into goto
    --  d.h
    --  d.i  Ignore Warnings pragmas
-   --  d.j
-   --  d.k
+   --  d.j  Generate listing of frontend inlined calls
+   --  d.k  Enable new support for frontend inlining
    --  d.l  Use Ada 95 semantics for limited function returns
    --  d.m  For -gnatl, print full source only for main unit
    --  d.n  Print source file names
@@ -533,6 +533,13 @@ 
    --       be used in particular to disable Warnings (Off) to check if any of
    --       these statements are inappropriate.
 
+   --  d.j  Generate listing of frontend inlined calls and inline calls passed
+   --       to the backend. This is useful to locate skipped calls that must be
+   --       inlined by the frontend.
+
+   --  d.k  Enable new semantics of frontend inlining.  This is useful to test
+   --       this new feature in all the platforms.
+
    --  d.l  Use Ada 95 semantics for limited function returns. This may be
    --       used to work around the incompatibility introduced by AI-318-2.
    --       It is useful only in -gnat05 mode.
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 185051)
+++ sem_ch12.adb	(working copy)
@@ -25,6 +25,7 @@ 
 
 with Aspects;  use Aspects;
 with Atree;    use Atree;
+with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
@@ -3294,6 +3295,11 @@ 
       --  but it is simpler than detecting the need for the body at the point
       --  of inlining, when the context of the instance is not available.
 
+      function Must_Inline_Subp return Boolean;
+      --  If inlining is active and the generic contains inlined subprograms,
+      --  return True if some of the inlined subprograms must be inlined by
+      --  the frontend.
+
       -----------------------
       -- Delay_Descriptors --
       -----------------------
@@ -3333,6 +3339,34 @@ 
          return False;
       end Might_Inline_Subp;
 
+      ----------------------
+      -- Must_Inline_Subp --
+      ----------------------
+
+      function Must_Inline_Subp return Boolean is
+         E : Entity_Id;
+
+      begin
+         if not Inline_Processing_Required then
+            return False;
+
+         else
+            E := First_Entity (Gen_Unit);
+            while Present (E) loop
+               if Is_Subprogram (E)
+                 and then Is_Inlined (E)
+                 and then Must_Inline (E)
+               then
+                  return True;
+               end if;
+
+               Next_Entity (E);
+            end loop;
+         end if;
+
+         return False;
+      end Must_Inline_Subp;
+
       --  Local declarations
 
       Vis_Prims_List : Elist_Id := No_Elist;
@@ -3613,13 +3647,22 @@ 
               and then Might_Inline_Subp
               and then not Is_Actual_Pack
             then
-               if Front_End_Inlining
+               if not Debug_Flag_Dot_K
+                 and then Front_End_Inlining
                  and then (Is_In_Main_Unit (N)
                             or else In_Main_Context (Current_Scope))
                  and then Nkind (Parent (N)) /= N_Compilation_Unit
                then
                   Inline_Now := True;
 
+               elsif Debug_Flag_Dot_K
+                 and then Must_Inline_Subp
+                 and then (Is_In_Main_Unit (N)
+                            or else In_Main_Context (Current_Scope))
+                 and then Nkind (Parent (N)) /= N_Compilation_Unit
+               then
+                  Inline_Now := True;
+
                --  In configurable_run_time mode we force the inlining of
                --  predefined subprograms marked Inline_Always, to minimize
                --  the use of the run-time library.
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 185051)
+++ sem_util.adb	(working copy)
@@ -9389,6 +9389,18 @@ 
       Mark_Allocators (Root_Nod);
    end Mark_Coextensions;
 
+   -----------------
+   -- Must_Inline --
+   -----------------
+
+   function Must_Inline (Subp : Entity_Id) return Boolean is
+   begin
+      return Optimization_Level = 0
+        and then Has_Pragma_Inline (Subp)
+        and then (Has_Pragma_Inline_Always (Subp)
+                    or else Front_End_Inlining);
+   end Must_Inline;
+
    ----------------------
    -- Needs_One_Actual --
    ----------------------
@@ -11767,6 +11779,18 @@ 
       Reset_Analyzed (N);
    end Reset_Analyzed_Flags;
 
+   --------------------------------
+   -- Returns_Unconstrained_Type --
+   --------------------------------
+
+   function Returns_Unconstrained_Type (Subp : Entity_Id) return Boolean is
+   begin
+      return Ekind (Subp) = E_Function
+        and then not Is_Scalar_Type (Etype (Subp))
+        and then not Is_Access_Type (Etype (Subp))
+        and then not Is_Constrained (Etype (Subp));
+   end Returns_Unconstrained_Type;
+
    ---------------------------
    -- Safe_To_Capture_Value --
    ---------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 185051)
+++ sem_util.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1115,6 +1115,9 @@ 
    --  to guarantee this in all cases. Note that it is more possible to give
    --  correct answer if the tree is fully analyzed.
 
+   function Must_Inline (Subp : Entity_Id) return Boolean;
+   --  Return true if Subp must be inlined by the frontend
+
    function Needs_One_Actual (E : Entity_Id) return Boolean;
    --  Returns True if a function has defaults for all but its first
    --  formal. Used in Ada 2005 mode to solve the syntactic ambiguity that
@@ -1307,6 +1310,9 @@ 
    procedure Reset_Analyzed_Flags (N : Node_Id);
    --  Reset the Analyzed flags in all nodes of the tree whose root is N
 
+   function Returns_Unconstrained_Type (Subp : Entity_Id) return Boolean;
+   --  Return true if Subp is a function that returns an unconstrained type
+
    function Safe_To_Capture_Value
      (N    : Node_Id;
       Ent  : Entity_Id;
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 185051)
+++ sem_res.adb	(working copy)
@@ -5611,9 +5611,18 @@ 
         and then Has_Pragma_Inline_Always (Nam)
         and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
         and then Present (Body_To_Inline (Unit_Declaration_Node (Nam)))
+        and then not Debug_Flag_Dot_K
       then
          null;
 
+      elsif Is_Inlined (Nam)
+        and then Has_Pragma_Inline (Nam)
+        and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
+        and then Present (Body_To_Inline (Unit_Declaration_Node (Nam)))
+        and then Debug_Flag_Dot_K
+      then
+         null;
+
       elsif Ekind (Nam) = E_Enumeration_Literal
         or else Is_Build_In_Place_Function (Nam)
         or else Is_Intrinsic_Subprogram (Nam)
Index: gnat1drv.adb
===================================================================
--- gnat1drv.adb	(revision 185051)
+++ gnat1drv.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -31,6 +31,7 @@ 
 with Elists;
 with Errout;   use Errout;
 with Exp_CG;
+with Exp_Ch6;  use Exp_Ch6;
 with Fmap;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
@@ -1160,6 +1161,7 @@ 
       Errout.Finalize (Last_Call => True);
       Errout.Output_Messages;
       List_Rep_Info;
+      List_Inlining_Info;
 
       --  Only write the library if the backend did not generate any error
       --  messages. Otherwise signal errors to the driver program so that
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 185051)
+++ exp_ch4.adb	(working copy)
@@ -3525,10 +3525,12 @@ 
       --  Processing for anonymous access-to-controlled types. These access
       --  types receive a special finalization master which appears in the
       --  declarations of the enclosing semantic unit. This expansion is done
-      --  now to ensure that any additional types generated by this routine
-      --  or Expand_Allocator_Expression inherit the proper type attributes.
+      --  now to ensure that any additional types generated by this routine or
+      --  Expand_Allocator_Expression inherit the proper type attributes.
 
-      if Ekind (PtrT) = E_Anonymous_Access_Type
+      if (Ekind (PtrT) = E_Anonymous_Access_Type
+            or else
+              (Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
         and then Needs_Finalization (Dtyp)
       then
          --  Anonymous access-to-controlled types allocate on the global pool.
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb	(revision 185053)
+++ exp_ch6.adb	(working copy)
@@ -51,6 +51,7 @@ 
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Output;   use Output;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
@@ -69,6 +70,7 @@ 
 with Sem_SCIL; use Sem_SCIL;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Targparm; use Targparm;
@@ -78,6 +80,10 @@ 
 
 package body Exp_Ch6 is
 
+   Inlined_Calls : Elist_Id := No_Elist;
+   Backend_Calls : Elist_Id := No_Elist;
+   --  List of frontend inlined calls and inline calls passed to the backend
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -1859,6 +1865,19 @@ 
       --  expression for the value of the actual, EF is the entity for the
       --  extra formal.
 
+      procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id);
+      --  Check and inline the body of Subp. Invoked when compiling with
+      --  optimizations enabled and Subp has pragma inline or inline always.
+      --  If the subprogram is a renaming, or if it is inherited, then Subp
+      --  references the renamed entity and Orig_Subp is the entity of the
+      --  call node N.
+
+      procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id);
+      --  Check and inline the body of Subp. Invoked when compiling without
+      --  optimizations and Subp has pragma inline always. If the subprogram is
+      --  a renaming, or if it is inherited, then Subp references the renamed
+      --  entity and Orig_Subp is the entity of the call node N.
+
       function Inherited_From_Formal (S : Entity_Id) return Entity_Id;
       --  Within an instance, a type derived from a non-tagged formal derived
       --  type inherits from the original parent, not from the actual. The
@@ -1868,6 +1887,9 @@ 
       --  convoluted tree traversal before setting the proper subprogram to be
       --  called.
 
+      function In_Unfrozen_Instance (E : Entity_Id) return Boolean;
+      --  Return true if E comes from an instance that is not yet frozen
+
       function Is_Direct_Deep_Call (Subp : Entity_Id) return Boolean;
       --  Determine if Subp denotes a non-dispatching call to a Deep routine
 
@@ -1942,6 +1964,228 @@ 
          end if;
       end Add_Extra_Actual;
 
+      ----------------
+      --  Do_Inline --
+      ----------------
+
+      procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id) is
+         Spec : constant Node_Id := Unit_Declaration_Node (Subp);
+
+         procedure Do_Backend_Inline;
+         --  Check that the call can be safely passed to the backend. If true
+         --  then register the enclosing unit of Subp to Inlined_Bodies so that
+         --  the body of Subp can be retrieved and analyzed by the backend.
+
+         procedure Register_Backend_Call (N : Node_Id);
+         --  Append N to the list Backend_Calls
+
+         -----------------------
+         -- Do_Backend_Inline --
+         -----------------------
+
+         procedure Do_Backend_Inline is
+         begin
+            --  No extra test needed for init subprograms since we know they
+            --  are available to the backend!
+
+            if Is_Init_Proc (Subp) then
+               Add_Inlined_Body (Subp);
+               Register_Backend_Call (Call_Node);
+
+            --  Verify that if the body to inline is located in the current
+            --  unit the inlining does not occur earlier. This avoids
+            --  order-of-elaboration problems in the back end.
+
+            elsif In_Same_Extended_Unit (Call_Node, Subp)
+              and then Nkind (Spec) = N_Subprogram_Declaration
+              and then Earlier_In_Extended_Unit
+                         (Loc, Sloc (Body_To_Inline (Spec)))
+            then
+               Error_Msg_NE
+                 ("cannot inline& (body not seen yet)?",
+                  Call_Node, Subp);
+
+            else
+               declare
+                  Backend_Inline : Boolean := True;
+
+               begin
+                  --  If we are compiling a package body that is not the
+                  --  main unit, it must be for inlining/instantiation
+                  --  purposes, in which case we inline the call to insure
+                  --  that the same temporaries are generated when compiling
+                  --  the body by itself. Otherwise link errors can occur.
+
+                  --  If the function being called is itself in the main
+                  --  unit, we cannot inline, because there is a risk of
+                  --  double elaboration and/or circularity: the inlining
+                  --  can make visible a private entity in the body of the
+                  --  main unit, that gigi will see before its sees its
+                  --  proper definition.
+
+                  if not (In_Extended_Main_Code_Unit (Call_Node))
+                    and then In_Package_Body
+                  then
+                     Backend_Inline :=
+                       not In_Extended_Main_Source_Unit (Subp);
+                  end if;
+
+                  if Backend_Inline then
+                     Add_Inlined_Body (Subp);
+                     Register_Backend_Call (Call_Node);
+                  end if;
+               end;
+            end if;
+         end Do_Backend_Inline;
+
+         ---------------------------
+         -- Register_Backend_Call --
+         ---------------------------
+
+         procedure Register_Backend_Call (N : Node_Id) is
+         begin
+            if Backend_Calls = No_Elist then
+               Backend_Calls := New_Elmt_List;
+            end if;
+
+            Append_Elmt (N, To => Backend_Calls);
+         end Register_Backend_Call;
+
+      --  Start of processing for Do_Inline
+
+      begin
+         --  Verify that the body to inline has already been seen
+
+         if No (Spec)
+           or else Nkind (Spec) /= N_Subprogram_Declaration
+           or else No (Body_To_Inline (Spec))
+         then
+            if Comes_From_Source (Subp)
+              and then Must_Inline (Subp)
+            then
+               Cannot_Inline
+                 ("cannot inline& (body not seen yet)?", Call_Node, Subp);
+
+            --  Let the back end handle it
+
+            else
+               Do_Backend_Inline;
+               return;
+            end if;
+
+         --  If this an inherited function that returns a private type, do not
+         --  inline if the full view is an unconstrained array, because such
+         --  calls cannot be inlined.
+
+         elsif Present (Orig_Subp)
+           and then Is_Array_Type (Etype (Orig_Subp))
+           and then not Is_Constrained (Etype (Orig_Subp))
+         then
+            Cannot_Inline
+              ("cannot inline& (unconstrained array)?", Call_Node, Subp);
+
+         else
+            Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
+         end if;
+      end Do_Inline;
+
+      ----------------------
+      -- Do_Inline_Always --
+      ----------------------
+
+      procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id) is
+         Spec    : constant Node_Id := Unit_Declaration_Node (Subp);
+         Body_Id : Entity_Id;
+
+      begin
+         if No (Spec)
+           or else Nkind (Spec) /= N_Subprogram_Declaration
+           or else No (Body_To_Inline (Spec))
+           or else Serious_Errors_Detected /= 0
+         then
+            return;
+         end if;
+
+         Body_Id := Corresponding_Body (Spec);
+
+         --  Verify that the body to inline has already been seen
+
+         if No (Body_Id)
+           or else not Analyzed (Body_Id)
+         then
+            Set_Is_Inlined (Subp, False);
+
+            if Comes_From_Source (Subp) then
+
+               --  Report a warning only if the call is located in the unit of
+               --  the called subprogram; otherwise it is an error.
+
+               if not In_Same_Extended_Unit (Call_Node, Subp) then
+                  Cannot_Inline
+                    ("cannot inline& (body not seen yet)", Call_Node, Subp,
+                     Is_Serious => True);
+
+               elsif In_Open_Scopes (Subp) then
+
+                  --  For backward compatibility we generate the same error
+                  --  or warning of the previous implementation. This will
+                  --  be changed when we definitely incorporate the new
+                  --  support ???
+
+                  if Front_End_Inlining
+                    and then Optimization_Level = 0
+                  then
+                     Error_Msg_N
+                       ("call to recursive subprogram cannot be inlined?",
+                        N);
+
+                  --  Do not emit error compiling runtime packages
+
+                  elsif Is_Predefined_File_Name
+                    (Unit_File_Name (Get_Source_Unit (Subp)))
+                  then
+                     Error_Msg_N
+                       ("call to recursive subprogram cannot be inlined?",
+                        N);
+
+                  else
+                     Error_Msg_N
+                       ("call to recursive subprogram cannot be inlined",
+                        N);
+                  end if;
+
+               else
+                  Cannot_Inline
+                    ("cannot inline& (body not seen yet)?", Call_Node, Subp);
+               end if;
+            end if;
+
+            return;
+
+         --  If this an inherited function that returns a private type, do not
+         --  inline if the full view is an unconstrained array, because such
+         --  calls cannot be inlined.
+
+         elsif Present (Orig_Subp)
+           and then Is_Array_Type (Etype (Orig_Subp))
+           and then not Is_Constrained (Etype (Orig_Subp))
+         then
+            Cannot_Inline
+              ("cannot inline& (unconstrained array)?", Call_Node, Subp);
+
+         --  If the called subprogram comes from an instance in the same
+         --  unit, and the instance is not yet frozen, inlining might
+         --  trigger order-of-elaboration problems.
+
+         elsif In_Unfrozen_Instance (Scope (Subp)) then
+            Cannot_Inline
+              ("cannot inline& (unfrozen instance)?", Call_Node, Subp);
+
+         else
+            Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
+         end if;
+      end Do_Inline_Always;
+
       ---------------------------
       -- Inherited_From_Formal --
       ---------------------------
@@ -2041,6 +2285,30 @@ 
          raise Program_Error;
       end Inherited_From_Formal;
 
+      --------------------------
+      -- In_Unfrozen_Instance --
+      --------------------------
+
+      function In_Unfrozen_Instance (E : Entity_Id) return Boolean is
+         S : Entity_Id := E;
+
+      begin
+         while Present (S)
+           and then S /= Standard_Standard
+         loop
+            if Is_Generic_Instance (S)
+              and then Present (Freeze_Node (S))
+              and then not Analyzed (Freeze_Node (S))
+            then
+               return True;
+            end if;
+
+            S := Scope (S);
+         end loop;
+
+         return False;
+      end In_Unfrozen_Instance;
+
       -------------------------
       -- Is_Direct_Deep_Call --
       -------------------------
@@ -3431,46 +3699,15 @@ 
             return;
          end if;
 
-         if Is_Inlined (Subp) then
+         --  Handle inlining (old semantics)
 
+         if Is_Inlined (Subp) and then not Debug_Flag_Dot_K then
+
             Inlined_Subprogram : declare
                Bod         : Node_Id;
                Must_Inline : Boolean := False;
                Spec        : constant Node_Id := Unit_Declaration_Node (Subp);
-               Scop        : constant Entity_Id := Scope (Subp);
 
-               function In_Unfrozen_Instance return Boolean;
-               --  If the subprogram comes from an instance in the same unit,
-               --  and the instance is not yet frozen, inlining might trigger
-               --  order-of-elaboration problems in gigi.
-
-               --------------------------
-               -- In_Unfrozen_Instance --
-               --------------------------
-
-               function In_Unfrozen_Instance return Boolean is
-                  S : Entity_Id;
-
-               begin
-                  S := Scop;
-                  while Present (S)
-                    and then S /= Standard_Standard
-                  loop
-                     if Is_Generic_Instance (S)
-                       and then Present (Freeze_Node (S))
-                       and then not Analyzed (Freeze_Node (S))
-                     then
-                        return True;
-                     end if;
-
-                     S := Scope (S);
-                  end loop;
-
-                  return False;
-               end In_Unfrozen_Instance;
-
-            --  Start of processing for Inlined_Subprogram
-
             begin
                --  Verify that the body to inline has already been seen, and
                --  that if the body is in the current unit the inlining does
@@ -3495,7 +3732,7 @@ 
                then
                   Must_Inline := False;
 
-               elsif In_Unfrozen_Instance then
+               elsif In_Unfrozen_Instance (Scope (Subp)) then
                   Must_Inline := False;
 
                else
@@ -3549,6 +3786,38 @@ 
                   end if;
                end if;
             end Inlined_Subprogram;
+
+         --  Handle inlining (new semantics)
+
+         elsif Is_Inlined (Subp) then
+            declare
+               Spec : constant Node_Id := Unit_Declaration_Node (Subp);
+
+            begin
+               if Optimization_Level > 0 then
+                  Do_Inline (Subp, Orig_Subp);
+
+               elsif Must_Inline (Subp) then
+                  if In_Extended_Main_Code_Unit (Call_Node)
+                    and then In_Same_Extended_Unit (Sloc (Spec), Loc)
+                    and then not Has_Completion (Subp)
+                  then
+                     Cannot_Inline
+                       ("cannot inline& (body not seen yet)?",
+                        Call_Node, Subp);
+
+                  else
+                     Do_Inline_Always (Subp, Orig_Subp);
+                  end if;
+               end if;
+
+               --  The call may have been inlined or may have been passed to
+               --  the backend. No further action needed if it was inlined.
+
+               if Nkind (N) /= N_Function_Call then
+                  return;
+               end if;
+            end;
          end if;
       end if;
 
@@ -3779,9 +4048,9 @@ 
       Remove_Side_Effects (N);
    end Expand_Ctrl_Function_Call;
 
-   --------------------------
+   -------------------------
    -- Expand_Inlined_Call --
-   --------------------------
+   -------------------------
 
    procedure Expand_Inlined_Call
     (N         : Node_Id;
@@ -3796,7 +4065,6 @@ 
                     Body_To_Inline (Unit_Declaration_Node (Subp));
 
       Blk      : Node_Id;
-      Bod      : Node_Id;
       Decl     : Node_Id;
       Decls    : constant List_Id := New_List;
       Exit_Lab : Entity_Id := Empty;
@@ -3810,7 +4078,7 @@ 
 
       Targ : Node_Id;
       --  The target of the call. If context is an assignment statement then
-      --  this is the left-hand side of the assignment. else it is a temporary
+      --  this is the left-hand side of the assignment; else it is a temporary
       --  to which the return value is assigned prior to rewriting the call.
 
       Targ1 : Node_Id;
@@ -3822,9 +4090,8 @@ 
       Return_Object : Entity_Id := Empty;
       --  Entity in declaration in an extended_return_statement
 
-      Is_Unc : constant Boolean :=
-                 Is_Array_Type (Etype (Subp))
-                   and then not Is_Constrained (Etype (Subp));
+      Is_Unc      : Boolean;
+      Is_Unc_Decl : Boolean;
       --  If the type returned by the function is unconstrained and the call
       --  can be inlined, special processing is required.
 
@@ -3845,6 +4112,12 @@ 
       --  Ada.Tags. If Debug_Generated_Code is true, suppress this change to
       --  simplify our own development.
 
+      procedure Reset_Dispatching_Calls (N : Node_Id);
+      --  In subtree N search for occurrences of dispatching calls that use the
+      --  Ada 2005 Object.Operation notation and the object is a formal of the
+      --  inlined subprogram; in all the found occurrences reset the entity
+      --  associated with Operation.
+
       procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id);
       --  If the function body is a single expression, replace call with
       --  expression, else insert block appropriately.
@@ -4023,6 +4296,13 @@ 
                   end if;
 
                   Set_Assignment_OK (Name (Assign));
+
+                  if No (Handled_Statement_Sequence (N)) then
+                     Set_Handled_Statement_Sequence (N,
+                       Make_Handled_Sequence_Of_Statements (Loc,
+                         Statements => New_List));
+                  end if;
+
                   Prepend (Assign,
                     Statements (Handled_Statement_Sequence (N)));
                end if;
@@ -4068,6 +4348,43 @@ 
 
       procedure Reset_Slocs is new Traverse_Proc (Process_Sloc);
 
+      ------------------------------
+      --  Reset_Dispatching_Calls --
+      ------------------------------
+
+      procedure Reset_Dispatching_Calls (N : Node_Id) is
+
+         function Do_Reset (N : Node_Id) return Traverse_Result;
+
+         --------------
+         -- Do_Check --
+         --------------
+
+         function Do_Reset (N : Node_Id) return Traverse_Result is
+         begin
+            if Nkind (N) = N_Procedure_Call_Statement
+              and then Nkind (Name (N)) = N_Selected_Component
+              and then Nkind (Prefix (Name (N))) = N_Identifier
+              and then Is_Formal (Entity (Prefix (Name (N))))
+              and then Is_Dispatching_Operation
+                         (Entity (Selector_Name (Name (N))))
+            then
+               Set_Entity (Selector_Name (Name (N)), Empty);
+            end if;
+
+            return OK;
+         end Do_Reset;
+
+         function Do_Reset_Calls is new Traverse_Func (Do_Reset);
+
+         --  Start of processing for Reset_Dispatching_Calls
+
+         Dummy : constant Traverse_Result := Do_Reset_Calls (N);
+         pragma Unreferenced (Dummy);
+      begin
+         null;
+      end Reset_Dispatching_Calls;
+
       ---------------------------
       -- Rewrite_Function_Call --
       ---------------------------
@@ -4138,10 +4455,20 @@ 
             end;
 
          elsif Nkind (Parent (N)) = N_Object_Declaration then
-            Set_Expression (Parent (N), Empty);
-            Insert_After (Parent (N), Blk);
 
-         elsif Is_Unc then
+            --  A call to a function which returns an unconstrained type
+            --  found in the expression initializing an object-declaration is
+            --  expanded into a procedure call which must be added after the
+            --  object declaration.
+
+            if Is_Unc_Decl and then Debug_Flag_Dot_K then
+               Insert_Action_After (Parent (N), Blk);
+            else
+               Set_Expression (Parent (N), Empty);
+               Insert_After (Parent (N), Blk);
+            end if;
+
+         elsif Is_Unc and then not Debug_Flag_Dot_K then
             Insert_Before (Parent (N), Blk);
          end if;
       end Rewrite_Function_Call;
@@ -4234,6 +4561,19 @@ 
    --  Start of processing for Expand_Inlined_Call
 
    begin
+      --  Initializations for old/new semantics
+
+      if not Debug_Flag_Dot_K then
+         Is_Unc      := Is_Array_Type (Etype (Subp))
+                          and then not Is_Constrained (Etype (Subp));
+         Is_Unc_Decl := False;
+      else
+         Is_Unc      := Returns_Unconstrained_Type (Subp)
+                          and then Optimization_Level > 0;
+         Is_Unc_Decl := Nkind (Parent (N)) = N_Object_Declaration
+                          and then Is_Unc;
+      end if;
+
       --  Check for an illegal attempt to inline a recursive procedure. If the
       --  subprogram has parameters this is detected when trying to supply a
       --  binding for parameters that already have one. For parameterless
@@ -4258,6 +4598,7 @@ 
         and then
           Nkind (First (Statements (Handled_Statement_Sequence (Orig_Bod))))
             = N_Extended_Return_Statement
+        and then not Debug_Flag_Dot_K
       then
          return;
       end if;
@@ -4281,6 +4622,14 @@ 
          return;
       end if;
 
+      --  Register the call in the list of inlined calls
+
+      if Inlined_Calls = No_Elist then
+         Inlined_Calls := New_Elmt_List;
+      end if;
+
+      Append_Elmt (N, To => Inlined_Calls);
+
       --  Use generic machinery to copy body of inlined subprogram, as if it
       --  were an instantiation, resetting source locations appropriately, so
       --  that nested inlined calls appear in the main unit.
@@ -4288,32 +4637,137 @@ 
       Save_Env (Subp, Empty);
       Set_Copied_Sloc_For_Inlined_Body (N, Defining_Entity (Orig_Bod));
 
-      Bod := Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True);
-      Blk :=
-        Make_Block_Statement (Loc,
-          Declarations => Declarations (Bod),
-          Handled_Statement_Sequence => Handled_Statement_Sequence (Bod));
+      --  Old semantics
 
-      if No (Declarations (Bod)) then
-         Set_Declarations (Blk, New_List);
-      end if;
+      if not Debug_Flag_Dot_K then
+         declare
+            Bod : Node_Id;
 
-      --  For the unconstrained case, capture the name of the local variable
-      --  that holds the result. This must be the first declaration in the
-      --  block, because its bounds cannot depend on local variables. Otherwise
-      --  there is no way to declare the result outside of the block. Needless
-      --  to say, in general the bounds will depend on the actuals in the call.
+         begin
+            Bod := Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True);
+            Blk :=
+              Make_Block_Statement (Loc,
+                Declarations => Declarations (Bod),
+                Handled_Statement_Sequence =>
+                  Handled_Statement_Sequence (Bod));
 
-      --  If the context is an assignment statement, as is the case for the
-      --  expansion of an extended return, the left-hand side provides bounds
-      --  even if the return type is unconstrained.
+            if No (Declarations (Bod)) then
+               Set_Declarations (Blk, New_List);
+            end if;
 
-      if Is_Unc then
-         if Nkind (Parent (N)) /= N_Assignment_Statement then
-            Targ1 := Defining_Identifier (First (Declarations (Blk)));
-         else
-            Targ1 := Name (Parent (N));
-         end if;
+            --  For the unconstrained case, capture the name of the local
+            --  variable that holds the result. This must be the first
+            --  declaration in the block, because its bounds cannot depend
+            --  on local variables. Otherwise there is no way to declare the
+            --  result outside of the block. Needless to say, in general the
+            --  bounds will depend on the actuals in the call.
+
+            --  If the context is an assignment statement, as is the case
+            --  for the expansion of an extended return, the left-hand side
+            --  provides bounds even if the return type is unconstrained.
+
+            if Is_Unc then
+               declare
+                  First_Decl : Node_Id;
+
+               begin
+                  First_Decl := First (Declarations (Blk));
+
+                  if Nkind (First_Decl) /= N_Object_Declaration then
+                     return;
+                  end if;
+
+                  if Nkind (Parent (N)) /= N_Assignment_Statement then
+                     Targ1 := Defining_Identifier (First_Decl);
+                  else
+                     Targ1 := Name (Parent (N));
+                  end if;
+               end;
+            end if;
+         end;
+
+      --  New semantics
+
+      else
+         declare
+            Bod : Node_Id;
+
+         begin
+            --  General case
+
+            if not Is_Unc then
+               Bod :=
+                 Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True);
+               Blk :=
+                 Make_Block_Statement (Loc,
+                                       Declarations => Declarations (Bod),
+                                       Handled_Statement_Sequence =>
+                                         Handled_Statement_Sequence (Bod));
+
+            --  Inline a call to a function that returns an unconstrained type.
+            --  The semantic analyzer checked that frontend-inlined functions
+            --  returning unconstrained types have no declarations and have
+            --  a single extended return statement. As part of its processing
+            --  the function was split in two subprograms: a procedure P and
+            --  a function F that has a block with a call to procedure P (see
+            --  Split_Unconstrained_Function).
+
+            else
+               pragma Assert
+                 (Nkind
+                    (First
+                       (Statements (Handled_Statement_Sequence (Orig_Bod))))
+                  = N_Block_Statement);
+
+               declare
+                  Blk_Stmt    : constant Node_Id :=
+                    First
+                      (Statements
+                           (Handled_Statement_Sequence (Orig_Bod)));
+                  First_Stmt  : constant Node_Id :=
+                    First
+                      (Statements
+                           (Handled_Statement_Sequence (Blk_Stmt)));
+                  Second_Stmt : constant Node_Id := Next (First_Stmt);
+
+               begin
+                  pragma Assert
+                    (Nkind (First_Stmt) = N_Procedure_Call_Statement
+                       and then Nkind (Second_Stmt) = Sinfo.N_Return_Statement
+                       and then No (Next (Second_Stmt)));
+
+                  Bod :=
+                    Copy_Generic_Node
+                      (First
+                         (Statements (Handled_Statement_Sequence (Orig_Bod))),
+                       Empty, Instantiating => True);
+                  Blk := Bod;
+
+                  --  Capture the name of the local variable that holds the
+                  --  result. This must be the first declaration in the block,
+                  --  because its bounds cannot depend on local variables.
+                  --  Otherwise there is no way to declare the result outside
+                  --  of the block. Needless to say, in general the bounds will
+                  --  depend on the actuals in the call.
+
+                  if Nkind (Parent (N)) /= N_Assignment_Statement then
+                     Targ1 := Defining_Identifier (First (Declarations (Blk)));
+
+                  --  If the context is an assignment statement, as is the case
+                  --  for the expansion of an extended return, the left-hand
+                  --  side provides bounds even if the return type is
+                  --  unconstrained.
+
+                  else
+                     Targ1 := Name (Parent (N));
+                  end if;
+               end;
+            end if;
+
+            if No (Declarations (Bod)) then
+               Set_Declarations (Blk, New_List);
+            end if;
+         end;
       end if;
 
       --  If this is a derived function, establish the proper return type
@@ -4483,6 +4937,16 @@ 
          then
             Targ := Defining_Identifier (Parent (N));
 
+         --  New semantics: In an object declaration avoid an extra copy
+         --  of the result of a call to an inlined function that returns
+         --  an unconstrained type
+
+         elsif Debug_Flag_Dot_K
+           and then Nkind (Parent (N)) = N_Object_Declaration
+           and then Is_Unc
+         then
+            Targ := Defining_Identifier (Parent (N));
+
          else
             --  Replace call with temporary and create its declaration
 
@@ -4523,6 +4987,80 @@ 
 
       Insert_Actions (N, Decls);
 
+      if Is_Unc_Decl then
+
+         --  Special management for inlining a call to a function that returns
+         --  an unconstrained type and initializes an object declaration: we
+         --  avoid generating undesired extra calls and goto statements.
+
+         --     Given:
+         --                 function Func (...) return ...
+         --                 begin
+         --                    declare
+         --                       Result : String (1 .. 4);
+         --                    begin
+         --                       Proc (Result, ...);
+         --                       return Result;
+         --                    end;
+         --                 end F;
+
+         --                 Result : String := Func (...);
+
+         --     Replace this object declaration by:
+
+         --                 Result : String (1 .. 4);
+         --                 Proc (Result, ...);
+
+         Remove_Homonym (Targ);
+
+         Decl :=
+           Make_Object_Declaration
+             (Loc,
+              Defining_Identifier => Targ,
+              Object_Definition   =>
+                New_Copy_Tree (Object_Definition (Parent (Targ1))));
+         Replace_Formals (Decl);
+         Rewrite (Parent (N), Decl);
+         Analyze (Parent (N));
+
+         --  Avoid spurious warnings since we know that this declaration is
+         --  referenced by the procedure call.
+
+         Set_Never_Set_In_Source (Targ, False);
+
+         --  Remove the local declaration of the extended return stmt from the
+         --  inlined code
+
+         Remove (Parent (Targ1));
+
+         --  Update the reference to the result (since we have rewriten the
+         --  object declaration)
+
+         declare
+            Blk_Call_Stmt : Node_Id;
+
+         begin
+            --  Capture the call to the procedure
+
+            Blk_Call_Stmt :=
+              First (Statements (Handled_Statement_Sequence (Blk)));
+            pragma Assert
+              (Nkind (Blk_Call_Stmt) = N_Procedure_Call_Statement);
+
+            Remove (First (Parameter_Associations (Blk_Call_Stmt)));
+            Prepend_To (Parameter_Associations (Blk_Call_Stmt),
+              New_Reference_To (Targ, Loc));
+         end;
+
+         --  Remove the return statement
+
+         pragma Assert
+           (Nkind (Last (Statements (Handled_Statement_Sequence (Blk))))
+            = Sinfo.N_Return_Statement);
+
+         Remove (Last (Statements (Handled_Statement_Sequence (Blk))));
+      end if;
+
       --  Traverse the tree and replace formals with actuals or their thunks.
       --  Attach block to tree before analysis and rewriting.
 
@@ -4533,8 +5071,15 @@ 
          Reset_Slocs (Blk);
       end if;
 
-      if Present (Exit_Lab) then
+      if Is_Unc_Decl then
 
+         --  No action needed since the return statement has been already
+         --  removed!
+
+         null;
+
+      elsif Present (Exit_Lab) then
+
          --  If the body was a single expression, the single return statement
          --  and the corresponding label are useless.
 
@@ -4564,8 +5109,18 @@ 
          if Is_Predef then
             declare
                Style : constant Boolean := Style_Check;
+
             begin
                Style_Check := False;
+
+               --  Search for dispatching calls that use the Object.Operation
+               --  notation using an Object that is a parameter of the inlined
+               --  function. We reset the decoration of Operation to force
+               --  the reanalysis of the inlined dispatching call because
+               --  the actual object has been inlined.
+
+               Reset_Dispatching_Calls (Blk);
+
                Analyze (Blk, Suppress => All_Checks);
                Style_Check := Style;
             end;
@@ -4583,11 +5138,14 @@ 
       else
          Rewrite_Function_Call (N, Blk);
 
+         if Is_Unc_Decl then
+            null;
+
          --  For the unconstrained case, the replacement of the call has been
          --  made prior to the complete analysis of the generated declarations.
          --  Propagate the proper type now.
 
-         if Is_Unc then
+         elsif Is_Unc then
             if Nkind (N) = N_Identifier then
                Set_Etype (N, Etype (Entity (N)));
             else
@@ -5566,8 +6124,8 @@ 
       --  Alpha/VMS, no-op everywhere else).
       --  Comes_From_Source intercepts recursive expansion.
 
-      if Vax_Float (Etype (N))
-        and then Nkind (N) = N_Function_Call
+      if Nkind (N) = N_Function_Call
+        and then Vax_Float (Etype (N))
         and then Present (Name (N))
         and then Present (Entity (Name (N)))
         and then Has_Foreign_Convention (Entity (Name (N)))
@@ -8642,4 +9200,75 @@ 
       end if;
    end Needs_Result_Accessibility_Level;
 
+   ------------------------
+   -- List_Inlining_Info --
+   ------------------------
+
+   procedure List_Inlining_Info is
+      Elmt  : Elmt_Id;
+      Nod   : Node_Id;
+      Count : Nat;
+
+   begin
+      if not Debug_Flag_Dot_J then
+         return;
+      end if;
+
+      --  Generate listing of calls inlined by the frontend
+
+      if Present (Inlined_Calls) then
+         Count := 0;
+         Elmt  := First_Elmt (Inlined_Calls);
+         while Present (Elmt) loop
+            Nod := Node (Elmt);
+
+            if In_Extended_Main_Code_Unit (Nod) then
+               Count := Count + 1;
+
+               if Count = 1 then
+                  Write_Str ("Listing of frontend inlined calls");
+                  Write_Eol;
+               end if;
+
+               Write_Str ("  ");
+               Write_Int (Count);
+               Write_Str (":");
+               Write_Location (Sloc (Nod));
+               Write_Str (":");
+               Output.Write_Eol;
+            end if;
+
+            Next_Elmt (Elmt);
+         end loop;
+      end if;
+
+      --  Generate listing of calls passed to the backend
+
+      if Present (Backend_Calls) then
+         Count := 0;
+
+         Elmt := First_Elmt (Backend_Calls);
+         while Present (Elmt) loop
+            Nod := Node (Elmt);
+
+            if In_Extended_Main_Code_Unit (Nod) then
+               Count := Count + 1;
+
+               if Count = 1 then
+                  Write_Str ("Listing of inlined calls passed to the backend");
+                  Write_Eol;
+               end if;
+
+               Write_Str ("  ");
+               Write_Int (Count);
+               Write_Str (":");
+               Write_Location (Sloc (Nod));
+               Output.Write_Eol;
+            end if;
+
+            Next_Elmt (Elmt);
+         end loop;
+      end if;
+   end List_Inlining_Info;
+
 end Exp_Ch6;
Index: exp_ch6.ads
===================================================================
--- exp_ch6.ads	(revision 185051)
+++ exp_ch6.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -157,6 +157,10 @@ 
    --  Predicate to recognize stubbed procedures and null procedures, which
    --  can be inlined unconditionally in all cases.
 
+   procedure List_Inlining_Info;
+   --  Generate listing of calls inlined by the frontend plus listing of
+   --  calls to inline subprograms passed to the backend.
+
    procedure Make_Build_In_Place_Call_In_Allocator
      (Allocator     : Node_Id;
       Function_Call : Node_Id);
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 185053)
+++ sem_ch6.adb	(working copy)
@@ -132,6 +132,15 @@ 
    function Can_Override_Operator (Subp : Entity_Id) return Boolean;
    --  Returns true if Subp can override a predefined operator.
 
+   procedure Check_And_Build_Body_To_Inline
+     (N       : Node_Id;
+      Spec_Id : Entity_Id;
+      Body_Id : Entity_Id);
+   --  Spec_Id and Body_Id are the entities of the specification and body of
+   --  the subprogram body N. If N can be inlined by the frontend (supported
+   --  cases documented in Check_Body_To_Inline) then build the body-to-inline
+   --  associated with N and attach it to the declaration node of Spec_Id.
+
    procedure Check_Conformance
      (New_Id                   : Entity_Id;
       Old_Id                   : Entity_Id;
@@ -2514,6 +2523,7 @@ 
 
       if Comes_From_Source (Body_Id)
         and then Serious_Errors_Detected = 0
+        and then not Debug_Flag_Dot_K
       then
          P_Ent := Body_Id;
          loop
@@ -2534,6 +2544,8 @@ 
          end loop;
       end if;
 
+      --  Look ahead to recognize a pragma inline that appears after the body
+
       Check_Inline_Pragma (Spec_Id);
 
       --  Deal with special case of a fully private operation in the body of
@@ -2842,14 +2854,31 @@ 
 
       if Nkind (N) = N_Subprogram_Body_Stub then
          return;
+      end if;
 
-      elsif Present (Spec_Id)
-        and then Expander_Active
-        and then
-          (Has_Pragma_Inline_Always (Spec_Id)
-             or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining))
+      --  Handle frontend inlining. There is no need to prepare us for inlining
+      --  if we will not generate the code.
+
+      --  Old semantics
+
+      if not Debug_Flag_Dot_K then
+         if Present (Spec_Id)
+           and then Expander_Active
+           and then
+             (Has_Pragma_Inline_Always (Spec_Id)
+                or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining))
+         then
+            Build_Body_To_Inline (N, Spec_Id);
+         end if;
+
+      --  New semantics
+
+      elsif Expander_Active
+        and then Serious_Errors_Detected = 0
+        and then Present (Spec_Id)
+        and then Has_Pragma_Inline (Spec_Id)
       then
-         Build_Body_To_Inline (N, Spec_Id);
+         Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id);
       end if;
 
       --  Ada 2005 (AI-262): In library subprogram bodies, after the analysis
@@ -4086,29 +4115,1224 @@ 
    -- Cannot_Inline --
    -------------------
 
-   procedure Cannot_Inline (Msg : String; N : Node_Id; Subp : Entity_Id) is
+   procedure Cannot_Inline
+     (Msg        : String;
+      N          : Node_Id;
+      Subp       : Entity_Id;
+      Is_Serious : Boolean := False) is
    begin
-      --  Do not emit warning if this is a predefined unit which is not the
-      --  main unit. With validity checks enabled, some predefined subprograms
-      --  may contain nested subprograms and become ineligible for inlining.
+      pragma Assert (Msg (Msg'Last) = '?');
 
-      if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Subp)))
-        and then not In_Extended_Main_Source_Unit (Subp)
-      then
-         null;
+      --  Old semantics
 
-      elsif Has_Pragma_Inline_Always (Subp) then
+      if not Debug_Flag_Dot_K then
 
-         --  Remove last character (question mark) to make this into an error,
-         --  because the Inline_Always pragma cannot be obeyed.
+         --  Do not emit warning if this is a predefined unit which is not
+         --  the main unit. With validity checks enabled, some predefined
+         --  subprograms may contain nested subprograms and become ineligible
+         --  for inlining.
 
+         if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Subp)))
+           and then not In_Extended_Main_Source_Unit (Subp)
+         then
+            null;
+
+         elsif Has_Pragma_Inline_Always (Subp) then
+
+            --  Remove last character (question mark) to make this into an
+            --  error, because the Inline_Always pragma cannot be obeyed.
+
+            Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
+
+         elsif Ineffective_Inline_Warnings then
+            Error_Msg_NE (Msg, N, Subp);
+         end if;
+
+         return;
+
+      --  New semantics
+
+      elsif Is_Serious then
+
+         --  Remove last character (question mark) to make this into an error.
+
          Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
 
-      elsif Ineffective_Inline_Warnings then
-         Error_Msg_NE (Msg, N, Subp);
+      elsif Optimization_Level = 0 then
+
+         --  Do not emit warning if this is a predefined unit which is not
+         --  the main unit. This behavior is currently provided for backward
+         --  compatibility but it will be removed when we enforce the
+         --  strictness of the new rules.
+
+         if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Subp)))
+           and then not In_Extended_Main_Source_Unit (Subp)
+         then
+            null;
+
+         elsif Has_Pragma_Inline_Always (Subp) then
+
+            --  Emit a warning if this is a call to a runtime subprogram
+            --  which is located inside a generic. Previously this call
+            --  was silently skipped!
+
+            if Is_Generic_Instance (Subp) then
+               declare
+                  Gen_P : constant Entity_Id := Generic_Parent (Parent (Subp));
+               begin
+                  if Is_Predefined_File_Name
+                    (Unit_File_Name (Get_Source_Unit (Gen_P)))
+                  then
+                     Set_Is_Inlined (Subp, False);
+                     Error_Msg_NE (Msg, N, Subp);
+                     return;
+                  end if;
+               end;
+            end if;
+
+            --  Remove last character (question mark) to make this into an
+            --  error, because the Inline_Always pragma cannot be obeyed.
+
+            Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
+
+         else pragma Assert (Front_End_Inlining);
+            Set_Is_Inlined (Subp, False);
+
+            --  When inlining cannot take place we must issue an error.
+            --  For backward compatibility we still report a warning.
+
+            if Ineffective_Inline_Warnings then
+               Error_Msg_NE (Msg, N, Subp);
+            end if;
+         end if;
+
+      --  Compiling with optimizations enabled it is too early to report
+      --  problems since the backend may still perform inlining. In order
+      --  to report unhandled inlinings the program must be compiled with
+      --  -Winline and the error is reported by the backend.
+
+      else
+         null;
       end if;
    end Cannot_Inline;
 
+   ------------------------------------
+   -- Check_And_Build_Body_To_Inline --
+   ------------------------------------
+
+   procedure Check_And_Build_Body_To_Inline
+     (N       : Node_Id;
+      Spec_Id : Entity_Id;
+      Body_Id : Entity_Id)
+   is
+      procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id);
+      --  Use generic machinery to build an unexpanded body for the subprogram.
+      --  This body is subsequently used for inline expansions at call sites.
+
+      function Can_Split_Unconstrained_Function (N : Node_Id) return Boolean;
+      --  Return true if the function body N has no local declarations and its
+      --  unique statement is a single extended return statement with a handled
+      --  statements sequence.
+
+      function Check_Body_To_Inline
+        (N    : Node_Id;
+         Subp : Entity_Id) return Boolean;
+      --  N is the N_Subprogram_Body of Subp. Return true if Subp can be
+      --  inlined by the frontend. These are the rules:
+      --    * At -O0 use fe inlining when inline_always is specified except if
+      --      the function returns a controlled type.
+      --    * At other optimization levels use the fe inlining for both inline
+      --      and inline_always in the following cases:
+      --       - function returning a known at compile time constant
+      --       - function returning a call to an intrinsic function
+      --       - function returning an unconstrained type (see Can_Split
+      --         Unconstrained_Function).
+      --       - function returning a call to a frontend-inlined function
+      --      Use the back-end mechanism otherwise
+      --
+      --  In addition, in the following cases the function cannot be inlined by
+      --  the frontend:
+      --    - functions that uses the secondary stack
+      --    - functions that have declarations of:
+      --         - Concurrent types
+      --         - Packages
+      --         - Instantiations
+      --         - Subprograms
+      --    - functions that have some of the following statements:
+      --         - abort
+      --         - asynchronous-select
+      --         - conditional-entry-call
+      --         - delay-relative
+      --         - delay-until
+      --         - selective-accept
+      --         - timed-entry-call
+      --    - functions that have exception handlers
+      --    - functions that have some enclosing body containing instantiations
+      --      that appear before the corresponding generic body.
+
+      procedure Generate_Body_To_Inline
+        (N              : Node_Id;
+         Body_To_Inline : out Node_Id);
+      --  Generate a parameterless duplicate of subprogram body N. Occurrences
+      --  of pragmas referencing the formals are removed since they have no
+      --  meaning when the body is inlined and the formals are rewritten (the
+      --  analysis of the non-inlined body will handle these pragmas properly).
+      --  A new internal name is associated with Body_To_Inline.
+
+      procedure Preanalyze (N : Node_Id);
+      --  Performs a pre-analysis of node N. During pre-analysis no expansion
+      --  is carried out for N or its children. For more info on pre-analysis
+      --  read the spec of Sem.
+
+      procedure Split_Unconstrained_Function
+        (N       : Node_Id;
+         Spec_Id : Entity_Id);
+      --  N is an inlined function body that returns an unconstrained type and
+      --  has a single extended return statement. Split N in two subprograms:
+      --  a procedure P' and a function F'. The formals of P' duplicate the
+      --  formals of N plus an extra formal which is used return a value;
+      --  its body is composed by the declarations and list of statements
+      --  of the extended return statement of N.
+
+      --------------------------
+      -- Build_Body_To_Inline --
+      --------------------------
+
+      procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id) is
+         Decl            : constant Node_Id := Unit_Declaration_Node (Spec_Id);
+         Original_Body   : Node_Id;
+         Body_To_Analyze : Node_Id;
+
+      begin
+         pragma Assert (Current_Scope = Spec_Id);
+
+         --  Within an instance, the body to inline must be treated as a nested
+         --  generic, so that the proper global references are preserved. We
+         --  do not do this at the library level, because it is not needed, and
+         --  furthermore this causes trouble if front end inlining is activated
+         --  (-gnatN).
+
+         if In_Instance
+           and then Scope (Current_Scope) /= Standard_Standard
+         then
+            Save_Env (Scope (Current_Scope), Scope (Current_Scope));
+         end if;
+
+         --  We need to capture references to the formals in order
+         --  to substitute the actuals at the point of inlining, i.e.
+         --  instantiation. To treat the formals as globals to the body to
+         --  inline, we nest it within a dummy parameterless subprogram,
+         --  declared within the real one.
+
+         Generate_Body_To_Inline (N, Original_Body);
+         Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False);
+
+         --  Set return type of function, which is also global and does not
+         --  need to be resolved.
+
+         if Ekind (Spec_Id) = E_Function then
+            Set_Result_Definition (Specification (Body_To_Analyze),
+              New_Occurrence_Of (Etype (Spec_Id), Sloc (N)));
+         end if;
+
+         if No (Declarations (N)) then
+            Set_Declarations (N, New_List (Body_To_Analyze));
+         else
+            Append_To (Declarations (N), Body_To_Analyze);
+         end if;
+
+         Preanalyze (Body_To_Analyze);
+
+         Push_Scope (Defining_Entity (Body_To_Analyze));
+         Save_Global_References (Original_Body);
+         End_Scope;
+         Remove (Body_To_Analyze);
+
+         --  Restore environment if previously saved
+
+         if In_Instance
+           and then Scope (Current_Scope) /= Standard_Standard
+         then
+            Restore_Env;
+         end if;
+
+         pragma Assert (No (Body_To_Inline (Decl)));
+         Set_Body_To_Inline (Decl, Original_Body);
+         Set_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id));
+      end Build_Body_To_Inline;
+
+      --------------------------
+      -- Check_Body_To_Inline --
+      --------------------------
+
+      function Check_Body_To_Inline
+        (N    : Node_Id;
+         Subp : Entity_Id) return Boolean
+      is
+         Max_Size   : constant := 10;
+         Stat_Count : Integer := 0;
+
+         function Has_Excluded_Declaration (Decls : List_Id) return Boolean;
+         --  Check for declarations that make inlining not worthwhile
+
+         function Has_Excluded_Statement   (Stats : List_Id) return Boolean;
+         --  Check for statements that make inlining not worthwhile: any
+         --  tasking statement, nested at any level. Keep track of total
+         --  number of elementary statements, as a measure of acceptable size.
+
+         function Has_Pending_Instantiation return Boolean;
+         --  Return True if some enclosing body contains instantiations that
+         --  appear before the corresponding generic body.
+
+         function Returns_Compile_Time_Constant (N : Node_Id) return Boolean;
+         --  Return True if all the return statements of the function body N
+         --  are simple return statements and return a compile time constant
+
+         function Returns_Intrinsic_Function_Call (N : Node_Id) return Boolean;
+         --  Return True if all the return statements of the function body N
+         --  are simple return statements and return an intrinsic function call
+
+         function Uses_Secondary_Stack (N : Node_Id) return Boolean;
+         --  If the body of the subprogram includes a call that returns an
+         --  unconstrained type, the secondary stack is involved, and it
+         --  is not worth inlining.
+
+         ------------------------------
+         -- Has_Excluded_Declaration --
+         ------------------------------
+
+         function Has_Excluded_Declaration (Decls : List_Id) return Boolean is
+            D : Node_Id;
+
+            function Is_Unchecked_Conversion (D : Node_Id) return Boolean;
+            --  Nested subprograms make a given body ineligible for inlining,
+            --  but we make an exception for instantiations of unchecked
+            --  conversion. The body has not been analyzed yet, so check the
+            --  name, and verify that the visible entity with that name is the
+            --  predefined unit.
+
+            -----------------------------
+            -- Is_Unchecked_Conversion --
+            -----------------------------
+
+            function Is_Unchecked_Conversion (D : Node_Id) return Boolean is
+               Id   : constant Node_Id := Name (D);
+               Conv : Entity_Id;
+
+            begin
+               if Nkind (Id) = N_Identifier
+                 and then Chars (Id) = Name_Unchecked_Conversion
+               then
+                  Conv := Current_Entity (Id);
+
+               elsif Nkind_In (Id, N_Selected_Component, N_Expanded_Name)
+                 and then Chars (Selector_Name (Id))
+                            = Name_Unchecked_Conversion
+               then
+                  Conv := Current_Entity (Selector_Name (Id));
+               else
+                  return False;
+               end if;
+
+               return Present (Conv)
+                 and then Is_Predefined_File_Name
+                            (Unit_File_Name (Get_Source_Unit (Conv)))
+                 and then Is_Intrinsic_Subprogram (Conv);
+            end Is_Unchecked_Conversion;
+
+         --  Start of processing for Has_Excluded_Declaration
+
+         begin
+            D := First (Decls);
+            while Present (D) loop
+               if (Nkind (D) = N_Function_Instantiation
+                   and then not Is_Unchecked_Conversion (D))
+                 or else Nkind_In (D, N_Protected_Type_Declaration,
+                                   N_Package_Declaration,
+                                   N_Package_Instantiation,
+                                   N_Subprogram_Body,
+                                   N_Procedure_Instantiation,
+                                   N_Task_Type_Declaration)
+               then
+                  Cannot_Inline
+                    ("cannot inline & (non-allowed declaration)?", D, Subp);
+
+                  return True;
+               end if;
+
+               Next (D);
+            end loop;
+
+            return False;
+         end Has_Excluded_Declaration;
+
+         ----------------------------
+         -- Has_Excluded_Statement --
+         ----------------------------
+
+         function Has_Excluded_Statement (Stats : List_Id) return Boolean is
+            S : Node_Id;
+            E : Node_Id;
+
+         begin
+            S := First (Stats);
+            while Present (S) loop
+               Stat_Count := Stat_Count + 1;
+
+               if Nkind_In (S, N_Abort_Statement,
+                            N_Asynchronous_Select,
+                            N_Conditional_Entry_Call,
+                            N_Delay_Relative_Statement,
+                            N_Delay_Until_Statement,
+                            N_Selective_Accept,
+                            N_Timed_Entry_Call)
+               then
+                  Cannot_Inline
+                    ("cannot inline & (non-allowed statement)?", S, Subp);
+                  return True;
+
+               elsif Nkind (S) = N_Block_Statement then
+                  if Present (Declarations (S))
+                    and then Has_Excluded_Declaration (Declarations (S))
+                  then
+                     return True;
+
+                  elsif Present (Handled_Statement_Sequence (S)) then
+                     if Present
+                       (Exception_Handlers (Handled_Statement_Sequence (S)))
+                     then
+                        Cannot_Inline
+                          ("cannot inline& (exception handler)?",
+                           First (Exception_Handlers
+                             (Handled_Statement_Sequence (S))),
+                           Subp);
+                        return True;
+
+                     elsif Has_Excluded_Statement
+                       (Statements (Handled_Statement_Sequence (S)))
+                     then
+                        return True;
+                     end if;
+                  end if;
+
+               elsif Nkind (S) = N_Case_Statement then
+                  E := First (Alternatives (S));
+                  while Present (E) loop
+                     if Has_Excluded_Statement (Statements (E)) then
+                        return True;
+                     end if;
+
+                     Next (E);
+                  end loop;
+
+               elsif Nkind (S) = N_If_Statement then
+                  if Has_Excluded_Statement (Then_Statements (S)) then
+                     return True;
+                  end if;
+
+                  if Present (Elsif_Parts (S)) then
+                     E := First (Elsif_Parts (S));
+                     while Present (E) loop
+                        if Has_Excluded_Statement (Then_Statements (E)) then
+                           return True;
+                        end if;
+                        Next (E);
+                     end loop;
+                  end if;
+
+                  if Present (Else_Statements (S))
+                    and then Has_Excluded_Statement (Else_Statements (S))
+                  then
+                     return True;
+                  end if;
+
+               elsif Nkind (S) = N_Loop_Statement
+                 and then Has_Excluded_Statement (Statements (S))
+               then
+                  return True;
+
+               elsif Nkind (S) = N_Extended_Return_Statement then
+                  if Present (Handled_Statement_Sequence (S))
+                    and then
+                      Has_Excluded_Statement
+                        (Statements (Handled_Statement_Sequence (S)))
+                  then
+                     return True;
+
+                  elsif Present (Handled_Statement_Sequence (S))
+                    and then
+                      Present (Exception_Handlers
+                               (Handled_Statement_Sequence (S)))
+                  then
+                     Cannot_Inline
+                       ("cannot inline& (exception handler)?",
+                        First (Exception_Handlers
+                          (Handled_Statement_Sequence (S))),
+                        Subp);
+                     return True;
+                  end if;
+               end if;
+
+               Next (S);
+            end loop;
+
+            return False;
+         end Has_Excluded_Statement;
+
+         -------------------------------
+         -- Has_Pending_Instantiation --
+         -------------------------------
+
+         function Has_Pending_Instantiation return Boolean is
+            S : Entity_Id;
+
+         begin
+            S := Current_Scope;
+            while Present (S) loop
+               if Is_Compilation_Unit (S)
+                 or else Is_Child_Unit (S)
+               then
+                  return False;
+
+               elsif Ekind (S) = E_Package
+                 and then Has_Forward_Instantiation (S)
+               then
+                  return True;
+               end if;
+
+               S := Scope (S);
+            end loop;
+
+            return False;
+         end Has_Pending_Instantiation;
+
+         ------------------------------------
+         --  Returns_Compile_Time_Constant --
+         ------------------------------------
+
+         function Returns_Compile_Time_Constant (N : Node_Id) return Boolean is
+
+            function Check_Return (N : Node_Id) return Traverse_Result;
+
+            ------------------
+            -- Check_Return --
+            ------------------
+
+            function Check_Return (N : Node_Id) return Traverse_Result is
+            begin
+               if Nkind (N) = N_Extended_Return_Statement then
+                  return Abandon;
+
+               elsif Nkind (N) = N_Simple_Return_Statement then
+                  if Present (Expression (N)) then
+                     declare
+                        Orig_Expr : constant Node_Id :=
+                          Original_Node (Expression (N));
+
+                     begin
+                        if Nkind_In (Orig_Expr, N_Integer_Literal,
+                                     N_Real_Literal,
+                                     N_Character_Literal)
+                        then
+                           return OK;
+
+                        elsif Is_Entity_Name (Orig_Expr)
+                          and then Ekind (Entity (Orig_Expr)) = E_Constant
+                          and then Is_Static_Expression (Orig_Expr)
+                        then
+                           return OK;
+                        else
+                           return Abandon;
+                        end if;
+                     end;
+
+                  --  Expression has wrong form
+
+                  else
+                     return Abandon;
+                  end if;
+
+               --  Continue analyzing statements
+
+               else
+                  return OK;
+               end if;
+            end Check_Return;
+
+            function Check_All_Returns is new Traverse_Func (Check_Return);
+
+            --  Start of processing for Returns_Compile_Time_Constant
+
+         begin
+            return Check_All_Returns (N) = OK;
+         end Returns_Compile_Time_Constant;
+
+         --------------------------------------
+         --  Returns_Intrinsic_Function_Call --
+         --------------------------------------
+
+         function Returns_Intrinsic_Function_Call
+           (N : Node_Id) return Boolean
+         is
+            function Check_Return (N : Node_Id) return Traverse_Result;
+
+            ------------------
+            -- Check_Return --
+            ------------------
+
+            function Check_Return (N : Node_Id) return Traverse_Result is
+            begin
+               if Nkind (N) = N_Extended_Return_Statement then
+                  return Abandon;
+
+               elsif Nkind (N) = N_Simple_Return_Statement then
+                  if Present (Expression (N)) then
+                     declare
+                        Orig_Expr : constant Node_Id :=
+                                      Original_Node (Expression (N));
+
+                     begin
+                        if Nkind (Orig_Expr) in N_Op
+                          and then Is_Intrinsic_Subprogram (Entity (Orig_Expr))
+                        then
+                           return OK;
+
+                        elsif Nkind (Orig_Expr) in N_Has_Entity
+                          and then Present (Entity (Orig_Expr))
+                          and then Ekind (Entity (Orig_Expr)) = E_Function
+                          and then Is_Inlined (Entity (Orig_Expr))
+                        then
+                           return OK;
+
+                        elsif Nkind (Orig_Expr) in N_Has_Entity
+                          and then Present (Entity (Orig_Expr))
+                          and then Is_Intrinsic_Subprogram (Entity (Orig_Expr))
+                        then
+                           return OK;
+
+                        else
+                           return Abandon;
+                        end if;
+                     end;
+
+                  --  Expression has wrong form
+
+                  else
+                     return Abandon;
+                  end if;
+
+               --  Continue analyzing statements
+
+               else
+                  return OK;
+               end if;
+            end Check_Return;
+
+            function Check_All_Returns is new Traverse_Func (Check_Return);
+
+         --  Start of processing for Returns_Intrinsic_Function_Call
+
+         begin
+            return Check_All_Returns (N) = OK;
+         end Returns_Intrinsic_Function_Call;
+
+         --------------------------
+         -- Uses_Secondary_Stack --
+         --------------------------
+
+         function Uses_Secondary_Stack (N : Node_Id) return Boolean is
+
+            function Check_Call (N : Node_Id) return Traverse_Result;
+            --  Look for function calls that return an unconstrained type
+
+            ----------------
+            -- Check_Call --
+            ----------------
+
+            function Check_Call (N : Node_Id) return Traverse_Result is
+            begin
+               if Nkind (N) = N_Function_Call
+                 and then Is_Entity_Name (Name (N))
+                 and then Is_Composite_Type (Etype (Entity (Name (N))))
+                 and then not Is_Constrained (Etype (Entity (Name (N))))
+               then
+                  Cannot_Inline
+                    ("cannot inline & (call returns unconstrained type)?",
+                     N, Subp);
+
+                  return Abandon;
+               else
+                  return OK;
+               end if;
+            end Check_Call;
+
+            function Check_Calls is new Traverse_Func (Check_Call);
+
+         --  Start of processing for Uses_Secondary_Stack
+
+         begin
+            return Check_Calls (N) = Abandon;
+         end Uses_Secondary_Stack;
+
+         --  Local variables
+
+         Decl       : constant Node_Id := Unit_Declaration_Node (Spec_Id);
+         May_Inline : constant Boolean :=
+                        Has_Pragma_Inline_Always (Spec_Id)
+                          or else (Has_Pragma_Inline (Spec_Id)
+                                     and then ((Optimization_Level > 0
+                                                  and then Ekind (Spec_Id)
+                                                             = E_Function)
+                                               or else Front_End_Inlining));
+         Body_To_Analyze : Node_Id;
+
+      --  Start of processing for Check_Body_To_Inline
+
+      begin
+         --  No action needed in stubs since the attribute Body_To_Inline
+         --  is not available
+
+         if Nkind (Decl) = N_Subprogram_Body_Stub then
+            return False;
+
+         --  Cannot build the body to inline if the attribute is already set.
+         --  This attribute may have been set if this is a subprogram renaming
+         --  declarations (see Freeze.Build_Renamed_Body).
+
+         elsif Present (Body_To_Inline (Decl)) then
+            return False;
+
+         --  No action needed if the subprogram does not fulfill the minimum
+         --  conditions to be inlined by the frontend
+
+         elsif not May_Inline then
+            return False;
+         end if;
+
+         --  Check excluded declarations
+
+         if Present (Declarations (N))
+           and then Has_Excluded_Declaration (Declarations (N))
+         then
+            return False;
+         end if;
+
+         --  Check excluded statements
+
+         if Present (Handled_Statement_Sequence (N)) then
+            if Present
+                 (Exception_Handlers (Handled_Statement_Sequence (N)))
+            then
+               Cannot_Inline
+                 ("cannot inline& (exception handler)?",
+                  First
+                    (Exception_Handlers (Handled_Statement_Sequence (N))),
+                  Subp);
+
+               return False;
+
+            elsif Has_Excluded_Statement
+              (Statements (Handled_Statement_Sequence (N)))
+            then
+               return False;
+            end if;
+         end if;
+
+         --  For backward compatibility, compiling under -gnatN we do not
+         --  inline a subprogram that is too large, unless it is marked
+         --  Inline_Always. This pragma does not suppress the other checks
+         --  on inlining (forbidden declarations, handlers, etc).
+
+         if Front_End_Inlining
+           and then not Has_Pragma_Inline_Always (Subp)
+           and then Stat_Count > Max_Size
+         then
+            Cannot_Inline ("cannot inline& (body too large)?", N, Subp);
+            return False;
+         end if;
+
+         --  If some enclosing body contains instantiations that appear before
+         --  the corresponding generic body, the enclosing body has a freeze
+         --  node so that it can be elaborated after the generic itself. This
+         --  might conflict with subsequent inlinings, so that it is unsafe to
+         --  try to inline in such a case.
+
+         if Has_Pending_Instantiation then
+            Cannot_Inline
+              ("cannot inline& (forward instance within enclosing body)?",
+               N, Subp);
+
+            return False;
+         end if;
+
+         --  Generate and preanalyze the body to inline (needed to perform
+         --  the rest of the checks)
+
+         Generate_Body_To_Inline (N, Body_To_Analyze);
+
+         if Ekind (Subp) = E_Function then
+            Set_Result_Definition (Specification (Body_To_Analyze),
+              New_Occurrence_Of (Etype (Subp), Sloc (N)));
+         end if;
+
+         --  Nest the body to analyze within the real one
+
+         if No (Declarations (N)) then
+            Set_Declarations (N, New_List (Body_To_Analyze));
+         else
+            Append_To (Declarations (N), Body_To_Analyze);
+         end if;
+
+         Preanalyze (Body_To_Analyze);
+         Remove (Body_To_Analyze);
+
+         --  Keep separate checks needed when compiling without optimizations
+
+         if Optimization_Level = 0 then
+
+            --  Cannot inline functions whose body has a call that returns an
+            --  unconstrained type since the secondary stack is involved, and
+            --  it is not worth inlining.
+
+            if Uses_Secondary_Stack (Body_To_Analyze) then
+               return False;
+
+            --  Cannot inline functions that return controlled types since
+            --  controlled actions interfere in complex ways with inlining.
+
+            elsif Ekind (Subp) = E_Function
+              and then Needs_Finalization (Etype (Subp))
+            then
+               Cannot_Inline
+                 ("cannot inline & (controlled return type)?", N, Subp);
+               return False;
+
+            elsif Returns_Unconstrained_Type (Subp) then
+               Cannot_Inline
+                 ("cannot inline & (unconstrained return type)?", N, Subp);
+               return False;
+            end if;
+
+         --  Compiling with optimizations enabled
+
+         else
+            --  Procedures are never frontend inlined in this case!
+
+            if Ekind (Subp) /= E_Function then
+               return False;
+
+            --  Functions returning unconstrained types are tested
+            --  separately (see Can_Split_Unconstrained_Function).
+
+            elsif Returns_Unconstrained_Type (Subp) then
+               null;
+
+            --  Check supported cases
+
+            elsif not Returns_Compile_Time_Constant (Body_To_Analyze)
+              and then Convention (Subp) /= Convention_Intrinsic
+              and then not Returns_Intrinsic_Function_Call (Body_To_Analyze)
+            then
+               return False;
+            end if;
+         end if;
+
+         return True;
+      end Check_Body_To_Inline;
+
+      --------------------------------------
+      -- Can_Split_Unconstrained_Function --
+      --------------------------------------
+
+      function Can_Split_Unconstrained_Function (N : Node_Id) return Boolean
+      is
+         Ret_Node : constant Node_Id :=
+                      First (Statements (Handled_Statement_Sequence (N)));
+         D : Node_Id;
+
+      begin
+         --  No user defined declarations allowed in the function except inside
+         --  the unique return statement; implicit labels are the only allowed
+         --  declarations.
+
+         if not Is_Empty_List (Declarations (N)) then
+            D := First (Declarations (N));
+            while Present (D) loop
+               if Nkind (D) /= N_Implicit_Label_Declaration then
+                  return False;
+               end if;
+
+               Next (D);
+            end loop;
+         end if;
+
+         return Present (Ret_Node)
+           and then Nkind (Ret_Node) = N_Extended_Return_Statement
+           and then No (Next (Ret_Node))
+           and then Present (Handled_Statement_Sequence (Ret_Node));
+      end Can_Split_Unconstrained_Function;
+
+      -----------------------------
+      -- Generate_Body_To_Inline --
+      -----------------------------
+
+      procedure Generate_Body_To_Inline
+        (N              : Node_Id;
+         Body_To_Inline : out Node_Id)
+      is
+         procedure Remove_Pragmas (N : Node_Id);
+         --  Remove occurrences of pragmas that may reference the formals of
+         --  N. The analysis of the non-inlined body will handle these pragmas
+         --  properly.
+
+         --------------------
+         -- Remove_Pragmas --
+         --------------------
+
+         procedure Remove_Pragmas (N : Node_Id) is
+            Decl : Node_Id;
+            Nxt  : Node_Id;
+
+         begin
+            Decl := First (Declarations (N));
+            while Present (Decl) loop
+               Nxt := Next (Decl);
+
+               if Nkind (Decl) = N_Pragma
+                 and then (Pragma_Name (Decl) = Name_Unreferenced
+                           or else
+                             Pragma_Name (Decl) = Name_Unmodified)
+               then
+                  Remove (Decl);
+               end if;
+
+               Decl := Nxt;
+            end loop;
+         end Remove_Pragmas;
+
+      --  Start of processing for Generate_Body_To_Inline
+
+      begin
+         --  Within an instance, the body to inline must be treated as a nested
+         --  generic, so that the proper global references are preserved.
+
+         --  Note that we do not do this at the library level, because it
+         --  is not needed, and furthermore this causes trouble if front
+         --  end inlining is activated (-gnatN).
+
+         if In_Instance
+           and then Scope (Current_Scope) /= Standard_Standard
+         then
+            Body_To_Inline := Copy_Generic_Node (N, Empty, True);
+         else
+            Body_To_Inline := Copy_Separate_Tree (N);
+         end if;
+
+         --  A pragma Unreferenced or pragma Unmodified that mentions a formal
+         --  parameter has no meaning when the body is inlined and the formals
+         --  are rewritten. Remove it from body to inline. The analysis of the
+         --  non-inlined body will handle the pragma properly.
+
+         Remove_Pragmas (Body_To_Inline);
+
+         --  We need to capture references to the formals in order
+         --  to substitute the actuals at the point of inlining, i.e.
+         --  instantiation. To treat the formals as globals to the body to
+         --  inline, we nest it within a dummy parameterless subprogram,
+         --  declared within the real one.
+
+         Set_Parameter_Specifications
+           (Specification (Body_To_Inline), No_List);
+
+         --  A new internal name is associated with Body_To_Inline to avoid
+         --  conflicts when the non-inlined body N is analyzed.
+
+         Set_Defining_Unit_Name (Specification (Body_To_Inline),
+            Make_Defining_Identifier (Sloc (N), New_Internal_Name ('P')));
+         Set_Corresponding_Spec (Body_To_Inline, Empty);
+      end Generate_Body_To_Inline;
+
+      ----------------
+      -- Preanalyze --
+      ----------------
+
+      procedure Preanalyze (N : Node_Id) is
+         Save_Full_Analysis : constant Boolean := Full_Analysis;
+
+      begin
+         Full_Analysis := False;
+         Expander_Mode_Save_And_Set (False);
+
+         Analyze (N);
+
+         Expander_Mode_Restore;
+         Full_Analysis := Save_Full_Analysis;
+      end Preanalyze;
+
+      ----------------------------------
+      -- Split_Unconstrained_Function --
+      ----------------------------------
+
+      procedure Split_Unconstrained_Function
+        (N        : Node_Id;
+         Spec_Id  : Entity_Id)
+      is
+         Loc      : constant Source_Ptr := Sloc (N);
+         Ret_Node : constant Node_Id :=
+                      First (Statements (Handled_Statement_Sequence (N)));
+         Ret_Obj  : constant Node_Id :=
+                      First (Return_Object_Declarations (Ret_Node));
+
+         procedure Build_Procedure
+           (Proc_Id   : out Entity_Id;
+            Decl_List : out List_Id);
+         --  Build a procedure containing the statements found in the extended
+         --  return statement of the unconstrained function body N.
+
+         procedure Build_Procedure
+           (Proc_Id   : out Entity_Id;
+            Decl_List : out List_Id)
+         is
+            Formal      : Entity_Id;
+            Formal_List : constant List_Id := New_List;
+            Proc_Spec   : Node_Id;
+            Proc_Body   : Node_Id;
+            Subp_Name   : constant Name_Id := New_Internal_Name ('F');
+            Body_Decl_List : List_Id := No_List;
+            Param_Type  : Node_Id;
+
+         begin
+            if Nkind (Object_Definition (Ret_Obj)) = N_Identifier then
+               Param_Type := New_Copy (Object_Definition (Ret_Obj));
+            else
+               Param_Type :=
+                 New_Copy (Subtype_Mark (Object_Definition (Ret_Obj)));
+            end if;
+
+            Append_To (Formal_List,
+              Make_Parameter_Specification (Loc,
+                Defining_Identifier =>
+                  Make_Defining_Identifier (Loc,
+                    Chars => Chars (Defining_Identifier (Ret_Obj))),
+                In_Present  => False,
+                Out_Present => True,
+                Null_Exclusion_Present => False,
+                Parameter_Type => Param_Type));
+
+            Formal := First_Formal (Spec_Id);
+            while Present (Formal) loop
+               Append_To (Formal_List,
+                 Make_Parameter_Specification (Loc,
+                   Defining_Identifier =>
+                     Make_Defining_Identifier (Sloc (Formal),
+                       Chars => Chars (Formal)),
+                   In_Present  => In_Present (Parent (Formal)),
+                   Out_Present => Out_Present (Parent (Formal)),
+                   Null_Exclusion_Present =>
+                     Null_Exclusion_Present (Parent (Formal)),
+                   Parameter_Type =>
+                     New_Reference_To (Etype (Formal), Loc),
+                   Expression =>
+                     Copy_Separate_Tree (Expression (Parent (Formal)))));
+
+               Next_Formal (Formal);
+            end loop;
+
+            Proc_Id :=
+              Make_Defining_Identifier (Loc, Chars => Subp_Name);
+
+            Proc_Spec :=
+              Make_Procedure_Specification (Loc,
+                Defining_Unit_Name => Proc_Id,
+                Parameter_Specifications => Formal_List);
+
+            Decl_List := New_List;
+
+            Append_To (Decl_List,
+              Make_Subprogram_Declaration (Loc, Proc_Spec));
+
+            --  Can_Convert_Unconstrained_Function checked that the function
+            --  has no local declarations except implicit label declarations.
+            --  Copy these declarations to the built procedure.
+
+            if Present (Declarations (N)) then
+               Body_Decl_List := New_List;
+
+               declare
+                  D     : Node_Id;
+                  New_D : Node_Id;
+
+               begin
+                  D := First (Declarations (N));
+                  while Present (D) loop
+                     pragma Assert (Nkind (D) = N_Implicit_Label_Declaration);
+
+                     New_D :=
+                       Make_Implicit_Label_Declaration (Loc,
+                         Make_Defining_Identifier (Loc,
+                           Chars => Chars (Defining_Identifier (D))),
+                         Label_Construct => Empty);
+                     Append_To (Body_Decl_List, New_D);
+
+                     Next (D);
+                  end loop;
+               end;
+            end if;
+
+            pragma Assert (Present (Handled_Statement_Sequence (Ret_Node)));
+
+            Proc_Body :=
+              Make_Subprogram_Body (Loc,
+                Specification => Copy_Separate_Tree (Proc_Spec),
+                Declarations  => Body_Decl_List,
+                Handled_Statement_Sequence =>
+                  Copy_Separate_Tree (Handled_Statement_Sequence (Ret_Node)));
+
+            Set_Defining_Unit_Name (Specification (Proc_Body),
+               Make_Defining_Identifier (Loc, Subp_Name));
+
+            Append_To (Decl_List, Proc_Body);
+         end Build_Procedure;
+
+         --  Local variables
+
+         New_Obj   : constant Node_Id := Copy_Separate_Tree (Ret_Obj);
+         Blk_Stmt  : Node_Id;
+         Proc_Id   : Entity_Id;
+         Proc_Call : Node_Id;
+
+      --  Start of processing for Split_Unconstrained_Function
+
+      begin
+         --  Build the associated procedure, analyze it and insert it before
+         --  the function body N
+
+         declare
+            Scope     : constant Entity_Id := Current_Scope;
+            Decl_List : List_Id;
+         begin
+            Pop_Scope;
+            Build_Procedure (Proc_Id, Decl_List);
+            Insert_Actions (N, Decl_List);
+            Push_Scope (Scope);
+         end;
+
+         --  Build the call to the generated procedure
+
+         declare
+            Actual_List : constant List_Id := New_List;
+            Formal      : Entity_Id;
+
+         begin
+            Append_To (Actual_List,
+              New_Reference_To (Defining_Identifier (New_Obj), Loc));
+
+            Formal := First_Formal (Spec_Id);
+            while Present (Formal) loop
+               Append_To (Actual_List, New_Reference_To (Formal, Loc));
+
+               --  Avoid spurious warning on unreferenced formals
+
+               Set_Referenced (Formal);
+               Next_Formal (Formal);
+            end loop;
+
+            Proc_Call :=
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (Proc_Id, Loc),
+                Parameter_Associations => Actual_List);
+         end;
+
+         --  Generate
+
+         --    declare
+         --       New_Obj : ...
+         --    begin
+         --       main_1__F1b (New_Obj, ...);
+         --       return Obj;
+         --    end B10b;
+
+         Blk_Stmt :=
+           Make_Block_Statement (Loc,
+             Declarations => New_List (New_Obj),
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => New_List (
+
+                   Proc_Call,
+
+                   Make_Simple_Return_Statement (Loc,
+                     Expression =>
+                       New_Reference_To
+                         (Defining_Identifier (New_Obj), Loc)))));
+
+         Rewrite (Ret_Node, Blk_Stmt);
+      end Split_Unconstrained_Function;
+
+   --  Start of processing for Check_And_Build_Body_To_Inline
+
+   begin
+      --  Do not inline any subprogram that contains nested subprograms, since
+      --  the backend inlining circuit seems to generate uninitialized
+      --  references in this case. We know this happens in the case of front
+      --  end ZCX support, but it also appears it can happen in other cases as
+      --  well. The backend often rejects attempts to inline in the case of
+      --  nested procedures anyway, so little if anything is lost by this.
+      --  Note that this is test is for the benefit of the back-end. There is
+      --  a separate test for front-end inlining that also rejects nested
+      --  subprograms.
+
+      --  Do not do this test if errors have been detected, because in some
+      --  error cases, this code blows up, and we don't need it anyway if
+      --  there have been errors, since we won't get to the linker anyway.
+
+      if Comes_From_Source (Body_Id)
+        and then (Has_Pragma_Inline_Always (Spec_Id)
+                    or else Optimization_Level > 0)
+        and then Serious_Errors_Detected = 0
+      then
+         declare
+            P_Ent : Node_Id;
+
+         begin
+            P_Ent := Body_Id;
+            loop
+               P_Ent := Scope (P_Ent);
+               exit when No (P_Ent) or else P_Ent = Standard_Standard;
+
+               if Is_Subprogram (P_Ent) then
+                  Set_Is_Inlined (P_Ent, False);
+
+                  if Comes_From_Source (P_Ent)
+                    and then Has_Pragma_Inline (P_Ent)
+                  then
+                     Cannot_Inline
+                       ("cannot inline& (nested subprogram)?", N, P_Ent,
+                        Is_Serious => True);
+                  end if;
+               end if;
+            end loop;
+         end;
+      end if;
+
+      --  Build the body to inline only if really needed!
+
+      if Check_Body_To_Inline (N, Spec_Id)
+        and then Serious_Errors_Detected = 0
+      then
+         if Returns_Unconstrained_Type (Spec_Id) then
+            if Can_Split_Unconstrained_Function (N) then
+               Split_Unconstrained_Function (N, Spec_Id);
+               Build_Body_To_Inline (N, Spec_Id);
+               Set_Is_Inlined (Spec_Id);
+            end if;
+         else
+            Build_Body_To_Inline (N, Spec_Id);
+            Set_Is_Inlined (Spec_Id);
+         end if;
+      end if;
+   end Check_And_Build_Body_To_Inline;
+
    -----------------------
    -- Check_Conformance --
    -----------------------
Index: sem_ch6.ads
===================================================================
--- sem_ch6.ads	(revision 185051)
+++ sem_ch6.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -50,13 +50,33 @@ 
    --  and body declarations. Returns the defining entity for the
    --  specification N.
 
-   procedure Cannot_Inline (Msg : String; N : Node_Id; Subp : Entity_Id);
+   procedure Cannot_Inline
+     (Msg        : String;
+      N          : Node_Id;
+      Subp       : Entity_Id;
+      Is_Serious : Boolean := False);
    --  This procedure is called if the node N, an instance of a call to
    --  subprogram Subp, cannot be inlined. Msg is the message to be issued,
-   --  and has a ? as the last character. If Subp has a pragma Always_Inlined,
-   --  then an error message is issued (by removing the last character of Msg).
-   --  If Subp is not Always_Inlined, then a warning is issued if the flag
-   --  Ineffective_Inline_Warnings is set, and if not, the call has no effect.
+   --  and has a ? as the last character. Temporarily the behavior of this
+   --  routine depends on the value of -gnatd.k:
+   --    * If -gnatd.k is not set (ie. old inlining model) then if Subp has
+   --      a pragma Always_Inlined, then an error message is issued (by
+   --      removing the last character of Msg). If Subp is not Always_Inlined,
+   --      then a warning is issued if the flag Ineffective_Inline_Warnings
+   --      is set, and if not, the call has no effect.
+   --    * If -gnatd.k is set (ie. new inlining model) then:
+   --      - If Is_Serious is true, then an error is reported (by removing the
+   --        last character of Msg);
+   --      - otherwise:
+   --        * Compiling without optimizations if Subp has a pragma
+   --          Always_Inlined, then an error message is issued; if Subp is
+   --          not Always_Inlined, then a warning is issued if the flag
+   --          Ineffective_Inline_Warnings is set, and if not, the call
+   --          has no effect.
+   --        * Compiling with optimizations then a warning is issued if
+   --          the flag Ineffective_Inline_Warnings is set; otherwise the
+   --          call has no effect since inlining may be performed by the
+   --          backend.
 
    procedure Check_Conventions (Typ : Entity_Id);
    --  Ada 2005 (AI-430): Check that the conventions of all inherited and