Skip to content

R
riscv-gcc-1
Commit 6c26bac2 by Arnaud Charlet
Options

[multiple changes] 

2014-07-31  Javier Miranda  <miranda@adacore.com>

	* debug.adb Remove documentation of -gnatd.k (no longer needed).
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Code cleanup.
	* inline.ads (Backend_Inlined_Subps): New
	Elist.	(Backend_Not_Inlined_Subps): New Elist.
	(Has_Excluded_Declaration): Declaration previously located in
	* inline.adb (Has_Excluded_Statement): Declaration previously
	located in inline.adb
	* inline.adb (Has_Single_Return): Moved out of
	Build_Body_To_Inline to avoid having duplicated code.
	(Number_Of_Statements): New subprogram.
	(Register_Backend_Inlined_Subprogram): New subprogram.
	(Register_Backend_Not_Inlined_Subprogram): New subprogram.
	(Add_Inlined_Subprogram): Register backend inlined subprograms and
	also register subprograms that cannot be inlined by the backend.
	(Has_Excluded_Declaration): Moved out of Build_Body_To_Inline
	to avoid having duplicated code.  Replace occurrences of
	Debug_Flag_Dot_K by Back_End_Inlining.
	* sem_res.adb (Resolve_Call): Code cleanup.
	* exp_ch6.adb (Expand_Call): Complete previous patch. Replace
	occurrence of Debug_Flag_Dot_K by Back_End_Inlining.
	(List_Inlining_Info): Add listing of subprograms passed to the
	backend and listing of subprograms that cannot be inlined by
	the backend.
	* sem_ch12.adb, sem_ch3.adb Replace occurrences of
	Debug_Flag_Dot_K by Back_End_Inlining.

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* nlists.ads: Minor code fix (remove unwise Inline for
	List_Length).

