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>
* einfo.adb: Remove VMS specific code.
......@@ -14,6 +47,7 @@
* gcc-interface/trans.c, gcc-interface/misc.c: Remove references
to VMS. Misc clean ups.
* gcc-interface/Makefile.in (gnatlib-shared-vms): Remove.
2014-07-31 Robert Dewar <dewar@adacore.com>
......
gcc/ada/debug.adb
......@@ -101,7 +101,7 @@ package body Debug is
-- d.h
-- d.i Ignore Warnings pragmas
-- 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.m For -gnatl, print full source only for main unit
-- d.n Print source file names
......@@ -533,10 +533,6 @@ package body Debug is
-- to the backend. This is useful to locate skipped calls that must be
-- inlined by the frontend.
-- d.k Enable new semantics of frontend inlining. This is useful to test
-- this new feature in all the platforms. 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
-- used to work around the incompatibility introduced by AI-318-2.
-- It is useful only in -gnat05 mode.
......
gcc/ada/exp_ch6.adb
......@@ -3830,15 +3830,14 @@ package body Exp_Ch6 is
return;
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
Add_Inlined_Body (Subp);
Register_Backend_Call (Call_Node);
if not Is_Inlined (Subp) then
null;
-- 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
Bod : Node_Id;
Must_Inline : Boolean := False;
......@@ -3924,9 +3923,22 @@ package body Exp_Ch6 is
end if;
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
Spec : constant Node_Id := Unit_Declaration_Node (Subp);
......@@ -9720,6 +9732,70 @@ package body Exp_Ch6 is
Next_Elmt (Elmt);
end loop;
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 Exp_Ch6;
gcc/ada/inline.adb
......@@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
......@@ -143,27 +142,37 @@ package body Inline is
-- 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);
-- Make two entries in Inlined table, for an inlined subprogram being
-- called, and for the inlined subprogram that contains the call. If
-- 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;
-- Make entry in Inlined table for subprogram E, or return table index
-- 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;
-- If a candidate for inlining contains type declarations for types with
-- 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;
-- 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.
......@@ -171,8 +180,8 @@ package body Inline is
-- 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).
procedure Add_Inlined_Subprogram (Index : Subp_Index);
-- Add the subprogram to the list of inlined subprogram for the unit
function Number_Of_Statements (Stats : List_Id) return Natural;
-- Return the number of statements in the list
------------------------------
-- Deferred Cleanup Actions --
......@@ -415,6 +424,13 @@ package body Inline is
--
-- 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 --
----------------------------
......@@ -461,6 +477,32 @@ package body Inline is
return False;
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
begin
......@@ -480,8 +522,11 @@ package body Inline is
then
if Back_End_Cannot_Inline (E) then
Set_Is_Inlined (E, False);
Register_Backend_Not_Inlined_Subprogram (E);
else
Register_Backend_Inlined_Subprogram (E);
if No (Last_Inlined) then
Set_First_Inlined_Subprogram (Cunit (Main_Unit), E);
else
......@@ -490,6 +535,8 @@ package body Inline is
Last_Inlined := E;
end if;
else
Register_Backend_Not_Inlined_Subprogram (E);
end if;
Inlined.Table (Index).Listed := True;
......@@ -850,9 +897,6 @@ package body Inline is
Max_Size : constant := 10;
Stat_Count : Integer := 0;
function Has_Excluded_Declaration (Decls : List_Id) return Boolean;
-- Check for declarations that make inlining not worthwhile
function Has_Excluded_Statement (Stats : List_Id) return Boolean;
-- Check for statements that make inlining not worthwhile: any tasking
-- statement, nested at any level. Keep track of total number of
......@@ -865,13 +909,6 @@ package body Inline is
-- conflict with subsequent inlinings, so that it is unsafe to try to
-- 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;
-- This function is called only in GNATprove mode, and it returns
-- True if the subprogram has no or a single return statement as
......@@ -888,103 +925,6 @@ package body Inline is
-- unconstrained type, the secondary stack is involved, and it
-- is not worth inlining.
------------------------------
-- Has_Excluded_Declaration --
------------------------------
function Has_Excluded_Declaration (Decls : List_Id) return Boolean is
D : Node_Id;
function Is_Unchecked_Conversion (D : Node_Id) return Boolean;
-- Nested subprograms make a given body ineligible for inlining, but
-- we make an exception for instantiations of unchecked conversion.
-- The body has not been analyzed yet, so check the name, and verify
-- that the visible entity with that name is the predefined unit.
-----------------------------
-- Is_Unchecked_Conversion --
-----------------------------
function Is_Unchecked_Conversion (D : Node_Id) return Boolean is
Id : constant Node_Id := Name (D);
Conv : Entity_Id;
begin
if Nkind (Id) = N_Identifier
and then Chars (Id) = Name_Unchecked_Conversion
then
Conv := Current_Entity (Id);
elsif Nkind_In (Id, N_Selected_Component, N_Expanded_Name)
and then Chars (Selector_Name (Id)) = Name_Unchecked_Conversion
then
Conv := Current_Entity (Selector_Name (Id));
else
return False;
end if;
return Present (Conv)
and then Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Conv)))
and then Is_Intrinsic_Subprogram (Conv);
end Is_Unchecked_Conversion;
-- Start of processing for Has_Excluded_Declaration
begin
D := First (Decls);
while Present (D) loop
if Nkind (D) = N_Function_Instantiation
and then not Is_Unchecked_Conversion (D)
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 --
----------------------------
......@@ -1012,7 +952,7 @@ package body Inline is
elsif Nkind (S) = N_Block_Statement then
if Present (Declarations (S))
and then Has_Excluded_Declaration (Declarations (S))
and then Has_Excluded_Declaration (Subp, Declarations (S))
then
return True;
......@@ -1108,89 +1048,6 @@ package body Inline is
return False;
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 --
-----------------------------------------
......@@ -1330,7 +1187,7 @@ package body Inline is
and then not Is_Access_Type (Etype (Subp))
and then not Is_Constrained (Etype (Subp))
then
if not Has_Single_Return then
if not Has_Single_Return (N) then
Cannot_Inline
("cannot inline & (unconstrained return type)?", N, Subp);
return;
......@@ -1348,7 +1205,7 @@ package body Inline is
end if;
if Present (Declarations (N))
and then Has_Excluded_Declaration (Declarations (N))
and then Has_Excluded_Declaration (Subp, Declarations (N))
then
return;
end if;
......@@ -1502,7 +1359,7 @@ package body Inline is
-- 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
-- the main unit. With validity checks enabled, some predefined
......@@ -1939,19 +1796,10 @@ package body Inline is
Subp : Entity_Id) return Boolean
is
Max_Size : constant := 10;
Stat_Count : Integer := 0;
function Has_Excluded_Contract return Boolean;
-- 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;
-- Return True if some enclosing body contains instantiations that
-- appear before the corresponding generic body.
......@@ -2046,218 +1894,6 @@ package body Inline is
return False;
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 --
-------------------------------
......@@ -2513,7 +2149,8 @@ package body Inline is
and then ((Optimization_Level > 0
and then Ekind (Spec_Id) =
E_Function)
or else Front_End_Inlining));
or else Front_End_Inlining
or else Back_End_Inlining));
Body_To_Analyze : Node_Id;
......@@ -2540,6 +2177,7 @@ package body Inline is
elsif Assertions_Enabled
and then Has_Excluded_Contract
and then not Back_End_Inlining
then
return False;
......@@ -2563,7 +2201,7 @@ package body Inline is
-- Check excluded declarations
if Present (Declarations (N))
and then Has_Excluded_Declaration (Declarations (N))
and then Has_Excluded_Declaration (Subp, Declarations (N))
then
return False;
end if;
......@@ -2581,7 +2219,7 @@ package body Inline is
return False;
elsif Has_Excluded_Statement
(Statements (Handled_Statement_Sequence (N)))
(Subp, Statements (Handled_Statement_Sequence (N)))
then
return False;
end if;
......@@ -2595,7 +2233,8 @@ package body Inline is
if Front_End_Inlining
and then
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
Cannot_Inline ("cannot inline& (body too large)?", N, Subp);
return False;
......@@ -2663,8 +2302,23 @@ package body Inline is
return False;
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;
end if;
......@@ -2680,7 +2334,7 @@ package body Inline is
-- separately (see Can_Split_Unconstrained_Function).
elsif Returns_Unconstrained_Type (Subp) then
null;
return True;
-- Check supported cases
......@@ -3084,7 +2738,7 @@ package body Inline is
Build_Body_To_Inline (N, Spec_Id);
Set_Is_Inlined (Spec_Id);
end if;
else
elsif not Back_End_Inlining then
Build_Body_To_Inline (N, Spec_Id);
Set_Is_Inlined (Spec_Id);
end if;
......@@ -3678,14 +3332,14 @@ package body Inline is
-- expanded into a procedure call which must be added after the
-- object declaration.
if Is_Unc_Decl and then Debug_Flag_Dot_K then
if Is_Unc_Decl and then Back_End_Inlining then
Insert_Action_After (Parent (N), Blk);
else
Set_Expression (Parent (N), Empty);
Insert_After (Parent (N), Blk);
end if;
elsif Is_Unc and then not Debug_Flag_Dot_K then
elsif Is_Unc and then not Back_End_Inlining then
Insert_Before (Parent (N), Blk);
end if;
end Rewrite_Function_Call;
......@@ -3780,7 +3434,7 @@ package body Inline is
begin
-- 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))
and then not Is_Constrained (Etype (Subp));
Is_Unc_Decl := False;
......@@ -3824,7 +3478,7 @@ package body Inline is
and then
Nkind (First (Statements (Handled_Statement_Sequence (Orig_Bod))))
= N_Extended_Return_Statement
and then not Debug_Flag_Dot_K
and then not Back_End_Inlining
then
return;
end if;
......@@ -3865,7 +3519,7 @@ package body Inline is
-- Old semantics
if not Debug_Flag_Dot_K then
if not Back_End_Inlining then
declare
Bod : Node_Id;
......@@ -4189,7 +3843,7 @@ package body Inline is
-- of the result of a call to an inlined function that returns
-- an unconstrained type
elsif Debug_Flag_Dot_K
elsif Back_End_Inlining
and then Nkind (Parent (N)) = N_Object_Declaration
and then Is_Unc
then
......@@ -4429,6 +4083,224 @@ package body Inline is
return Unit;
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 --
--------------------------
......@@ -4457,6 +4329,89 @@ package body Inline is
return False;
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 --
-----------------------------
......@@ -4613,6 +4568,24 @@ package body Inline is
Inlined.Release;
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 --
---------------------------
......
gcc/ada/inline.ads
......@@ -132,8 +132,16 @@ package Inline is
Table_Name => "Pending_Descriptor");
Inlined_Calls : Elist_Id := No_Elist;
-- List of frontend inlined calls
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 --
......@@ -231,6 +239,17 @@ package Inline is
-- expressions in the body must be converted to the desired type (which
-- 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);
-- Append N to the list Backend_Calls
......
gcc/ada/nlists.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -149,7 +149,6 @@ package Nlists is
-- No_List. (No_List is not considered to be the same as an empty list).
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
-- this function with No_List (No_List is not considered to be the same
-- as an empty list).
......
gcc/ada/sem_ch12.adb
......@@ -25,7 +25,6 @@
with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
......@@ -3877,7 +3876,7 @@ package body Sem_Ch12 is
and then Might_Inline_Subp
and then not Is_Actual_Pack
then
if not Debug_Flag_Dot_K
if not Back_End_Inlining
and then Front_End_Inlining
and then (Is_In_Main_Unit (N)
or else In_Main_Context (Current_Scope))
......@@ -3885,7 +3884,7 @@ package body Sem_Ch12 is
then
Inline_Now := True;
elsif Debug_Flag_Dot_K
elsif Back_End_Inlining
and then Must_Inline_Subp
and then (Is_In_Main_Unit (N)
or else In_Main_Context (Current_Scope))
......
gcc/ada/sem_ch3.adb
......@@ -3514,7 +3514,7 @@ package body Sem_Ch3 is
-- declaration without initializing expression and it has been
-- analyzed (see Expand_Inlined_Call).
if Debug_Flag_Dot_K
if Back_End_Inlining
and then Expander_Active
and then Nkind (E) = N_Function_Call
and then Nkind (Name (E)) in N_Has_Entity
......
gcc/ada/sem_ch6.adb
......@@ -3561,56 +3561,75 @@ package body Sem_Ch6 is
-- mode where we want to expand some calls in place, even with expansion
-- 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
-- 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)
-- New implementation (relying on backend inlining). Enabled by
-- debug flag gnatd.z for testing
if Present (Spec_Id)
and then Expander_Active
and then Back_End_Inlining
then
Set_Is_Inlined (Spec_Id);
else
if Has_Pragma_Inline_Always (Spec_Id)
or else Optimization_Level > 0
then
-- Handle function returning an unconstrained type
elsif Present (Spec_Id)
and then Expander_Active
and then
(Has_Pragma_Inline_Always (Spec_Id)
or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining))
then
Build_Body_To_Inline (N, Spec_Id);
-- In GNATprove mode, inline only when there is a separate subprogram
-- declaration for now, as inlining of subprogram bodies acting as
-- declarations, or subprogram stubs, are not supported by frontend
-- 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;
if Comes_From_Source (Body_Id)
and then Ekind (Spec_Id) = E_Function
and then Returns_Unconstrained_Type (Spec_Id)
then
Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id);
else
declare
Body_Spec : constant Node_Id := Parent (Body_Id);
Subp_Body : constant Node_Id := Parent (Body_Spec);
Subp_Decl : constant List_Id := Declarations (Subp_Body);
-- 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
and then Serious_Errors_Detected = 0
and then Present (Spec_Id)
and then Has_Pragma_Inline (Spec_Id)
then
Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id);
elsif Has_Excluded_Statement
(Spec_Id,
Statements
(Handled_Statement_Sequence (Subp_Body)))
then
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
-- declaration for now, as inlining of subprogram bodies acting as
......@@ -3627,7 +3646,7 @@ package body Sem_Ch6 is
and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id)
and then not Body_Has_Contract
then
Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id);
Build_Body_To_Inline (N, Spec_Id);
end if;
-- 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
-- check for this by traversing the type in Check_Initialization_Call.
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 Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
and then Present (Body_To_Inline (Unit_Declaration_Node (Nam)))
and then Debug_Flag_Dot_K
then
null;
......
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