Commit 4b96d386 by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Compiler speedup with inlining across units

This change is aimed at speeding up the inlining across units done by
the Ada compiler when -gnatn is specified and in the presence of units
instantiating a lot of generic packages.

The current implementation is as follows: when a generic package is
being instantiated, the compiler scans its spec for the presence of
subprograms with an aspect/pragma Inline and, upon finding one,
schedules the instantiation of its body.  That's not very efficient
because the compiler doesn't know yet if one of those inlined
subprograms will eventually be called from the main unit.

The new implementation arranges for the compiler to instantiate the body
on demand, i.e. when it encounters a call to one of the inlined
subprograms.  That's still not optimal because, at this point, the
compiler has not yet computed whether the call itself is reachable from
the main unit (it will do this computation at the very end of the
processing, just before sending the inlined units to the code generator)
but that's nevertheless a net progress.

The patch also enhances the -gnatd.j option to make it output the list
of instances "inlined" this way.  The following package is a simple
example:

with Q;

procedure P is
begin
  Q.Proc;
end;

package Q is

  procedure Proc;
  pragma Inline (Proc);

end Q;

with G;

package body Q is

  package My_G is new G (1);

  procedure Proc is
    Val : constant Integer := My_G.Func;
  begin
    if Val /= 1 then
      raise Program_Error;
    end if;
  end;

end Q;

generic

  Value : Integer;

package G is

  function Func return Integer;
  pragma Inline (Func);

end G;

package body G is

  function Func return Integer is
  begin
    return Value;
  end;

end G;

2019-08-14  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* einfo.ads (Is_Called): Document new usage on E_Package
	entities.
	* einfo.adb (Is_Called): Accept E_Package entities.
	(Set_Is_Called): Likewise.
	* exp_ch6.adb (Expand_Call_Helper): Move code dealing with
	instances for back-end inlining to Add_Inlined_Body.
	* inline.ads: Remove with clauses for Alloc and Table.
	(Pending_Instantiations): Move to...
	* inline.adb: Add with clauses for Alloc, Uintp, Table and
	GNAT.HTable.
	(Backend_Instances): New variable.
	(Pending_Instantiations): ...here.
	(Called_Pending_Instantiations): New table.
	(Node_Table_Size): New constant.
	(Node_Header_Num): New subtype.
	(Node_Hash): New function.
	(To_Pending_Instantiations): New hash table.
	(Add_Inlined_Body): Bail out early for subprograms in the main
	unit or subunit.  Likewise if the Is_Called flag is set.  If the
	subprogram is an instance, invoke Add_Inlined_Instance.  Call
	Set_Is_Called earlier.  If the subrogram is within an instance,
	invoke Add_Inlined_Instance.  Also deal with the case where the
	call itself is within an instance.
	(Add_Inlined_Instance): New procedure.
	(Add_Inlined_Subprogram): Remove conditions always fulfilled.
	(Add_Pending_Instantiation): Move the defence against ludicruous
	number of instantiations to here. When back-end inlining is
	enabled, associate an instantiation with its index in table and
	mark a few selected kinds of instantiations as always needed.
	(Initialize): Set Backend_Instances to No_Elist.
	(Instantiate_Body): New procedure doing the work extracted
	from...
	(Instantiate_Bodies): ...here.  When back-end inlining is
	enabled, loop over Called_Pending_Instantiations instead of
	Pending_Instantiations.
	(Is_Nested): Minor tweak.
	(List_Inlining_Info): Also list the contents of
	Backend_Instances.
	* sem_ch12.adb (Might_Inline_Subp): Return early if Is_Inlined
	is set and otherwise set it before returning true.
	(Analyze_Package_Instantiation): Remove the defence against
	ludicruous number of instantiations.  Invoke
	Remove_Dead_Instance instead of doing the removal manually if
	there is a guaranteed ABE.

