exp_ch3.adb (Default_Initialize_Object): Call Add_Inlined_Body on the…

exp_ch3.adb (Default_Initialize_Object): Call Add_Inlined_Body on the Abort_Undefer_Direct function.

2015-02-20  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch3.adb (Default_Initialize_Object): Call Add_Inlined_Body on the
	Abort_Undefer_Direct function.
	* exp_ch5.adb (Expand_N_Assignment_Statement): Likewise.
	* exp_intr.adb (Expand_Unc_Deallocation): Likewise.
	* exp_prag.adb (Expand_Pragma_Abort_Defer): Likewise.
	* exp_ch4.adb (Expand_N_Selected_Component): Adjust call to
	Add_Inlined_Body.
	* exp_ch6.adb (Expand_Call): Adjust calls to Add_Inlined_Body.
	 Remove call to Register_Backend_Call and move code resetting
	Needs_Debug_Info on inlined subprograms to...
	* inline.ads (Add_Inlined_Body): Add N parameter.
	(Register_Backend_Call): Delete.
	* inline.adb (Add_Inlined_Body): ...here and simplify.
	 Register the call with Backend_Calls directly.
	(Register_Backend_Call): Delete.
	* s-stalib.ads (Abort_Undefer_Direct): Restore pragma Inline.

From-SVN: r220841

gcc/ada/ChangeLog

 2015-02-20  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* exp_ch3.adb (Default_Initialize_Object): Call Add_Inlined_Body on the
+	Abort_Undefer_Direct function.
+	* exp_ch5.adb (Expand_N_Assignment_Statement): Likewise.
+	* exp_intr.adb (Expand_Unc_Deallocation): Likewise.
+	* exp_prag.adb (Expand_Pragma_Abort_Defer): Likewise.
+	* exp_ch4.adb (Expand_N_Selected_Component): Adjust call to
+	Add_Inlined_Body.
+	* exp_ch6.adb (Expand_Call): Adjust calls to Add_Inlined_Body.
+	 Remove call to Register_Backend_Call and move code resetting
+	Needs_Debug_Info on inlined subprograms to...
+	* inline.ads (Add_Inlined_Body): Add N parameter.
+	(Register_Backend_Call): Delete.
+	* inline.adb (Add_Inlined_Body): ...here and simplify.
+	 Register the call with Backend_Calls directly.
+	(Register_Backend_Call): Delete.
+	* s-stalib.ads (Abort_Undefer_Direct): Restore pragma Inline.
+
+2015-02-20  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* s-stalib.ads: Fix typo.
 
 2015-02-20  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/exp_ch3.adb

@@ -44,6 +44,7 @@ with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
 with Ghost;    use Ghost;
+with Inline;   use Inline;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -5321,11 +5322,20 @@ package body Exp_Ch3 is
                --       Abort_Undefer_Direct;
                --    end;
 
+               declare
+                  AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
+
+               begin
                   Abrt_HSS :=
                     Make_Handled_Sequence_Of_Statements (Loc,
                       Statements  => Fin_Stmts,
-                   At_End_Proc =>
-                     New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc));
+                      At_End_Proc => New_Occurrence_Of (AUD, Loc));
+
+                  --  Present the Abort_Undefer_Direct function to the backend
+                  --  so that it can inline the call to the function.
+
+                  Add_Inlined_Body (AUD, N);
+               end;
 
                Abrt_Blk :=
                  Make_Block_Statement (Loc,

gcc/ada/exp_ch4.adb

@@ -9485,7 +9485,8 @@ package body Exp_Ch4 is
 
             Add_Inlined_Body
               (Discriminant_Checking_Func
-                (Original_Record_Component (Entity (S))));
+                (Original_Record_Component (Entity (S))),
+               N);
 
             --  Now reset the flag and generate the call
 

gcc/ada/exp_ch5.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -38,6 +38,7 @@ with Exp_Dbug; use Exp_Dbug;
 with Exp_Pakd; use Exp_Pakd;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
+with Inline;   use Inline;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -2342,6 +2343,7 @@ package body Exp_Ch5 is
                   Blk : constant Entity_Id :=
                           New_Internal_Entity
                             (E_Block, Current_Scope, Sloc (N), 'B');
+                  AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
 
                begin
                   Set_Scope (Blk, Current_Scope);
@@ -2350,7 +2352,13 @@ package body Exp_Ch5 is
 
                   Prepend_To (L, Build_Runtime_Call (Loc, RE_Abort_Defer));
                   Set_At_End_Proc (Handled_Statement_Sequence (N),
-                    New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc));
+                    New_Occurrence_Of (AUD, Loc));
+
+                  --  Present the Abort_Undefer_Direct function to the backend
+                  --  so that it can inline the call to the function.
+
+                  Add_Inlined_Body (AUD, N);
+
                   Expand_At_End_Handler
                     (Handled_Statement_Sequence (N), Blk);
                end;

gcc/ada/exp_ch6.adb

@@ -43,7 +43,6 @@ with Exp_Pakd; use Exp_Pakd;
 with Exp_Prag; use Exp_Prag;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
-with Fname;    use Fname;
 with Freeze;   use Freeze;
 with Inline;   use Inline;
 with Lib;      use Lib;
@@ -3757,7 +3756,7 @@ package body Exp_Ch6 is
                else
                   --  Let the back end handle it
 
-                  Add_Inlined_Body (Subp);
+                  Add_Inlined_Body (Subp, Call_Node);
 
                   if Front_End_Inlining
                     and then Nkind (Spec) = N_Subprogram_Declaration
@@ -3780,30 +3779,7 @@ package body Exp_Ch6 is
                                                  N_Subprogram_Declaration
            or else No (Body_To_Inline (Unit_Declaration_Node (Subp)))
          then
-            Add_Inlined_Body (Subp);
-            Register_Backend_Call (Call_Node);
-
-            --  If the call is to a function in a run-time unit that is marked
-            --  Inline_Always, we must suppress debugging information on it,
-            --  so that the code that is eventually inlined will not affect
-            --  debugging of the user program.
-
-            if Is_Predefined_File_Name
-                 (Unit_File_Name (Get_Source_Unit (Sloc (Subp))))
-              and then In_Extended_Main_Source_Unit (N)
-            then
-               --  We make an exception for calls to the Ada hierarchy if call
-               --  comes from source, because some user applications need the
-               --  debugging information for such calls.
-
-               if Comes_From_Source (Call_Node)
-                 and then Name_Buffer (1 .. 2) = "a-"
-               then
-                  null;
-               else
-                  Set_Needs_Debug_Info (Subp, False);
-               end if;
-            end if;
+            Add_Inlined_Body (Subp, Call_Node);
 
          --  Front end expansion of simple functions returning unconstrained
          --  types (see Check_And_Split_Unconstrained_Function) and simple

gcc/ada/exp_intr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -37,6 +37,7 @@ with Exp_Code; use Exp_Code;
 with Exp_Fixd; use Exp_Fixd;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
+with Inline;   use Inline;
 with Nmake;    use Nmake;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
@@ -1082,12 +1083,23 @@ package body Exp_Intr is
          if Abort_Allowed then
             Prepend_To (Final_Code, Build_Runtime_Call (Loc, RE_Abort_Defer));
 
+            declare
+               AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
+
+            begin
                Blk :=
-              Make_Block_Statement (Loc, Handled_Statement_Sequence =>
+                 Make_Block_Statement (Loc,
+                   Handled_Statement_Sequence =>
                      Make_Handled_Sequence_Of_Statements (Loc,
                        Statements  => Final_Code,
-                  At_End_Proc =>
-                    New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)));
+                       At_End_Proc => New_Occurrence_Of (AUD, Loc)));
+
+               --  Present the Abort_Undefer_Direct function to the backend so
+               --  that it can inline the call to the function.
+
+               Add_Inlined_Body (AUD, N);
+            end;
+
             Add_Block_Identifier (Blk, Blk_Id);
 
             Append (Blk, Stmts);

gcc/ada/exp_prag.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -32,6 +32,7 @@ with Errout;   use Errout;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Util; use Exp_Util;
 with Expander; use Expander;
+with Inline;   use Inline;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -889,10 +890,10 @@ package body Exp_Prag is
       HSS  : Node_Id;
       Blk  : constant Entity_Id :=
                New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
+      AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
 
    begin
       Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
-
       loop
          Stm := Remove_Next (N);
          exit when No (Stm);