From-SVN: r213373
parent 0c9aebea
Showing with 620 additions and 514 deletions
gcc/ada/ChangeLog
2014-07-31 Javier Miranda <miranda@adacore.com>
* debug.adb Remove documentation of -gnatd.k (no longer needed).
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Code cleanup.
* inline.ads (Backend_Inlined_Subps): New
Elist. (Backend_Not_Inlined_Subps): New Elist.
(Has_Excluded_Declaration): Declaration previously located in
* inline.adb (Has_Excluded_Statement): Declaration previously
located in inline.adb
* inline.adb (Has_Single_Return): Moved out of
Build_Body_To_Inline to avoid having duplicated code.
(Number_Of_Statements): New subprogram.
(Register_Backend_Inlined_Subprogram): New subprogram.
(Register_Backend_Not_Inlined_Subprogram): New subprogram.
(Add_Inlined_Subprogram): Register backend inlined subprograms and
also register subprograms that cannot be inlined by the backend.
(Has_Excluded_Declaration): Moved out of Build_Body_To_Inline
to avoid having duplicated code. Replace occurrences of
Debug_Flag_Dot_K by Back_End_Inlining.
* sem_res.adb (Resolve_Call): Code cleanup.
* exp_ch6.adb (Expand_Call): Complete previous patch. Replace
occurrence of Debug_Flag_Dot_K by Back_End_Inlining.
(List_Inlining_Info): Add listing of subprograms passed to the
backend and listing of subprograms that cannot be inlined by
the backend.
* sem_ch12.adb, sem_ch3.adb Replace occurrences of
Debug_Flag_Dot_K by Back_End_Inlining.
2014-07-31 Robert Dewar <dewar@adacore.com>
* nlists.ads: Minor code fix (remove unwise Inline for
List_Length).
2014-07-31 Arnaud Charlet <charlet@adacore.com> 2014-07-31 Arnaud Charlet <charlet@adacore.com>
* einfo.adb: Remove VMS specific code. * einfo.adb: Remove VMS specific code.
...@@ -14,6 +47,7 @@ ...@@ -14,6 +47,7 @@
* gcc-interface/trans.c, gcc-interface/misc.c: Remove references * gcc-interface/trans.c, gcc-interface/misc.c: Remove references
to VMS. Misc clean ups. to VMS. Misc clean ups.
* gcc-interface/Makefile.in (gnatlib-shared-vms): Remove.
2014-07-31 Robert Dewar <dewar@adacore.com> 2014-07-31 Robert Dewar <dewar@adacore.com>
......
gcc/ada/debug.adb
...@@ -101,7 +101,7 @@ package body Debug is ...@@ -101,7 +101,7 @@ package body Debug is
-- d.h -- d.h
-- d.i Ignore Warnings pragmas -- d.i Ignore Warnings pragmas
-- d.j Generate listing of frontend inlined calls -- d.j Generate listing of frontend inlined calls
-- d.k Enable new support for frontend inlining -- d.k
-- d.l Use Ada 95 semantics for limited function returns -- d.l Use Ada 95 semantics for limited function returns
-- d.m For -gnatl, print full source only for main unit -- d.m For -gnatl, print full source only for main unit
-- d.n Print source file names -- d.n Print source file names
...@@ -533,10 +533,6 @@ package body Debug is ...@@ -533,10 +533,6 @@ package body Debug is
-- to the backend. This is useful to locate skipped calls that must be -- to the backend. This is useful to locate skipped calls that must be
-- inlined by the frontend. -- inlined by the frontend.
-- d.k Enable new semantics of frontend inlining. This is useful to test
-- this new feature in all the platforms. What *is* this new semantics
-- which doesn't seem to be documented anywhere???
-- d.l Use Ada 95 semantics for limited function returns. This may be -- d.l Use Ada 95 semantics for limited function returns. This may be
-- used to work around the incompatibility introduced by AI-318-2. -- used to work around the incompatibility introduced by AI-318-2.
-- It is useful only in -gnat05 mode. -- It is useful only in -gnat05 mode.
......
gcc/ada/exp_ch6.adb
...@@ -3830,15 +3830,14 @@ package body Exp_Ch6 is ...@@ -3830,15 +3830,14 @@ package body Exp_Ch6 is
return; return;
end if; end if;
-- Back end inlining: let the back end handle it -- Handle inlining. No action needed if the subprogram is not inlined
if Back_End_Inlining and then Is_Inlined (Subp) then if not Is_Inlined (Subp) then
Add_Inlined_Body (Subp); null;
Register_Backend_Call (Call_Node);
-- Handle inlining (old semantics) -- Handle frontend inlining
elsif Is_Inlined (Subp) and then not Debug_Flag_Dot_K then elsif not Back_End_Inlining then
Inlined_Subprogram : declare Inlined_Subprogram : declare
Bod : Node_Id; Bod : Node_Id;
Must_Inline : Boolean := False; Must_Inline : Boolean := False;
...@@ -3924,9 +3923,22 @@ package body Exp_Ch6 is ...@@ -3924,9 +3923,22 @@ package body Exp_Ch6 is
end if; end if;
end Inlined_Subprogram; end Inlined_Subprogram;
-- Handle inlining (new semantics) -- Back end inlining: let the back end handle it
elsif No (Unit_Declaration_Node (Subp))
or else
Nkind (Unit_Declaration_Node (Subp)) /= N_Subprogram_Declaration
or else
No (Body_To_Inline (Unit_Declaration_Node (Subp)))
then
Add_Inlined_Body (Subp);
Register_Backend_Call (Call_Node);
-- Frontend expansion of supported functions returning unconstrained
-- types
elsif Is_Inlined (Subp) then else pragma Assert (Ekind (Subp) = E_Function
and then Returns_Unconstrained_Type (Subp));
declare declare
Spec : constant Node_Id := Unit_Declaration_Node (Subp); Spec : constant Node_Id := Unit_Declaration_Node (Subp);
...@@ -9720,6 +9732,70 @@ package body Exp_Ch6 is ...@@ -9720,6 +9732,70 @@ package body Exp_Ch6 is
Next_Elmt (Elmt); Next_Elmt (Elmt);
end loop; end loop;
end if; end if;
-- Generate listing of subprograms passed to the backend
if Present (Backend_Inlined_Subps)
and then Back_End_Inlining
then
Count := 0;
Elmt := First_Elmt (Backend_Inlined_Subps);
while Present (Elmt) loop
Nod := Node (Elmt);
Count := Count + 1;
if Count = 1 then
Write_Str
("Listing of inlined subprograms passed to the backend");
Write_Eol;
end if;
Write_Str (" ");
Write_Int (Count);
Write_Str (":");
Write_Name (Chars (Nod));
Write_Str (" (");
Write_Location (Sloc (Nod));
Write_Str (")");
Output.Write_Eol;
Next_Elmt (Elmt);
end loop;
end if;
-- Generate listing of subprogram that cannot be inlined by the backend
if Present (Backend_Not_Inlined_Subps)
and then Back_End_Inlining
then
Count := 0;
Elmt := First_Elmt (Backend_Not_Inlined_Subps);
while Present (Elmt) loop
Nod := Node (Elmt);
Count := Count + 1;
if Count = 1 then
Write_Str
("Listing of subprograms that cannot inline the backend");
Write_Eol;
end if;
Write_Str (" ");
Write_Int (Count);
Write_Str (":");
Write_Name (Chars (Nod));
Write_Str (" (");
Write_Location (Sloc (Nod));
Write_Str (")");
Output.Write_Eol;
Next_Elmt (Elmt);
end loop;
end if;
end List_Inlining_Info; end List_Inlining_Info;
end Exp_Ch6; end Exp_Ch6;
gcc/ada/inline.adb
...@@ -24,7 +24,6 @@ ...@@ -24,7 +24,6 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Atree; use Atree; with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo; with Einfo; use Einfo;
with Elists; use Elists; with Elists; use Elists;
with Errout; use Errout; with Errout; use Errout;
...@@ -143,27 +142,37 @@ package body Inline is ...@@ -143,27 +142,37 @@ package body Inline is
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id;
pragma Inline (Get_Code_Unit_Entity);
-- Return the entity node for the unit containing E. Always return the spec
-- for a package.
function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean;
-- Return True if E is in the main unit or its spec or in a subunit
procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty); procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);
-- Make two entries in Inlined table, for an inlined subprogram being -- Make two entries in Inlined table, for an inlined subprogram being
-- called, and for the inlined subprogram that contains the call. If -- called, and for the inlined subprogram that contains the call. If
-- the call is in the main compilation unit, Caller is Empty. -- the call is in the main compilation unit, Caller is Empty.
procedure Add_Inlined_Subprogram (Index : Subp_Index);
-- Add the subprogram to the list of inlined subprogram for the unit
function Add_Subp (E : Entity_Id) return Subp_Index; function Add_Subp (E : Entity_Id) return Subp_Index;
-- Make entry in Inlined table for subprogram E, or return table index -- Make entry in Inlined table for subprogram E, or return table index
-- that already holds E. -- that already holds E.
function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id;
pragma Inline (Get_Code_Unit_Entity);
-- Return the entity node for the unit containing E. Always return the spec
-- for a package.
function Has_Initialized_Type (E : Entity_Id) return Boolean; function Has_Initialized_Type (E : Entity_Id) return Boolean;
-- If a candidate for inlining contains type declarations for types with -- If a candidate for inlining contains type declarations for types with
-- non-trivial initialization procedures, they are not worth inlining. -- non-trivial initialization procedures, they are not worth inlining.
function Has_Single_Return (N : Node_Id) return Boolean;
-- In general we cannot inline functions that return unconstrained type.
-- However, we can handle such functions if all return statements return
-- a local variable that is the only declaration in the body of the
-- function. In that case the call can be replaced by that local
-- variable as is done for other inlined calls.
function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean;
-- Return True if E is in the main unit or its spec or in a subunit
function Is_Nested (E : Entity_Id) return Boolean; function Is_Nested (E : Entity_Id) return Boolean;
-- If the function is nested inside some other function, it will always -- If the function is nested inside some other function, it will always
-- be compiled if that function is, so don't add it to the inline list. -- be compiled if that function is, so don't add it to the inline list.
...@@ -171,8 +180,8 @@ package body Inline is ...@@ -171,8 +180,8 @@ package body Inline is
-- function anyway. This is also the case if the function is defined in a -- function anyway. This is also the case if the function is defined in a
-- task body or within an entry (for example, an initialization procedure). -- task body or within an entry (for example, an initialization procedure).
procedure Add_Inlined_Subprogram (Index : Subp_Index); function Number_Of_Statements (Stats : List_Id) return Natural;
-- Add the subprogram to the list of inlined subprogram for the unit -- Return the number of statements in the list
------------------------------ ------------------------------
-- Deferred Cleanup Actions -- -- Deferred Cleanup Actions --
...@@ -415,6 +424,13 @@ package body Inline is ...@@ -415,6 +424,13 @@ package body Inline is
-- --
-- This procedure must be carefully coordinated with the back end. -- This procedure must be carefully coordinated with the back end.
procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id);
-- Append Subp to the list of subprograms inlined by the backend
procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id);
-- Append Subp to the list of subprograms that cannot be inlined by
-- the backend
---------------------------- ----------------------------
-- Back_End_Cannot_Inline -- -- Back_End_Cannot_Inline --
---------------------------- ----------------------------
...@@ -461,6 +477,32 @@ package body Inline is ...@@ -461,6 +477,32 @@ package body Inline is
return False; return False;
end Back_End_Cannot_Inline; end Back_End_Cannot_Inline;
-----------------------------------------
-- Register_Backend_Inlined_Subprogram --
-----------------------------------------
procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id) is
begin
if Backend_Inlined_Subps = No_Elist then
Backend_Inlined_Subps := New_Elmt_List;
end if;
Append_Elmt (Subp, To => Backend_Inlined_Subps);
end Register_Backend_Inlined_Subprogram;
---------------------------------------------
-- Register_Backend_Not_Inlined_Subprogram --
---------------------------------------------
procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id) is
begin
if Backend_Not_Inlined_Subps = No_Elist then
Backend_Not_Inlined_Subps := New_Elmt_List;
end if;
Append_Elmt (Subp, To => Backend_Not_Inlined_Subps);
end Register_Backend_Not_Inlined_Subprogram;
-- Start of processing for Add_Inlined_Subprogram -- Start of processing for Add_Inlined_Subprogram
begin begin
...@@ -480,8 +522,11 @@ package body Inline is ...@@ -480,8 +522,11 @@ package body Inline is
then then
if Back_End_Cannot_Inline (E) then if Back_End_Cannot_Inline (E) then
Set_Is_Inlined (E, False); Set_Is_Inlined (E, False);
Register_Backend_Not_Inlined_Subprogram (E);
else else
Register_Backend_Inlined_Subprogram (E);
if No (Last_Inlined) then if No (Last_Inlined) then
Set_First_Inlined_Subprogram (Cunit (Main_Unit), E); Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
else else
...@@ -490,6 +535,8 @@ package body Inline is ...@@ -490,6 +535,8 @@ package body Inline is
Last_Inlined := E; Last_Inlined := E;
end if; end if;
else
Register_Backend_Not_Inlined_Subprogram (E);
end if; end if;
Inlined.Table (Index).Listed := True; Inlined.Table (Index).Listed := True;
...@@ -850,9 +897,6 @@ package body Inline is ...@@ -850,9 +897,6 @@ package body Inline is
Max_Size : constant := 10; Max_Size : constant := 10;
Stat_Count : Integer := 0; 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; function Has_Excluded_Statement (Stats : List_Id) return Boolean;
-- Check for statements that make inlining not worthwhile: any tasking -- Check for statements that make inlining not worthwhile: any tasking
-- statement, nested at any level. Keep track of total number of -- statement, nested at any level. Keep track of total number of
...@@ -865,13 +909,6 @@ package body Inline is ...@@ -865,13 +909,6 @@ package body Inline is
-- conflict with subsequent inlinings, so that it is unsafe to try to -- conflict with subsequent inlinings, so that it is unsafe to try to
-- inline in such a case. -- inline in such a case.
function Has_Single_Return return Boolean;
-- In general we cannot inline functions that return unconstrained type.
-- However, we can handle such functions if all return statements return
-- a local variable that is the only declaration in the body of the
-- function. In that case the call can be replaced by that local
-- variable as is done for other inlined calls.
function Has_Single_Return_In_GNATprove_Mode return Boolean; function Has_Single_Return_In_GNATprove_Mode return Boolean;
-- This function is called only in GNATprove mode, and it returns -- This function is called only in GNATprove mode, and it returns
-- True if the subprogram has no or a single return statement as -- True if the subprogram has no or a single return statement as
...@@ -888,103 +925,6 @@ package body Inline is ...@@ -888,103 +925,6 @@ package body Inline is
-- unconstrained type, the secondary stack is involved, and it -- unconstrained type, the secondary stack is involved, and it
-- is not worth inlining. -- 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)
then
Cannot_Inline
("cannot inline & (nested function instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Protected_Type_Declaration then
Cannot_Inline
("cannot inline & (nested protected type declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Declaration then
Cannot_Inline
("cannot inline & (nested package declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline
("cannot inline & (nested package instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Subprogram_Body then
Cannot_Inline
("cannot inline & (nested subprogram)?",
D, Subp);
return True;
elsif Nkind (D) = N_Procedure_Instantiation then
Cannot_Inline
("cannot inline & (nested procedure instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Task_Type_Declaration then
Cannot_Inline
("cannot inline & (nested task type declaration)?",
D, Subp);
return True;
end if;
Next (D);
end loop;
return False;
end Has_Excluded_Declaration;
---------------------------- ----------------------------
-- Has_Excluded_Statement -- -- Has_Excluded_Statement --
---------------------------- ----------------------------
...@@ -1012,7 +952,7 @@ package body Inline is ...@@ -1012,7 +952,7 @@ package body Inline is
elsif Nkind (S) = N_Block_Statement then elsif Nkind (S) = N_Block_Statement then
if Present (Declarations (S)) if Present (Declarations (S))
and then Has_Excluded_Declaration (Declarations (S)) and then Has_Excluded_Declaration (Subp, Declarations (S))
then then
return True; return True;
...@@ -1108,89 +1048,6 @@ package body Inline is ...@@ -1108,89 +1048,6 @@ package body Inline is
return False; return False;
end Has_Pending_Instantiation; end Has_Pending_Instantiation;
------------------------
-- Has_Single_Return --
------------------------
function Has_Single_Return return Boolean is
Return_Statement : Node_Id := Empty;
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_Simple_Return_Statement then
if Present (Expression (N))
and then Is_Entity_Name (Expression (N))
then
if No (Return_Statement) then
Return_Statement := N;
return OK;
elsif Chars (Expression (N)) =
Chars (Expression (Return_Statement))
then
return OK;
else
return Abandon;
end if;
-- A return statement within an extended return is a noop
-- after inlining.
elsif No (Expression (N))
and then Nkind (Parent (Parent (N))) =
N_Extended_Return_Statement
then
return OK;
else
-- Expression has wrong form
return Abandon;
end if;
-- We can only inline a build-in-place function if
-- it has a single extended return.
elsif Nkind (N) = N_Extended_Return_Statement then
if No (Return_Statement) then
Return_Statement := N;
return OK;
else
return Abandon;
end if;
else
return OK;
end if;
end Check_Return;
function Check_All_Returns is new Traverse_Func (Check_Return);
-- Start of processing for Has_Single_Return
begin
if Check_All_Returns (N) /= OK then
return False;
elsif Nkind (Return_Statement) = N_Extended_Return_Statement then
return True;
else
return Present (Declarations (N))
and then Present (First (Declarations (N)))
and then Chars (Expression (Return_Statement)) =
Chars (Defining_Identifier (First (Declarations (N))));
end if;
end Has_Single_Return;
----------------------------------------- -----------------------------------------
-- Has_Single_Return_In_GNATprove_Mode -- -- Has_Single_Return_In_GNATprove_Mode --
----------------------------------------- -----------------------------------------
...@@ -1330,7 +1187,7 @@ package body Inline is ...@@ -1330,7 +1187,7 @@ package body Inline is
and then not Is_Access_Type (Etype (Subp)) and then not Is_Access_Type (Etype (Subp))
and then not Is_Constrained (Etype (Subp)) and then not Is_Constrained (Etype (Subp))
then then
if not Has_Single_Return then if not Has_Single_Return (N) then
Cannot_Inline Cannot_Inline
("cannot inline & (unconstrained return type)?", N, Subp); ("cannot inline & (unconstrained return type)?", N, Subp);
return; return;
...@@ -1348,7 +1205,7 @@ package body Inline is ...@@ -1348,7 +1205,7 @@ package body Inline is
end if; end if;
if Present (Declarations (N)) if Present (Declarations (N))
and then Has_Excluded_Declaration (Declarations (N)) and then Has_Excluded_Declaration (Subp, Declarations (N))
then then
return; return;
end if; end if;
...@@ -1502,7 +1359,7 @@ package body Inline is ...@@ -1502,7 +1359,7 @@ package body Inline is
-- Old semantics -- Old semantics
if not Debug_Flag_Dot_K then if not Back_End_Inlining then
-- Do not emit warning if this is a predefined unit which is not -- Do not emit warning if this is a predefined unit which is not
-- the main unit. With validity checks enabled, some predefined -- the main unit. With validity checks enabled, some predefined
...@@ -1939,19 +1796,10 @@ package body Inline is ...@@ -1939,19 +1796,10 @@ package body Inline is
Subp : Entity_Id) return Boolean Subp : Entity_Id) return Boolean
is is
Max_Size : constant := 10; Max_Size : constant := 10;
Stat_Count : Integer := 0;
function Has_Excluded_Contract return Boolean; function Has_Excluded_Contract return Boolean;
-- Check for contracts that cannot be inlined -- Check for contracts that cannot be inlined
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; function Has_Pending_Instantiation return Boolean;
-- Return True if some enclosing body contains instantiations that -- Return True if some enclosing body contains instantiations that
-- appear before the corresponding generic body. -- appear before the corresponding generic body.
...@@ -2046,218 +1894,6 @@ package body Inline is ...@@ -2046,218 +1894,6 @@ package body Inline is
return False; return False;
end Has_Excluded_Contract; end Has_Excluded_Contract;
------------------------------
-- 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)
then
Cannot_Inline
("cannot inline & (nested function instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Protected_Type_Declaration then
Cannot_Inline
("cannot inline & (nested protected type declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Declaration then
Cannot_Inline
("cannot inline & (nested package declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline
("cannot inline & (nested package instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Subprogram_Body then
Cannot_Inline
("cannot inline & (nested subprogram)?",
D, Subp);
return True;
elsif Nkind (D) = N_Procedure_Instantiation then
Cannot_Inline
("cannot inline & (nested procedure instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Task_Type_Declaration then
Cannot_Inline
("cannot inline & (nested task type 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 -- -- Has_Pending_Instantiation --
------------------------------- -------------------------------
...@@ -2513,7 +2149,8 @@ package body Inline is ...@@ -2513,7 +2149,8 @@ package body Inline is
and then ((Optimization_Level > 0 and then ((Optimization_Level > 0
and then Ekind (Spec_Id) = and then Ekind (Spec_Id) =
E_Function) E_Function)
or else Front_End_Inlining)); or else Front_End_Inlining
or else Back_End_Inlining));
Body_To_Analyze : Node_Id; Body_To_Analyze : Node_Id;
...@@ -2540,6 +2177,7 @@ package body Inline is ...@@ -2540,6 +2177,7 @@ package body Inline is
elsif Assertions_Enabled elsif Assertions_Enabled
and then Has_Excluded_Contract and then Has_Excluded_Contract
and then not Back_End_Inlining
then then
return False; return False;
...@@ -2563,7 +2201,7 @@ package body Inline is ...@@ -2563,7 +2201,7 @@ package body Inline is
-- Check excluded declarations -- Check excluded declarations
if Present (Declarations (N)) if Present (Declarations (N))
and then Has_Excluded_Declaration (Declarations (N)) and then Has_Excluded_Declaration (Subp, Declarations (N))
then then
return False; return False;
end if; end if;
...@@ -2581,7 +2219,7 @@ package body Inline is ...@@ -2581,7 +2219,7 @@ package body Inline is
return False; return False;
elsif Has_Excluded_Statement elsif Has_Excluded_Statement
(Statements (Handled_Statement_Sequence (N))) (Subp, Statements (Handled_Statement_Sequence (N)))
then then
return False; return False;
end if; end if;
...@@ -2595,7 +2233,8 @@ package body Inline is ...@@ -2595,7 +2233,8 @@ package body Inline is
if Front_End_Inlining if Front_End_Inlining
and then and then
not (Has_Pragma_Inline_Always (Subp) or else GNATprove_Mode) not (Has_Pragma_Inline_Always (Subp) or else GNATprove_Mode)
and then Stat_Count > Max_Size and then Number_Of_Statements
(Statements (Handled_Statement_Sequence (N))) > Max_Size
then then
Cannot_Inline ("cannot inline& (body too large)?", N, Subp); Cannot_Inline ("cannot inline& (body too large)?", N, Subp);
return False; return False;
...@@ -2663,8 +2302,23 @@ package body Inline is ...@@ -2663,8 +2302,23 @@ package body Inline is
return False; return False;
elsif Returns_Unconstrained_Type (Subp) then elsif Returns_Unconstrained_Type (Subp) then
Cannot_Inline
("cannot inline & (unconstrained return type)?", N, Subp); if Back_End_Inlining
and then Can_Split_Unconstrained_Function (N)
then
return True;
elsif Has_Single_Return (N) then
return True;
-- Otherwise the secondary stack is involved, and it is not
-- worth inlining.
else
Cannot_Inline
("cannot inline & (unconstrained return type)?", N, Subp);
end if;
return False; return False;
end if; end if;
...@@ -2680,7 +2334,7 @@ package body Inline is ...@@ -2680,7 +2334,7 @@ package body Inline is
-- separately (see Can_Split_Unconstrained_Function). -- separately (see Can_Split_Unconstrained_Function).
elsif Returns_Unconstrained_Type (Subp) then elsif Returns_Unconstrained_Type (Subp) then
null; return True;
-- Check supported cases -- Check supported cases
...@@ -3084,7 +2738,7 @@ package body Inline is ...@@ -3084,7 +2738,7 @@ package body Inline is
Build_Body_To_Inline (N, Spec_Id); Build_Body_To_Inline (N, Spec_Id);
Set_Is_Inlined (Spec_Id); Set_Is_Inlined (Spec_Id);
end if; end if;
else elsif not Back_End_Inlining then
Build_Body_To_Inline (N, Spec_Id); Build_Body_To_Inline (N, Spec_Id);
Set_Is_Inlined (Spec_Id); Set_Is_Inlined (Spec_Id);
end if; end if;
...@@ -3678,14 +3332,14 @@ package body Inline is ...@@ -3678,14 +3332,14 @@ package body Inline is
-- expanded into a procedure call which must be added after the -- expanded into a procedure call which must be added after the
-- object declaration. -- object declaration.
if Is_Unc_Decl and then Debug_Flag_Dot_K then if Is_Unc_Decl and then Back_End_Inlining then
Insert_Action_After (Parent (N), Blk); Insert_Action_After (Parent (N), Blk);
else else
Set_Expression (Parent (N), Empty); Set_Expression (Parent (N), Empty);
Insert_After (Parent (N), Blk); Insert_After (Parent (N), Blk);
end if; end if;
elsif Is_Unc and then not Debug_Flag_Dot_K then elsif Is_Unc and then not Back_End_Inlining then
Insert_Before (Parent (N), Blk); Insert_Before (Parent (N), Blk);
end if; end if;
end Rewrite_Function_Call; end Rewrite_Function_Call;
...@@ -3780,7 +3434,7 @@ package body Inline is ...@@ -3780,7 +3434,7 @@ package body Inline is
begin begin
-- Initializations for old/new semantics -- Initializations for old/new semantics
if not Debug_Flag_Dot_K then if not Back_End_Inlining then
Is_Unc := Is_Array_Type (Etype (Subp)) Is_Unc := Is_Array_Type (Etype (Subp))
and then not Is_Constrained (Etype (Subp)); and then not Is_Constrained (Etype (Subp));
Is_Unc_Decl := False; Is_Unc_Decl := False;
...@@ -3824,7 +3478,7 @@ package body Inline is ...@@ -3824,7 +3478,7 @@ package body Inline is
and then and then
Nkind (First (Statements (Handled_Statement_Sequence (Orig_Bod)))) Nkind (First (Statements (Handled_Statement_Sequence (Orig_Bod))))
= N_Extended_Return_Statement = N_Extended_Return_Statement
and then not Debug_Flag_Dot_K and then not Back_End_Inlining
then then
return; return;
end if; end if;
...@@ -3865,7 +3519,7 @@ package body Inline is ...@@ -3865,7 +3519,7 @@ package body Inline is
-- Old semantics -- Old semantics
if not Debug_Flag_Dot_K then if not Back_End_Inlining then
declare declare
Bod : Node_Id; Bod : Node_Id;
...@@ -4189,7 +3843,7 @@ package body Inline is ...@@ -4189,7 +3843,7 @@ package body Inline is
-- of the result of a call to an inlined function that returns -- of the result of a call to an inlined function that returns
-- an unconstrained type -- an unconstrained type
elsif Debug_Flag_Dot_K elsif Back_End_Inlining
and then Nkind (Parent (N)) = N_Object_Declaration and then Nkind (Parent (N)) = N_Object_Declaration
and then Is_Unc and then Is_Unc
then then
...@@ -4429,6 +4083,224 @@ package body Inline is ...@@ -4429,6 +4083,224 @@ package body Inline is
return Unit; return Unit;
end Get_Code_Unit_Entity; end Get_Code_Unit_Entity;
------------------------------
-- Has_Excluded_Declaration --
------------------------------
function Has_Excluded_Declaration
(Subp : Entity_Id;
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_Subprogram_Body then
Cannot_Inline
("cannot inline & (nested subprogram)?",
D, Subp);
return True;
elsif Nkind (D) = N_Task_Type_Declaration
or else Nkind (D) = N_Single_Task_Declaration
then
Cannot_Inline
("cannot inline & (nested task type declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Protected_Type_Declaration
or else Nkind (D) = N_Single_Protected_Declaration
then
Cannot_Inline
("cannot inline & (nested protected type declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Declaration then
Cannot_Inline
("cannot inline & (nested package declaration)?",
D, Subp);
return True;
elsif Nkind (D) = N_Function_Instantiation
and then not Is_Unchecked_Conversion (D)
then
Cannot_Inline
("cannot inline & (nested function instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Procedure_Instantiation then
Cannot_Inline
("cannot inline & (nested procedure instantiation)?",
D, Subp);
return True;
elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline
("cannot inline & (nested package instantiation)?",
D, Subp);
return True;
end if;
Next (D);
end loop;
return False;
end Has_Excluded_Declaration;
----------------------------
-- Has_Excluded_Statement --
----------------------------
function Has_Excluded_Statement
(Subp : Entity_Id;
Stats : List_Id) return Boolean
is
S : Node_Id;
E : Node_Id;
begin
S := First (Stats);
while Present (S) loop
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 (Subp, 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
(Subp, 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 (Subp, Statements (E)) then
return True;
end if;
Next (E);
end loop;
elsif Nkind (S) = N_If_Statement then
if Has_Excluded_Statement (Subp, 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 (Subp, Then_Statements (E)) then
return True;
end if;
Next (E);
end loop;
end if;
if Present (Else_Statements (S))
and then Has_Excluded_Statement (Subp, Else_Statements (S))
then
return True;
end if;
elsif Nkind (S) = N_Loop_Statement
and then Has_Excluded_Statement (Subp, Statements (S))
then
return True;
elsif Nkind (S) = N_Extended_Return_Statement then
if Present (Handled_Statement_Sequence (S))
and then
Has_Excluded_Statement
(Subp, 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_Initialized_Type -- -- Has_Initialized_Type --
-------------------------- --------------------------
...@@ -4457,6 +4329,89 @@ package body Inline is ...@@ -4457,6 +4329,89 @@ package body Inline is
return False; return False;
end Has_Initialized_Type; end Has_Initialized_Type;
------------------------
-- Has_Single_Return --
------------------------
function Has_Single_Return (N : Node_Id) return Boolean is
Return_Statement : Node_Id := Empty;
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_Simple_Return_Statement then
if Present (Expression (N))
and then Is_Entity_Name (Expression (N))
then
if No (Return_Statement) then
Return_Statement := N;
return OK;
elsif Chars (Expression (N)) =
Chars (Expression (Return_Statement))
then
return OK;
else
return Abandon;
end if;
-- A return statement within an extended return is a noop
-- after inlining.
elsif No (Expression (N))
and then
Nkind (Parent (Parent (N))) = N_Extended_Return_Statement
then
return OK;
else
-- Expression has wrong form
return Abandon;
end if;
-- We can only inline a build-in-place function if
-- it has a single extended return.
elsif Nkind (N) = N_Extended_Return_Statement then
if No (Return_Statement) then
Return_Statement := N;
return OK;
else
return Abandon;
end if;
else
return OK;
end if;
end Check_Return;
function Check_All_Returns is new Traverse_Func (Check_Return);
-- Start of processing for Has_Single_Return
begin
if Check_All_Returns (N) /= OK then
return False;
elsif Nkind (Return_Statement) = N_Extended_Return_Statement then
return True;
else
return Present (Declarations (N))
and then Present (First (Declarations (N)))
and then Chars (Expression (Return_Statement)) =
Chars (Defining_Identifier (First (Declarations (N))));
end if;
end Has_Single_Return;
----------------------------- -----------------------------
-- In_Main_Unit_Or_Subunit -- -- In_Main_Unit_Or_Subunit --
----------------------------- -----------------------------
...@@ -4613,6 +4568,24 @@ package body Inline is ...@@ -4613,6 +4568,24 @@ package body Inline is
Inlined.Release; Inlined.Release;
end Lock; end Lock;
--------------------------
-- Number_Of_Statements --
--------------------------
function Number_Of_Statements (Stats : List_Id) return Natural is
Stat_Count : Integer := 0;
Stmt : Node_Id;
begin
Stmt := First (Stats);
while Present (Stmt) loop
Stat_Count := Stat_Count + 1;
Next (Stmt);
end loop;
return Stat_Count;
end Number_Of_Statements;
--------------------------- ---------------------------
-- Register_Backend_Call -- -- Register_Backend_Call --
--------------------------- ---------------------------
......
gcc/ada/inline.ads
...@@ -132,8 +132,16 @@ package Inline is ...@@ -132,8 +132,16 @@ package Inline is
Table_Name => "Pending_Descriptor"); Table_Name => "Pending_Descriptor");
Inlined_Calls : Elist_Id := No_Elist; Inlined_Calls : Elist_Id := No_Elist;
-- List of frontend inlined calls
Backend_Calls : Elist_Id := No_Elist; Backend_Calls : Elist_Id := No_Elist;
-- List of frontend inlined calls and inline calls passed to the backend -- List of inline calls passed to the backend
Backend_Inlined_Subps : Elist_Id := No_Elist;
-- List of subprograms inlined by the backend
Backend_Not_Inlined_Subps : Elist_Id := No_Elist;
-- List of subprograms that cannot be inlined by the backend
----------------- -----------------
-- Subprograms -- -- Subprograms --
...@@ -231,6 +239,17 @@ package Inline is ...@@ -231,6 +239,17 @@ package Inline is
-- expressions in the body must be converted to the desired type (which -- expressions in the body must be converted to the desired type (which
-- is simply not noted in the tree without inline expansion). -- is simply not noted in the tree without inline expansion).
function Has_Excluded_Declaration
(Subp : Entity_Id;
Decls : List_Id) return Boolean;
-- Check for declarations that make inlining not worthwhile inlining Subp
function Has_Excluded_Statement
(Subp : Entity_Id;
Stats : List_Id) return Boolean;
-- Check for statements that make inlining not worthwhile: any tasking
-- statement, nested at any level.
procedure Register_Backend_Call (N : Node_Id); procedure Register_Backend_Call (N : Node_Id);
-- Append N to the list Backend_Calls -- Append N to the list Backend_Calls
......
gcc/ada/nlists.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -149,7 +149,6 @@ package Nlists is ...@@ -149,7 +149,6 @@ package Nlists is
-- No_List. (No_List is not considered to be the same as an empty list). -- No_List. (No_List is not considered to be the same as an empty list).
function List_Length (List : List_Id) return Nat; function List_Length (List : List_Id) return Nat;
pragma Inline (List_Length);
-- Returns number of items in the given list. It is an error to call -- Returns number of items in the given list. It is an error to call
-- this function with No_List (No_List is not considered to be the same -- this function with No_List (No_List is not considered to be the same
-- as an empty list). -- as an empty list).
......
gcc/ada/sem_ch12.adb
...@@ -25,7 +25,6 @@ ...@@ -25,7 +25,6 @@
with Aspects; use Aspects; with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo; with Einfo; use Einfo;
with Elists; use Elists; with Elists; use Elists;
with Errout; use Errout; with Errout; use Errout;
...@@ -3877,7 +3876,7 @@ package body Sem_Ch12 is ...@@ -3877,7 +3876,7 @@ package body Sem_Ch12 is
and then Might_Inline_Subp and then Might_Inline_Subp
and then not Is_Actual_Pack and then not Is_Actual_Pack
then then
if not Debug_Flag_Dot_K if not Back_End_Inlining
and then Front_End_Inlining and then Front_End_Inlining
and then (Is_In_Main_Unit (N) and then (Is_In_Main_Unit (N)
or else In_Main_Context (Current_Scope)) or else In_Main_Context (Current_Scope))
...@@ -3885,7 +3884,7 @@ package body Sem_Ch12 is ...@@ -3885,7 +3884,7 @@ package body Sem_Ch12 is
then then
Inline_Now := True; Inline_Now := True;
elsif Debug_Flag_Dot_K elsif Back_End_Inlining
and then Must_Inline_Subp and then Must_Inline_Subp
and then (Is_In_Main_Unit (N) and then (Is_In_Main_Unit (N)
or else In_Main_Context (Current_Scope)) or else In_Main_Context (Current_Scope))
......
gcc/ada/sem_ch3.adb
...@@ -3514,7 +3514,7 @@ package body Sem_Ch3 is ...@@ -3514,7 +3514,7 @@ package body Sem_Ch3 is
-- declaration without initializing expression and it has been -- declaration without initializing expression and it has been
-- analyzed (see Expand_Inlined_Call). -- analyzed (see Expand_Inlined_Call).
if Debug_Flag_Dot_K if Back_End_Inlining
and then Expander_Active and then Expander_Active
and then Nkind (E) = N_Function_Call and then Nkind (E) = N_Function_Call
and then Nkind (Name (E)) in N_Has_Entity and then Nkind (Name (E)) in N_Has_Entity
......
gcc/ada/sem_ch6.adb
...@@ -3561,56 +3561,75 @@ package body Sem_Ch6 is ...@@ -3561,56 +3561,75 @@ package body Sem_Ch6 is
-- mode where we want to expand some calls in place, even with expansion -- mode where we want to expand some calls in place, even with expansion
-- disabled, since the inlining eases formal verification. -- disabled, since the inlining eases formal verification.
-- Old semantics if not GNATprove_Mode
and then Expander_Active
and then Serious_Errors_Detected = 0
and then Present (Spec_Id)
and then Has_Pragma_Inline (Spec_Id)
then
-- Legacy implementation (relying on frontend inlining)
if not Debug_Flag_Dot_K then if not Back_End_Inlining then
if 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;
-- If the backend inlining is available then at this stage we only -- New implementation (relying on backend inlining). Enabled by
-- have to mark the subprogram as inlined. The expander will take -- debug flag gnatd.z for testing
-- care of registering it in the table of subprograms inlined by
-- the backend a part of processing calls to it (cf. Expand_Call)
if Present (Spec_Id) else
and then Expander_Active if Has_Pragma_Inline_Always (Spec_Id)
and then Back_End_Inlining or else Optimization_Level > 0
then then
Set_Is_Inlined (Spec_Id); -- Handle function returning an unconstrained type
elsif Present (Spec_Id) if Comes_From_Source (Body_Id)
and then Expander_Active and then Ekind (Spec_Id) = E_Function
and then and then Returns_Unconstrained_Type (Spec_Id)
(Has_Pragma_Inline_Always (Spec_Id) then
or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining)) Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id);
then
Build_Body_To_Inline (N, Spec_Id); else
declare
-- In GNATprove mode, inline only when there is a separate subprogram Body_Spec : constant Node_Id := Parent (Body_Id);
-- declaration for now, as inlining of subprogram bodies acting as Subp_Body : constant Node_Id := Parent (Body_Spec);
-- declarations, or subprogram stubs, are not supported by frontend Subp_Decl : constant List_Id := Declarations (Subp_Body);
-- inlining. This inlining should occur after analysis of the body,
-- so that it is known whether the value of SPARK_Mode applicable to
-- the body, which can be defined by a pragma inside the body.
elsif GNATprove_Mode
and then Full_Analysis
and then not Inside_A_Generic
and then Present (Spec_Id)
and then
Nkind (Parent (Parent (Spec_Id))) = N_Subprogram_Declaration
and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id)
and then not Body_Has_Contract
then
Build_Body_To_Inline (N, Spec_Id);
end if;
-- New semantics (enabled by debug flag gnatd.k for testing) begin
-- Do not pass inlining to the backend if the subprogram
-- has declarations or statements which cannot be inlined
-- by the backend. This check is done here to emit an
-- error instead of the generic warning message reported
-- by the GCC backend (ie. "function might not be
-- inlinable").
if Present (Subp_Decl)
and then Has_Excluded_Declaration (Spec_Id, Subp_Decl)
then
null;
elsif Expander_Active elsif Has_Excluded_Statement
and then Serious_Errors_Detected = 0 (Spec_Id,
and then Present (Spec_Id) Statements
and then Has_Pragma_Inline (Spec_Id) (Handled_Statement_Sequence (Subp_Body)))
then then
Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id); null;
-- If the backend inlining is available then at this
-- stage we only have to mark the subprogram as inlined.
-- The expander will take care of registering it in the
-- table of subprograms inlined by the backend a part of
-- processing calls to it (cf. Expand_Call)
else
Set_Is_Inlined (Spec_Id);
end if;
end;
end if;
end if;
end if;
-- In GNATprove mode, inline only when there is a separate subprogram -- In GNATprove mode, inline only when there is a separate subprogram
-- declaration for now, as inlining of subprogram bodies acting as -- declaration for now, as inlining of subprogram bodies acting as
...@@ -3627,7 +3646,7 @@ package body Sem_Ch6 is ...@@ -3627,7 +3646,7 @@ package body Sem_Ch6 is
and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id) and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id)
and then not Body_Has_Contract and then not Body_Has_Contract
then then
Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id); Build_Body_To_Inline (N, Spec_Id);
end if; end if;
-- Ada 2005 (AI-262): In library subprogram bodies, after the analysis -- Ada 2005 (AI-262): In library subprogram bodies, after the analysis
......
gcc/ada/sem_res.adb
...@@ -5935,18 +5935,9 @@ package body Sem_Res is ...@@ -5935,18 +5935,9 @@ package body Sem_Res is
-- check for this by traversing the type in Check_Initialization_Call. -- check for this by traversing the type in Check_Initialization_Call.
if Is_Inlined (Nam) if Is_Inlined (Nam)
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 Has_Pragma_Inline (Nam)
and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
and then Present (Body_To_Inline (Unit_Declaration_Node (Nam))) and then Present (Body_To_Inline (Unit_Declaration_Node (Nam)))
and then Debug_Flag_Dot_K
then then
null; null;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment