exp_ch3.adb (Default_Initialize_Object): Call Add_Inlined_Body on the Abort_Undefer_D...
authorEric Botcazou <ebotcazou@adacore.com>
Fri, 20 Feb 2015 09:45:50 +0000 (09:45 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 20 Feb 2015 09:45:50 +0000 (10:45 +0100)
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
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch5.adb
gcc/ada/exp_ch6.adb
gcc/ada/exp_intr.adb
gcc/ada/exp_prag.adb
gcc/ada/inline.adb
gcc/ada/inline.ads
gcc/ada/s-stalib.ads

index 2144ec83d51584d492ba6e4ff64298ac1dcbcd12..7a2d6d112e58899391cd8b098893e2fd98791851 100644 (file)
@@ -1,3 +1,22 @@
+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.
index 3d0ee1f76600ca821aecca21189c6a76453e5731..c2ba50af70ba3ff32557df3ffb290afcc3ef0b17 100644 (file)
@@ -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;
 
-               Abrt_HSS :=
-                 Make_Handled_Sequence_Of_Statements (Loc,
-                   Statements  => Fin_Stmts,
-                   At_End_Proc =>
-                     New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc));
+               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 (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,
index 98b24a9a6a138b33a1723d571f72f8b87e93e85c..3fcd8247fd8e7ce26cd298e3173dcaecf38f15a7 100644 (file)
@@ -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
 
index 5e7f79e15698de37e02d2126130b2edf459bf2d9..c45dcb98e81afe8a5288c0e01445adc0ba552411 100644 (file)
@@ -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;
index c9c5da2cbe943ef29002d36c6b17042cd1450b0c..0195b74632cf691c91558476c855739929628e7f 100644 (file)
@@ -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
index e8efe03348cb45baafddeb5d2a6bc75091269ec0..9bda8aab152744c67d1bbd126b47b417739f86d0 100644 (file)
@@ -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));
 
-            Blk :=
-              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)));
+            declare
+               AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
+
+            begin
+               Blk :=
+                 Make_Block_Statement (Loc,
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements  => Final_Code,
+                       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);
index 6ceaf310b060263db0f8d1d6c21e1d96fa1b7f82..d4196e77328aab839866f7d62123e10e44f140e8 100644 (file)
@@ -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;
@@ -888,11 +889,11 @@ package body Exp_Prag is
       Stms : List_Id;
       HSS  : Node_Id;
       Blk  : constant Entity_Id :=
-        New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
+               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);
@@ -901,9 +902,13 @@ 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));
+          Statements  => Stms,
+          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,
index 896a5e452a54e088cca92c674088fc35719b2708..74b39710a1d5aa238d0cc9cecf66fb91920318b0 100644 (file)
@@ -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 --
    --------------------------------
index 632cbc2c2e5ee5d638454e84d1b503de9e1ac74d..bd22e45ef77514e5b35fd660b756e2aa569d7b32 100644 (file)
@@ -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.
index 8d96677dad04fa8fd6145e35cb75270cd9ae9b63..447662b5e9150be34a870c7e00128fc9fc543c2a 100644 (file)
@@ -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.