@@ -902,8 +903,12 @@ package body Exp_Prag is
       HSS :=
         Make_Handled_Sequence_Of_Statements (Loc,
           Statements  => Stms,
-          At_End_Proc =>
-            New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc));
+          At_End_Proc => New_Occurrence_Of (AUD, Loc));
+
+      --  Present the Abort_Undefer_Direct function to the backend so that it
+      --  can inline the call to the function.
+
+      Add_Inlined_Body (AUD, N);
 
       Rewrite (N,
         Make_Block_Statement (Loc,

gcc/ada/inline.adb

@@ -291,7 +291,7 @@ package body Inline is
    -- Add_Inlined_Body --
    ----------------------
 
-   procedure Add_Inlined_Body (E : Entity_Id) is
+   procedure Add_Inlined_Body (E : Entity_Id; N : Node_Id) is
 
       type Inline_Level_Type is (Dont_Inline, Inline_Call, Inline_Package);
       --  Level of inlining for the call: Dont_Inline means no inlining,
@@ -376,6 +376,8 @@ package body Inline is
    --  Start of processing for Add_Inlined_Body
 
    begin
+      Append_New_Elmt (N, To => Backend_Calls);
+
       --  Find unit containing E, and add to list of inlined bodies if needed.
       --  If the body is already present, no need to load any other unit. This
       --  is the case for an initialization procedure, which appears in the
@@ -397,6 +399,7 @@ package body Inline is
       end if;
 
       Level := Must_Inline;
+
       if Level /= Dont_Inline then
          declare
             Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
@@ -444,6 +447,21 @@ package body Inline is
                   Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
                end if;
             end if;
+
+            --  If the call was generated by the compiler and is to a function
+            --  in a run-time unit, we need to suppress debugging information
+            --  for it, so that the code that is eventually inlined will not
+            --  affect debugging of the program. We do not do it if the call
+            --  comes from source because, even if the call is inlined, the
+            --  user may expect it to be present in the debugging information.
+
+            if not Comes_From_Source (N)
+               and then In_Extended_Main_Source_Unit (N)
+               and then
+                 Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (E)))
+            then
+               Set_Needs_Debug_Info (E, False);
+            end if;
          end;
       end if;
    end Add_Inlined_Body;
@@ -3937,15 +3955,6 @@ package body Inline is
       Inlined.Release;
    end Lock;
 
-   ---------------------------
-   -- Register_Backend_Call --
-   ---------------------------
-
-   procedure Register_Backend_Call (N : Node_Id) is
-   begin
-      Append_New_Elmt (N, To => Backend_Calls);
-   end Register_Backend_Call;
-
    --------------------------------
    -- Remove_Aspects_And_Pragmas --
    --------------------------------

gcc/ada/inline.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -149,11 +149,11 @@ package Inline is
    --  instantiate the bodies of generic instantiations that appear in the
    --  compilation unit.
 
-   procedure Add_Inlined_Body (E : Entity_Id);
-   --  E is an inlined subprogram appearing in a call, either explicitly, or
-   --  a discriminant check for which gigi builds a call.  Add E's enclosing
-   --  unit to Inlined_Bodies so that body of E can be subsequently retrieved
-   --  and analyzed.
+   procedure Add_Inlined_Body (E : Entity_Id; N : Node_Id);
+   --  E is an inlined subprogram appearing in a call, either explicitly or in
+   --  a discriminant check for which gigi builds a call or an at-end handler.
+   --  Add E's enclosing unit to Inlined_Bodies so that E can be subsequently
+   --  retrieved and analyzed. N is the node giving rise to the call to E.
 
    procedure Analyze_Inlined_Bodies;
    --  At end of compilation, analyze the bodies of all units that contain
@@ -247,9 +247,6 @@ package Inline is
    --  Generate listing of calls inlined by the frontend plus listing of
    --  calls to inline subprograms passed to the backend.
 
-   procedure Register_Backend_Call (N : Node_Id);
-   --  Append N to the list Backend_Calls
-
    procedure Remove_Dead_Instance (N : Node_Id);
    --  If an instantiation appears in unreachable code, delete the pending
    --  body instance.

gcc/ada/s-stalib.ads

@@ -239,10 +239,9 @@ package System.Standard_Library is
    -----------------
 
    procedure Abort_Undefer_Direct;
+   pragma Inline (Abort_Undefer_Direct);
    --  A little procedure that just calls Abort_Undefer.all, for use in
    --  clean up procedures, which only permit a simple subprogram name.
-   --  ??? This procedure is not marked inline because the front-end
-   --  cannot currently mark its calls from at-end handlers as inlined.
 
    procedure Adafinal;
    --  Performs the Ada Runtime finalization the first time it is invoked.