From-SVN: r274465
parent 72e324b6
2019-08-14 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads (Is_Called): Document new usage on E_Package
entities.
* einfo.adb (Is_Called): Accept E_Package entities.
(Set_Is_Called): Likewise.
* exp_ch6.adb (Expand_Call_Helper): Move code dealing with
instances for back-end inlining to Add_Inlined_Body.
* inline.ads: Remove with clauses for Alloc and Table.
(Pending_Instantiations): Move to...
* inline.adb: Add with clauses for Alloc, Uintp, Table and
GNAT.HTable.
(Backend_Instances): New variable.
(Pending_Instantiations): ...here.
(Called_Pending_Instantiations): New table.
(Node_Table_Size): New constant.
(Node_Header_Num): New subtype.
(Node_Hash): New function.
(To_Pending_Instantiations): New hash table.
(Add_Inlined_Body): Bail out early for subprograms in the main
unit or subunit. Likewise if the Is_Called flag is set. If the
subprogram is an instance, invoke Add_Inlined_Instance. Call
Set_Is_Called earlier. If the subrogram is within an instance,
invoke Add_Inlined_Instance. Also deal with the case where the
call itself is within an instance.
(Add_Inlined_Instance): New procedure.
(Add_Inlined_Subprogram): Remove conditions always fulfilled.
(Add_Pending_Instantiation): Move the defence against ludicruous
number of instantiations to here. When back-end inlining is
enabled, associate an instantiation with its index in table and
mark a few selected kinds of instantiations as always needed.
(Initialize): Set Backend_Instances to No_Elist.
(Instantiate_Body): New procedure doing the work extracted
from...
(Instantiate_Bodies): ...here. When back-end inlining is
enabled, loop over Called_Pending_Instantiations instead of
Pending_Instantiations.
(Is_Nested): Minor tweak.
(List_Inlining_Info): Also list the contents of
Backend_Instances.
* sem_ch12.adb (Might_Inline_Subp): Return early if Is_Inlined
is set and otherwise set it before returning true.
(Analyze_Package_Instantiation): Remove the defence against
ludicruous number of instantiations. Invoke
Remove_Dead_Instance instead of doing the removal manually if
there is a guaranteed ABE.
2019-08-14 Gary Dismukes <dismukes@adacore.com> 2019-08-14 Gary Dismukes <dismukes@adacore.com>
* exp_ch3.adb (Predef_Spec_Or_Body): For an equality operation * exp_ch3.adb (Predef_Spec_Or_Body): For an equality operation
......
...@@ -2140,7 +2140,7 @@ package body Einfo is ...@@ -2140,7 +2140,7 @@ package body Einfo is
function Is_Called (Id : E) return B is function Is_Called (Id : E) return B is
begin begin
pragma Assert (Ekind_In (Id, E_Procedure, E_Function)); pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package));
return Flag102 (Id); return Flag102 (Id);
end Is_Called; end Is_Called;
...@@ -5344,7 +5344,7 @@ package body Einfo is ...@@ -5344,7 +5344,7 @@ package body Einfo is
procedure Set_Is_Called (Id : E; V : B := True) is procedure Set_Is_Called (Id : E; V : B := True) is
begin begin
pragma Assert (Ekind_In (Id, E_Procedure, E_Function)); pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package));
Set_Flag102 (Id, V); Set_Flag102 (Id, V);
end Set_Is_Called; end Set_Is_Called;
......
...@@ -2366,9 +2366,9 @@ package Einfo is ...@@ -2366,9 +2366,9 @@ package Einfo is
-- i.e. Standard.Boolean and all types ultimately derived from it. -- i.e. Standard.Boolean and all types ultimately derived from it.
-- Is_Called (Flag102) -- Is_Called (Flag102)
-- Defined in subprograms. Returns true if the subprogram is called -- Defined in subprograms and packages. Set if a subprogram is called
-- in the unit being compiled or in a unit in the context. Used for -- from the unit being compiled or a unit in the closure. Also set for
-- inlining. -- a package that contains called subprograms. Used only for inlining.
-- Is_Character_Type (Flag63) -- Is_Character_Type (Flag63)
-- Defined in all entities. Set for character types and subtypes, -- Defined in all entities. Set for character types and subtypes,
...@@ -6406,12 +6406,13 @@ package Einfo is ...@@ -6406,12 +6406,13 @@ package Einfo is
-- Has_Master_Entity (Flag21) -- Has_Master_Entity (Flag21)
-- Has_RACW (Flag214) (non-generic case only) -- Has_RACW (Flag214) (non-generic case only)
-- Ignore_SPARK_Mode_Pragmas (Flag301) -- Ignore_SPARK_Mode_Pragmas (Flag301)
-- In_Package_Body (Flag48) -- Is_Called (Flag102) (non-generic case only)
-- In_Use (Flag8)
-- Is_Elaboration_Checks_OK_Id (Flag148) -- Is_Elaboration_Checks_OK_Id (Flag148)
-- Is_Elaboration_Warnings_OK_Id (Flag304) -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Instantiated (Flag126) -- Is_Instantiated (Flag126)
-- In_Package_Body (Flag48)
-- Is_Private_Descendant (Flag53) -- Is_Private_Descendant (Flag53)
-- In_Use (Flag8)
-- Is_Visible_Lib_Unit (Flag116) -- Is_Visible_Lib_Unit (Flag116)
-- Renamed_In_Spec (Flag231) (non-generic case only) -- Renamed_In_Spec (Flag231) (non-generic case only)
-- SPARK_Aux_Pragma_Inherited (Flag266) -- SPARK_Aux_Pragma_Inherited (Flag266)
......
...@@ -4443,62 +4443,6 @@ package body Exp_Ch6 is ...@@ -4443,62 +4443,6 @@ package body Exp_Ch6 is
or else Has_Pragma_Inline_Always (Subp) or else Has_Pragma_Inline_Always (Subp)
then then
Add_Inlined_Body (Subp, Call_Node); Add_Inlined_Body (Subp, Call_Node);
-- If the inlined call appears within an instance, then ensure
-- that the enclosing instance body is available so the back end
-- can actually perform the inlining.
if In_Instance and then Comes_From_Source (Subp) then
declare
Decl : Node_Id;
Inst : Entity_Id;
Inst_Node : Node_Id;
begin
Inst := Scope (Subp);
-- Find enclosing instance
while Present (Inst) and then Inst /= Standard_Standard loop
exit when Is_Generic_Instance (Inst);
Inst := Scope (Inst);
end loop;
if Present (Inst)
and then Is_Generic_Instance (Inst)
and then not Is_Inlined (Inst)
then
Set_Is_Inlined (Inst);
Decl := Unit_Declaration_Node (Inst);
-- Do not add a pending instantiation if the body exits
-- already, or if the instance is a compilation unit, or
-- the instance node is missing.
if Present (Corresponding_Body (Decl))
or else Nkind (Parent (Decl)) = N_Compilation_Unit
or else No (Next (Decl))
then
null;
else
-- The instantiation node usually follows the package
-- declaration for the instance. If the generic unit
-- has aspect specifications, they are transformed
-- into pragmas in the instance, and the instance node
-- appears after them.
Inst_Node := Next (Decl);
while Nkind (Inst_Node) /= N_Package_Instantiation loop
Inst_Node := Next (Inst_Node);
end loop;
Add_Pending_Instantiation (Inst_Node, Decl);
end if;
end if;
end;
end if;
end if; end if;
end if; end if;
......
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Alloc;
with Aspects; use Aspects; with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Debug; use Debug; with Debug; use Debug;
...@@ -51,8 +52,12 @@ with Sinfo; use Sinfo; ...@@ -51,8 +52,12 @@ with Sinfo; use Sinfo;
with Sinput; use Sinput; with Sinput; use Sinput;
with Snames; use Snames; with Snames; use Snames;
with Stand; use Stand; with Stand; use Stand;
with Uname; use Uname; with Table;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Uname; use Uname;
with GNAT.HTable;
package body Inline is package body Inline is
...@@ -82,12 +87,83 @@ package body Inline is ...@@ -82,12 +87,83 @@ package body Inline is
Backend_Calls : Elist_Id; Backend_Calls : Elist_Id;
-- List of inline calls passed to the backend -- List of inline calls passed to the backend
Backend_Instances : Elist_Id;
-- List of instances inlined for the backend
Backend_Inlined_Subps : Elist_Id; Backend_Inlined_Subps : Elist_Id;
-- List of subprograms inlined by the backend -- List of subprograms inlined by the backend
Backend_Not_Inlined_Subps : Elist_Id; Backend_Not_Inlined_Subps : Elist_Id;
-- List of subprograms that cannot be inlined by the backend -- List of subprograms that cannot be inlined by the backend
-----------------------------
-- Pending_Instantiations --
-----------------------------
-- We make entries in this table for the pending instantiations of generic
-- bodies that are created during semantic analysis. After the analysis is
-- complete, calling Instantiate_Bodies performs the actual instantiations.
package Pending_Instantiations is new Table.Table (
Table_Component_Type => Pending_Body_Info,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Pending_Instantiations_Initial,
Table_Increment => Alloc.Pending_Instantiations_Increment,
Table_Name => "Pending_Instantiations");
-------------------------------------
-- Called_Pending_Instantiations --
-------------------------------------
-- With back-end inlining, the pending instantiations that are not in the
-- main unit or subunit are performed only after a call to the subprogram
-- instance, or to a subprogram within the package instance, is inlined.
-- Since such a call can be within a subsequent pending instantiation,
-- we make entries in this table that stores the index of these "called"
-- pending instantiations and perform them when the table is populated.
package Called_Pending_Instantiations is new Table.Table (
Table_Component_Type => Int,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Pending_Instantiations_Initial,
Table_Increment => Alloc.Pending_Instantiations_Increment,
Table_Name => "Called_Pending_Instantiations");
---------------------------------
-- To_Pending_Instantiations --
---------------------------------
-- With back-end inlining, we also need to have a map from the pending
-- instantiations to their index in the Pending_Instantiations table.
Node_Table_Size : constant := 257;
-- Number of headers in hash table
subtype Node_Header_Num is Integer range 0 .. Node_Table_Size - 1;
-- Range of headers in hash table
function Node_Hash (Id : Node_Id) return Node_Header_Num;
-- Simple hash function for Node_Ids
package To_Pending_Instantiations is new GNAT.Htable.Simple_HTable
(Header_Num => Node_Header_Num,
Element => Int,
No_Element => -1,
Key => Node_Id,
Hash => Node_Hash,
Equal => "=");
-----------------
-- Node_Hash --
-----------------
function Node_Hash (Id : Node_Id) return Node_Header_Num is
begin
return Node_Header_Num (Id mod Node_Table_Size);
end Node_Hash;
-------------------- --------------------
-- Inlined Bodies -- -- Inlined Bodies --
-------------------- --------------------
...@@ -179,8 +255,11 @@ package body Inline is ...@@ -179,8 +255,11 @@ package body Inline is
-- 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_Instance (E : Entity_Id);
-- Add instance E to the list of of inlined instances for the unit
procedure Add_Inlined_Subprogram (E : Entity_Id); procedure Add_Inlined_Subprogram (E : Entity_Id);
-- Add subprogram E to the list of inlined subprogram for the unit -- Add subprogram E to the list of inlined subprograms 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
...@@ -429,6 +508,9 @@ package body Inline is ...@@ -429,6 +508,9 @@ package body Inline is
return Dont_Inline; return Dont_Inline;
end Must_Inline; end Must_Inline;
Inst : Entity_Id;
Inst_Decl : Node_Id;
Inst_Node : Node_Id;
Level : Inline_Level_Type; Level : Inline_Level_Type;
-- Start of processing for Add_Inlined_Body -- Start of processing for Add_Inlined_Body
...@@ -436,10 +518,12 @@ package body Inline is ...@@ -436,10 +518,12 @@ package body Inline is
begin begin
Append_New_Elmt (N, To => Backend_Calls); Append_New_Elmt (N, To => Backend_Calls);
-- Skip subprograms that cannot be inlined outside their unit -- Skip subprograms that cannot or need not be inlined outside their
-- unit or parent subprogram.
if Is_Abstract_Subprogram (E) if Is_Abstract_Subprogram (E)
or else Convention (E) = Convention_Protected or else Convention (E) = Convention_Protected
or else In_Main_Unit_Or_Subunit (E)
or else Is_Nested (E) or else Is_Nested (E)
then then
return; return;
...@@ -456,6 +540,22 @@ package body Inline is ...@@ -456,6 +540,22 @@ package body Inline is
return; return;
end if; end if;
-- If a previous call to the subprogram has been inlined, nothing to do
if Is_Called (E) then
return;
end if;
-- If the subprogram is an instance, then inline the instance
if Is_Generic_Instance (E) then
Add_Inlined_Instance (E);
end if;
-- Mark the subprogram as called
Set_Is_Called (E);
-- If the call was generated by the compiler and is to a subprogram in -- If the call was generated by the compiler and is to a subprogram in
-- a run-time unit, we need to suppress debugging information for it, -- a run-time unit, we need to suppress debugging information for it,
-- so that the code that is eventually inlined will not affect the -- so that the code that is eventually inlined will not affect the
...@@ -476,7 +576,6 @@ package body Inline is ...@@ -476,7 +576,6 @@ package body Inline is
-- in the spec. -- in the spec.
if Is_Non_Loading_Expression_Function (E) then if Is_Non_Loading_Expression_Function (E) then
Set_Is_Called (E);
return; return;
end if; end if;
...@@ -489,8 +588,6 @@ package body Inline is ...@@ -489,8 +588,6 @@ package body Inline is
Pack : constant Entity_Id := Get_Code_Unit_Entity (E); Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
begin begin
Set_Is_Called (E);
if Pack = E then if Pack = E then
Inlined_Bodies.Increment_Last; Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := E; Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
...@@ -498,6 +595,60 @@ package body Inline is ...@@ -498,6 +595,60 @@ package body Inline is
else else
pragma Assert (Ekind (Pack) = E_Package); pragma Assert (Ekind (Pack) = E_Package);
-- If the subprogram is within an instance, inline the instance
if Comes_From_Source (E) then
Inst := Scope (E);
while Present (Inst) and then Inst /= Standard_Standard loop
exit when Is_Generic_Instance (Inst);
Inst := Scope (Inst);
end loop;
if Present (Inst)
and then Is_Generic_Instance (Inst)
and then not Is_Called (Inst)
then
-- Do not add a pending instantiation if the body exits
-- already, or if the instance is a compilation unit, or
-- the instance node is missing.
Inst_Decl := Unit_Declaration_Node (Inst);
if Present (Corresponding_Body (Inst_Decl))
or else Nkind (Parent (Inst_Decl)) = N_Compilation_Unit
or else No (Next (Inst_Decl))
then
Set_Is_Called (Inst);
else
-- If the inlined call itself appears within an instance,
-- ensure that the enclosing instance body is available.
-- This is necessary because Sem_Ch12.Might_Inline_Subp
-- does not recurse into nested instantiations.
if not Is_Inlined (Inst) and then In_Instance then
Set_Is_Inlined (Inst);
-- The instantiation node usually follows the package
-- declaration for the instance. If the generic unit
-- has aspect specifications, they are transformed
-- into pragmas in the instance, and the instance node
-- appears after them.
Inst_Node := Next (Inst_Decl);
while Nkind (Inst_Node) /= N_Package_Instantiation loop
Inst_Node := Next (Inst_Node);
end loop;
Add_Pending_Instantiation (Inst_Node, Inst_Decl);
end if;
Add_Inlined_Instance (Inst);
end if;
end if;
end if;
-- If the unit containing E is an instance, then the instance body -- If the unit containing E is an instance, then the instance body
-- will be analyzed in any case, see Sem_Ch12.Might_Inline_Subp. -- will be analyzed in any case, see Sem_Ch12.Might_Inline_Subp.
...@@ -534,6 +685,39 @@ package body Inline is ...@@ -534,6 +685,39 @@ package body Inline is
end; end;
end Add_Inlined_Body; end Add_Inlined_Body;
--------------------------
-- Add_Inlined_Instance --
--------------------------
procedure Add_Inlined_Instance (E : Entity_Id) is
Decl_Node : constant Node_Id := Unit_Declaration_Node (E);
Index : Int;
begin
-- This machinery is only used with back-end inlining
if not Back_End_Inlining then
return;
end if;
-- Register the instance in the list
Append_New_Elmt (Decl_Node, To => Backend_Instances);
-- Retrieve the index of its corresponding pending instantiation
-- and mark this corresponding pending instantiation as needed.
Index := To_Pending_Instantiations.Get (Decl_Node);
if Index >= 0 then
Called_Pending_Instantiations.Append (Index);
else
pragma Assert (False);
null;
end if;
Set_Is_Called (E);
end Add_Inlined_Instance;
---------------------------- ----------------------------
-- Add_Inlined_Subprogram -- -- Add_Inlined_Subprogram --
---------------------------- ----------------------------
...@@ -570,21 +754,17 @@ package body Inline is ...@@ -570,21 +754,17 @@ package body Inline is
-- Start of processing for Add_Inlined_Subprogram -- Start of processing for Add_Inlined_Subprogram
begin begin
-- If the subprogram is to be inlined, and if its unit is known to be -- We can inline the subprogram if its unit is known to be inlined or is
-- inlined or is an instance whose body will be analyzed anyway or the -- an instance whose body will be analyzed anyway or the subprogram was
-- subprogram was generated as a body by the compiler (for example an -- generated as a body by the compiler (for example an initialization
-- initialization procedure) or its declaration was provided along with -- procedure) or its declaration was provided along with the body (for
-- the body (for example an expression function), and if it is declared -- example an expression function) and it does not declare types with
-- at the library level not in the main unit, and if it can be inlined -- nontrivial initialization procedures.
-- by the back-end, then insert it in the list of inlined subprograms.
if (Is_Inlined (Pack)
if Is_Inlined (E)
and then (Is_Inlined (Pack)
or else Is_Generic_Instance (Pack) or else Is_Generic_Instance (Pack)
or else Nkind (Decl) = N_Subprogram_Body or else Nkind (Decl) = N_Subprogram_Body
or else Present (Corresponding_Body (Decl))) or else Present (Corresponding_Body (Decl)))
and then not In_Main_Unit_Or_Subunit (E)
and then not Is_Nested (E)
and then not Has_Initialized_Type (E) and then not Has_Initialized_Type (E)
then then
Register_Backend_Inlined_Subprogram (E); Register_Backend_Inlined_Subprogram (E);
...@@ -607,7 +787,20 @@ package body Inline is ...@@ -607,7 +787,20 @@ package body Inline is
-------------------------------- --------------------------------
procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is
Act_Decl_Id : Entity_Id;
Index : Int;
begin begin
-- Here is a defense against a ludicrous number of instantiations
-- caused by a circular set of instantiation attempts.
if Pending_Instantiations.Last > Maximum_Instantiations then
Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations);
Error_Msg_N ("too many instantiations, exceeds max of^", Inst);
Error_Msg_N ("\limit can be changed using -gnateinn switch", Inst);
raise Unrecoverable_Error;
end if;
-- Capture the body of the generic instantiation along with its context -- Capture the body of the generic instantiation along with its context
-- for later processing by Instantiate_Bodies. -- for later processing by Instantiate_Bodies.
...@@ -620,6 +813,30 @@ package body Inline is ...@@ -620,6 +813,30 @@ package body Inline is
Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
Scope_Suppress => Scope_Suppress, Scope_Suppress => Scope_Suppress,
Warnings => Save_Warnings)); Warnings => Save_Warnings));
-- With back-end inlining, also associate the index to the instantiation
if Back_End_Inlining then
Act_Decl_Id := Defining_Entity (Act_Decl);
Index := Pending_Instantiations.Last;
To_Pending_Instantiations.Set (Act_Decl, Index);
-- If an instantiation is either a compilation unit or is in the main
-- unit or subunit or is a nested subprogram, then its body is needed
-- as per the analysis already done in Analyze_Package_Instantiation
-- and Analyze_Subprogram_Instantiation.
if Nkind (Parent (Inst)) = N_Compilation_Unit
or else In_Main_Unit_Or_Subunit (Act_Decl_Id)
or else (Is_Subprogram (Act_Decl_Id)
and then Is_Nested (Act_Decl_Id))
then
Called_Pending_Instantiations.Append (Index);
Set_Is_Called (Act_Decl_Id);
end if;
end if;
end Add_Pending_Instantiation; end Add_Pending_Instantiation;
------------------------ ------------------------
...@@ -4220,6 +4437,7 @@ package body Inline is ...@@ -4220,6 +4437,7 @@ package body Inline is
Inlined_Calls := No_Elist; Inlined_Calls := No_Elist;
Backend_Calls := No_Elist; Backend_Calls := No_Elist;
Backend_Instances := No_Elist;
Backend_Inlined_Subps := No_Elist; Backend_Inlined_Subps := No_Elist;
Backend_Not_Inlined_Subps := No_Elist; Backend_Not_Inlined_Subps := No_Elist;
end Initialize; end Initialize;
...@@ -4236,9 +4454,36 @@ package body Inline is ...@@ -4236,9 +4454,36 @@ package body Inline is
-- the body is an internal error. -- the body is an internal error.
procedure Instantiate_Bodies is procedure Instantiate_Bodies is
J : Nat;
procedure Instantiate_Body (Info : Pending_Body_Info);
-- Instantiate a pending body
------------------------
-- Instantiate_Body --
------------------------
procedure Instantiate_Body (Info : Pending_Body_Info) is
begin
-- If the instantiation node is absent, it has been removed as part
-- of unreachable code.
if No (Info.Inst_Node) then
null;
elsif Nkind (Info.Act_Decl) = N_Package_Declaration then
Instantiate_Package_Body (Info);
Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
else
Instantiate_Subprogram_Body (Info);
end if;
end Instantiate_Body;
J, K : Nat;
Info : Pending_Body_Info; Info : Pending_Body_Info;
-- Start of processing for Instantiate_Bodies
begin begin
if Serious_Errors_Detected = 0 then if Serious_Errors_Detected = 0 then
Expander_Active := (Operating_Mode = Opt.Generate_Code); Expander_Active := (Operating_Mode = Opt.Generate_Code);
...@@ -4251,36 +4496,41 @@ package body Inline is ...@@ -4251,36 +4496,41 @@ package body Inline is
-- A body instantiation may generate additional instantiations, so -- A body instantiation may generate additional instantiations, so
-- the following loop must scan to the end of a possibly expanding -- the following loop must scan to the end of a possibly expanding
-- set (that's why we can't simply use a FOR loop here). -- set (that's why we cannot simply use a FOR loop here). We must
-- also capture the element lest the set be entirely reallocated.
J := 0; J := 0;
while J <= Pending_Instantiations.Last if Back_End_Inlining then
while J <= Called_Pending_Instantiations.Last
and then Serious_Errors_Detected = 0 and then Serious_Errors_Detected = 0
loop loop
Info := Pending_Instantiations.Table (J); K := Called_Pending_Instantiations.Table (J);
Info := Pending_Instantiations.Table (K);
-- If the instantiation node is absent, it has been removed Instantiate_Body (Info);
-- as part of unreachable code.
if No (Info.Inst_Node) then
null;
elsif Nkind (Info.Act_Decl) = N_Package_Declaration then J := J + 1;
Instantiate_Package_Body (Info); end loop;
Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
else else
Instantiate_Subprogram_Body (Info); while J <= Pending_Instantiations.Last
end if; and then Serious_Errors_Detected = 0
loop
Info := Pending_Instantiations.Table (J);
Instantiate_Body (Info);
J := J + 1; J := J + 1;
end loop; end loop;
end if;
-- Reset the table of instantiations. Additional instantiations -- Reset the table of instantiations. Additional instantiations
-- may be added through inlining, when additional bodies are -- may be added through inlining, when additional bodies are
-- analyzed. -- analyzed.
if Back_End_Inlining then
Called_Pending_Instantiations.Init;
else
Pending_Instantiations.Init; Pending_Instantiations.Init;
end if;
-- We can now complete the cleanup actions of scopes that contain -- We can now complete the cleanup actions of scopes that contain
-- pending instantiations (skipped for generic units, since we -- pending instantiations (skipped for generic units, since we
...@@ -4308,7 +4558,7 @@ package body Inline is ...@@ -4308,7 +4558,7 @@ package body Inline is
begin begin
Scop := Scope (E); Scop := Scope (E);
while Scop /= Standard_Standard loop while Scop /= Standard_Standard loop
if Ekind (Scop) in Subprogram_Kind then if Is_Subprogram (Scop) then
return True; return True;
elsif Ekind (Scop) = E_Task_Type elsif Ekind (Scop) = E_Task_Type
...@@ -4394,6 +4644,34 @@ package body Inline is ...@@ -4394,6 +4644,34 @@ package body Inline is
end loop; end loop;
end if; end if;
-- Generate listing of instances inlined for the backend
if Present (Backend_Instances) then
Count := 0;
Elmt := First_Elmt (Backend_Instances);
while Present (Elmt) loop
Nod := Node (Elmt);
if not In_Internal_Unit (Nod) then
Count := Count + 1;
if Count = 1 then
Write_Str ("List of instances inlined for the backend");
Write_Eol;
end if;
Write_Str (" ");
Write_Int (Count);
Write_Str (":");
Write_Location (Sloc (Nod));
Output.Write_Eol;
end if;
Next_Elmt (Elmt);
end loop;
end if;
-- Generate listing of subprograms passed to the backend -- Generate listing of subprograms passed to the backend
if Present (Backend_Inlined_Subps) and then Back_End_Inlining then if Present (Backend_Inlined_Subps) and then Back_End_Inlining then
......
...@@ -42,10 +42,8 @@ ...@@ -42,10 +42,8 @@
-- Inline_Always subprograms, but there are fewer restrictions on the source -- Inline_Always subprograms, but there are fewer restrictions on the source
-- of subprograms. -- of subprograms.
with Alloc;
with Opt; use Opt; with Opt; use Opt;
with Sem; use Sem; with Sem; use Sem;
with Table;
with Types; use Types; with Types; use Types;
with Warnsw; use Warnsw; with Warnsw; use Warnsw;
...@@ -100,14 +98,6 @@ package Inline is ...@@ -100,14 +98,6 @@ package Inline is
-- Capture values of warning flags -- Capture values of warning flags
end record; end record;
package Pending_Instantiations is new Table.Table (
Table_Component_Type => Pending_Body_Info,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Pending_Instantiations_Initial,
Table_Increment => Alloc.Pending_Instantiations_Increment,
Table_Name => "Pending_Instantiations");
----------------- -----------------
-- Subprograms -- -- Subprograms --
----------------- -----------------
......
...@@ -3861,6 +3861,12 @@ package body Sem_Ch12 is ...@@ -3861,6 +3861,12 @@ package body Sem_Ch12 is
begin begin
if Inline_Processing_Required then if Inline_Processing_Required then
-- No need to recompute the answer if we know it is positive
if Is_Inlined (Gen_Unit) then
return True;
end if;
E := First_Entity (Gen_Unit); E := First_Entity (Gen_Unit);
while Present (E) loop while Present (E) loop
if Is_Subprogram (E) and then Is_Inlined (E) then if Is_Subprogram (E) and then Is_Inlined (E) then
...@@ -3870,6 +3876,7 @@ package body Sem_Ch12 is ...@@ -3870,6 +3876,7 @@ package body Sem_Ch12 is
Has_Inline_Always := True; Has_Inline_Always := True;
end if; end if;
Set_Is_Inlined (Gen_Unit);
return True; return True;
end if; end if;
...@@ -4425,17 +4432,6 @@ package body Sem_Ch12 is ...@@ -4425,17 +4432,6 @@ package body Sem_Ch12 is
end if; end if;
if Needs_Body then if Needs_Body then
-- Here is a defence against a ludicrous number of instantiations
-- caused by a circular set of instantiation attempts.
if Pending_Instantiations.Last > Maximum_Instantiations then
Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations);
Error_Msg_N ("too many instantiations, exceeds max of^", N);
Error_Msg_N ("\limit can be changed using -gnateinn switch", N);
raise Unrecoverable_Error;
end if;
-- Indicate that the enclosing scopes contain an instantiation, -- Indicate that the enclosing scopes contain an instantiation,
-- and that cleanup actions should be delayed until after the -- and that cleanup actions should be delayed until after the
-- instance body is expanded. -- instance body is expanded.
...@@ -4633,11 +4629,10 @@ package body Sem_Ch12 is ...@@ -4633,11 +4629,10 @@ package body Sem_Ch12 is
-- The instantiation results in a guaranteed ABE -- The instantiation results in a guaranteed ABE
if Is_Known_Guaranteed_ABE (N) and then Needs_Body then if Is_Known_Guaranteed_ABE (N) and then Needs_Body then
-- Do not instantiate the corresponding body because gigi cannot -- Do not instantiate the corresponding body because gigi cannot
-- handle certain types of premature instantiations. -- handle certain types of premature instantiations.
Pending_Instantiations.Decrement_Last; Remove_Dead_Instance (N);
-- Create completing bodies for all subprogram declarations since -- Create completing bodies for all subprogram declarations since
-- their real bodies will not be instantiated. -- their real bodies will not be instantiated.
......
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