+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.
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;
-- 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,
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
-- --
-- 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- --
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;
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);
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;
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;
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
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
-- --
-- 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- --
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;
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);
-- --
-- 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- --
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;
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);
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,
-- 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,
-- 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
end if;
Level := Must_Inline;
+
if Level /= Dont_Inline then
declare
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
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;
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 --
--------------------------------
-- --
-- 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- --
-- 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
-- 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.
-----------------
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.