aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2019-08-14 09:52:15 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-08-14 09:52:15 +0000
commit4b96d3861e74b8df1032f4317230408248e4bf09 (patch)
treefbcdc10f2092f73da537788d02b6fc5d18e05425
parent72e324b6d8cb43b07eb3927f7d150b93105d1add (diff)
downloadgcc-4b96d3861e74b8df1032f4317230408248e4bf09.zip
gcc-4b96d3861e74b8df1032f4317230408248e4bf09.tar.gz
gcc-4b96d3861e74b8df1032f4317230408248e4bf09.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog47
-rw-r--r--gcc/ada/einfo.adb4
-rw-r--r--gcc/ada/einfo.ads11
-rw-r--r--gcc/ada/exp_ch6.adb56
-rw-r--r--gcc/ada/inline.adb366
-rw-r--r--gcc/ada/inline.ads10
-rw-r--r--gcc/ada/sem_ch12.adb21
7 files changed, 385 insertions, 130 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1b9e285..6cabf26 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,50 @@
+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>
* exp_ch3.adb (Predef_Spec_Or_Body): For an equality operation
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 0438c8e..957bfe6 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -2140,7 +2140,7 @@ package body Einfo is
function Is_Called (Id : E) return B is
begin
- pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
+ pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package));
return Flag102 (Id);
end Is_Called;
@@ -5344,7 +5344,7 @@ package body Einfo is
procedure Set_Is_Called (Id : E; V : B := True) is
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);
end Set_Is_Called;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 007b7d2..b879753 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2366,9 +2366,9 @@ package Einfo is
-- i.e. Standard.Boolean and all types ultimately derived from it.
-- Is_Called (Flag102)
--- Defined in subprograms. Returns true if the subprogram is called
--- in the unit being compiled or in a unit in the context. Used for
--- inlining.
+-- Defined in subprograms and packages. Set if a subprogram is called
+-- from the unit being compiled or a unit in the closure. Also set for
+-- a package that contains called subprograms. Used only for inlining.
-- Is_Character_Type (Flag63)
-- Defined in all entities. Set for character types and subtypes,
@@ -6406,12 +6406,13 @@ package Einfo is
-- Has_Master_Entity (Flag21)
-- Has_RACW (Flag214) (non-generic case only)
-- Ignore_SPARK_Mode_Pragmas (Flag301)
- -- In_Package_Body (Flag48)
- -- In_Use (Flag8)
+ -- Is_Called (Flag102) (non-generic case only)
-- Is_Elaboration_Checks_OK_Id (Flag148)
-- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Instantiated (Flag126)
+ -- In_Package_Body (Flag48)
-- Is_Private_Descendant (Flag53)
+ -- In_Use (Flag8)
-- Is_Visible_Lib_Unit (Flag116)
-- Renamed_In_Spec (Flag231) (non-generic case only)
-- SPARK_Aux_Pragma_Inherited (Flag266)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 128fb90..c182072 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4443,62 +4443,6 @@ package body Exp_Ch6 is
or else Has_Pragma_Inline_Always (Subp)
then
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;
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 862f047..05830e1 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
+with Alloc;
with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
@@ -51,8 +52,12 @@ with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
-with Uname; use Uname;
+with Table;
with Tbuild; use Tbuild;
+with Uintp; use Uintp;
+with Uname; use Uname;
+
+with GNAT.HTable;
package body Inline is
@@ -82,12 +87,83 @@ package body Inline is
Backend_Calls : Elist_Id;
-- List of inline calls passed to the backend
+ Backend_Instances : Elist_Id;
+ -- List of instances inlined for the backend
+
Backend_Inlined_Subps : Elist_Id;
-- List of subprograms inlined by the backend
Backend_Not_Inlined_Subps : Elist_Id;
-- 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 --
--------------------
@@ -179,8 +255,11 @@ package body Inline is
-- 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_Instance (E : Entity_Id);
+ -- Add instance E to the list of of inlined instances for the unit
+
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;
-- Make entry in Inlined table for subprogram E, or return table index
@@ -429,17 +508,22 @@ package body Inline is
return Dont_Inline;
end Must_Inline;
- Level : Inline_Level_Type;
+ Inst : Entity_Id;
+ Inst_Decl : Node_Id;
+ Inst_Node : Node_Id;
+ Level : Inline_Level_Type;
-- Start of processing for Add_Inlined_Body
begin
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)
or else Convention (E) = Convention_Protected
+ or else In_Main_Unit_Or_Subunit (E)
or else Is_Nested (E)
then
return;
@@ -456,6 +540,22 @@ package body Inline is
return;
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
-- a run-time unit, we need to suppress debugging information for it,
-- so that the code that is eventually inlined will not affect the
@@ -476,7 +576,6 @@ package body Inline is
-- in the spec.
if Is_Non_Loading_Expression_Function (E) then
- Set_Is_Called (E);
return;
end if;
@@ -489,8 +588,6 @@ package body Inline is
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
begin
- Set_Is_Called (E);
-
if Pack = E then
Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := E;
@@ -498,6 +595,60 @@ package body Inline is
else
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
-- will be analyzed in any case, see Sem_Ch12.Might_Inline_Subp.
@@ -534,6 +685,39 @@ package body Inline is
end;
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 --
----------------------------
@@ -570,21 +754,17 @@ package body Inline is
-- Start of processing for Add_Inlined_Subprogram
begin
- -- If the subprogram is to be inlined, and if its unit is known to be
- -- inlined or is an instance whose body will be analyzed anyway or the
- -- subprogram was generated as a body by the compiler (for example an
- -- initialization procedure) or its declaration was provided along with
- -- the body (for example an expression function), and if it is declared
- -- at the library level not in the main unit, and if it can be inlined
- -- by the back-end, then insert it in the list of inlined subprograms.
-
- if Is_Inlined (E)
- and then (Is_Inlined (Pack)
- or else Is_Generic_Instance (Pack)
- or else Nkind (Decl) = N_Subprogram_Body
- or else Present (Corresponding_Body (Decl)))
- and then not In_Main_Unit_Or_Subunit (E)
- and then not Is_Nested (E)
+ -- We can inline the subprogram if its unit is known to be inlined or is
+ -- an instance whose body will be analyzed anyway or the subprogram was
+ -- generated as a body by the compiler (for example an initialization
+ -- procedure) or its declaration was provided along with the body (for
+ -- example an expression function) and it does not declare types with
+ -- nontrivial initialization procedures.
+
+ if (Is_Inlined (Pack)
+ or else Is_Generic_Instance (Pack)
+ or else Nkind (Decl) = N_Subprogram_Body
+ or else Present (Corresponding_Body (Decl)))
and then not Has_Initialized_Type (E)
then
Register_Backend_Inlined_Subprogram (E);
@@ -607,7 +787,20 @@ package body Inline is
--------------------------------
procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is
+ Act_Decl_Id : Entity_Id;
+ Index : Int;
+
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
-- for later processing by Instantiate_Bodies.
@@ -620,6 +813,30 @@ package body Inline is
Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
Scope_Suppress => Scope_Suppress,
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;
------------------------
@@ -4220,6 +4437,7 @@ package body Inline is
Inlined_Calls := No_Elist;
Backend_Calls := No_Elist;
+ Backend_Instances := No_Elist;
Backend_Inlined_Subps := No_Elist;
Backend_Not_Inlined_Subps := No_Elist;
end Initialize;
@@ -4236,9 +4454,36 @@ package body Inline is
-- the body is an internal error.
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;
+ -- Start of processing for Instantiate_Bodies
+
begin
if Serious_Errors_Detected = 0 then
Expander_Active := (Operating_Mode = Opt.Generate_Code);
@@ -4251,36 +4496,41 @@ package body Inline is
-- A body instantiation may generate additional instantiations, so
-- 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;
- while J <= Pending_Instantiations.Last
- and then Serious_Errors_Detected = 0
- loop
- Info := Pending_Instantiations.Table (J);
-
- -- If the instantiation node is absent, it has been removed
- -- as part of unreachable code.
-
- if No (Info.Inst_Node) then
- null;
+ if Back_End_Inlining then
+ while J <= Called_Pending_Instantiations.Last
+ and then Serious_Errors_Detected = 0
+ loop
+ K := Called_Pending_Instantiations.Table (J);
+ Info := Pending_Instantiations.Table (K);
+ Instantiate_Body (Info);
- elsif Nkind (Info.Act_Decl) = N_Package_Declaration then
- Instantiate_Package_Body (Info);
- Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
+ J := J + 1;
+ end loop;
- else
- Instantiate_Subprogram_Body (Info);
- end if;
+ else
+ while J <= Pending_Instantiations.Last
+ and then Serious_Errors_Detected = 0
+ loop
+ Info := Pending_Instantiations.Table (J);
+ Instantiate_Body (Info);
- J := J + 1;
- end loop;
+ J := J + 1;
+ end loop;
+ end if;
-- Reset the table of instantiations. Additional instantiations
-- may be added through inlining, when additional bodies are
-- analyzed.
- Pending_Instantiations.Init;
+ if Back_End_Inlining then
+ Called_Pending_Instantiations.Init;
+ else
+ Pending_Instantiations.Init;
+ end if;
-- We can now complete the cleanup actions of scopes that contain
-- pending instantiations (skipped for generic units, since we
@@ -4308,7 +4558,7 @@ package body Inline is
begin
Scop := Scope (E);
while Scop /= Standard_Standard loop
- if Ekind (Scop) in Subprogram_Kind then
+ if Is_Subprogram (Scop) then
return True;
elsif Ekind (Scop) = E_Task_Type
@@ -4394,6 +4644,34 @@ package body Inline is
end loop;
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
if Present (Backend_Inlined_Subps) and then Back_End_Inlining then
diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads
index 5af42f9..ed342f5 100644
--- a/gcc/ada/inline.ads
+++ b/gcc/ada/inline.ads
@@ -42,10 +42,8 @@
-- Inline_Always subprograms, but there are fewer restrictions on the source
-- of subprograms.
-with Alloc;
with Opt; use Opt;
with Sem; use Sem;
-with Table;
with Types; use Types;
with Warnsw; use Warnsw;
@@ -100,14 +98,6 @@ package Inline is
-- Capture values of warning flags
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 --
-----------------
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 06afd2a..dffec14 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3861,6 +3861,12 @@ package body Sem_Ch12 is
begin
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);
while Present (E) loop
if Is_Subprogram (E) and then Is_Inlined (E) then
@@ -3870,6 +3876,7 @@ package body Sem_Ch12 is
Has_Inline_Always := True;
end if;
+ Set_Is_Inlined (Gen_Unit);
return True;
end if;
@@ -4425,17 +4432,6 @@ package body Sem_Ch12 is
end if;
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,
-- and that cleanup actions should be delayed until after the
-- instance body is expanded.
@@ -4633,11 +4629,10 @@ package body Sem_Ch12 is
-- The instantiation results in a guaranteed ABE
if Is_Known_Guaranteed_ABE (N) and then Needs_Body then
-
-- Do not instantiate the corresponding body because gigi cannot
-- handle certain types of premature instantiations.
- Pending_Instantiations.Decrement_Last;
+ Remove_Dead_Instance (N);
-- Create completing bodies for all subprogram declarations since
-- their real bodies will not be instantiated.