diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-11 12:24:08 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-11 12:24:08 +0200 |
commit | 1237d6ef3c2a5994c7d633b2de2b6db525c92d7b (patch) | |
tree | cadb7f8e64b74dd68b8d3be233527091a162548c /gcc/ada/inline.adb | |
parent | 3cae7f1412ac273c2794babccfb130c010cf84db (diff) | |
download | gcc-1237d6ef3c2a5994c7d633b2de2b6db525c92d7b.zip gcc-1237d6ef3c2a5994c7d633b2de2b6db525c92d7b.tar.gz gcc-1237d6ef3c2a5994c7d633b2de2b6db525c92d7b.tar.bz2 |
[multiple changes]
2010-10-11 Javier Miranda <miranda@adacore.com>
* debug.adb: Update comment.
2010-10-11 Vincent Celier <celier@adacore.com>
* gnatcmd.adb (GNATCmd): Set Opt.Unchecked_Shared_Lib_Imports to True
unconditionally as for "gnat make" the projects are not processed in
the GNAT driver.
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.ads, sem_ch10.adb (Load_Needed_Body): Add parameter to
suppress semantic analysis of the body when inlining, prior to
verifying that the body does not have a with_clause on a descendant
unit.
* inline.adb (Analyze_Inlined_Bodies): Do not inline a body if it has a
with_clause on a descendant.
(Scope_In_Main_Unit): Simplify.
From-SVN: r165298
Diffstat (limited to 'gcc/ada/inline.adb')
-rw-r--r-- | gcc/ada/inline.adb | 159 |
1 files changed, 108 insertions, 51 deletions
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 1379a9e..f7e2b30 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -138,8 +138,7 @@ package body Inline is ----------------------- function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean; - -- Return True if Scop is in the main unit or its spec, or in a - -- parent of the main unit if it is a child unit. + -- Return True if Scop is in the main unit or its spec procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty); -- Make two entries in Inlined table, for an inlined subprogram being @@ -338,7 +337,6 @@ package body Inline is elsif not Is_Inlined (Pack) and then not Has_Completion (E) - and then not Scope_In_Main_Unit (Pack) then Set_Is_Inlined (Pack); Inlined_Bodies.Increment_Last; @@ -354,6 +352,7 @@ package body Inline is procedure Add_Inlined_Subprogram (Index : Subp_Index) is E : constant Entity_Id := Inlined.Table (Index).Name; + Pack : constant Entity_Id := Cunit_Entity (Get_Code_Unit (E)); Succ : Succ_Index; Subp : Subp_Index; @@ -473,10 +472,12 @@ package body Inline is -- Start of processing for Add_Inlined_Subprogram begin - -- Insert the current subprogram in the list of inlined subprograms, - -- if it can actually be inlined by the back-end. + -- Insert the current subprogram in the list of inlined subprograms, if + -- it can actually be inlined by the back-end, and if its unit is known + -- to be inlined, or is an instance whose body will be analyzed anyway. - if not Scope_In_Main_Unit (E) + if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack)) + and then not Scope_In_Main_Unit (E) and then Is_Inlined (E) and then not Is_Nested (E) and then not Has_Initialized_Type (E) @@ -625,6 +626,53 @@ package body Inline is Pack : Entity_Id; S : Succ_Index; + function Is_Ancestor + (U_Name : Entity_Id; + Nam : Node_Id) return Boolean; + -- Determine whether the unit whose body is loaded is an ancestor of + -- a unit mentioned in a with_clause of that body. The body is not + -- analyzed yet, so the check is purely lexical: the name of the with + -- clause is a selected component, and names of ancestors must match. + + ----------------- + -- Is_Ancestor -- + ----------------- + + function Is_Ancestor + (U_Name : Entity_Id; + Nam : Node_Id) return Boolean + is + Pref : Node_Id; + + begin + if Nkind (Nam) /= N_Selected_Component then + return False; + + else + Pref := Prefix (Nam); + if Nkind (Pref) = N_Identifier then + + -- Par is an ancestor of Par.Child. + + return Chars (Pref) = Chars (U_Name); + + elsif Nkind (Pref) = N_Selected_Component + and then Chars (Selector_Name (Pref)) = Chars (U_Name) + then + -- Par.Child is an ancestor of Par.Child.Grand. + + return True; -- should check that ancestor match + + else + -- A is an ancestor of A.B.C if it is an ancestor of A.B + + return Is_Ancestor (U_Name, Pref); + end if; + end if; + end Is_Ancestor; + + -- Start of processing for Analyze_Inlined_Bodies + begin Analyzing_Inlined_Bodies := False; @@ -650,8 +698,8 @@ package body Inline is Comp_Unit := Parent (Comp_Unit); end loop; - -- Load the body, unless it the main unit, or is an instance - -- whose body has already been analyzed. + -- Load the body, unless it the main unit, or is an instance whose + -- body has already been analyzed. if Present (Comp_Unit) and then Comp_Unit /= Cunit (Main_Unit) @@ -667,7 +715,8 @@ package body Inline is begin if not Is_Loaded (Bname) then - Load_Needed_Body (Comp_Unit, OK); + Style_Check := False; + Load_Needed_Body (Comp_Unit, OK, Do_Analyze => False); if not OK then @@ -681,6 +730,42 @@ package body Inline is Error_Msg_File_1 := Get_File_Name (Bname, Subunit => False); Error_Msg_N ("\but file{ was not found!?", Comp_Unit); + + else + -- If the package to be inlined is an ancestor unit of + -- the main unit, and it has a semantic dependence on + -- it, the inlining cannot take place to prevent an + -- elaboration circularity. The desired body is not + -- analyzed yet, to prevent the completion of Taft + -- amendment types that would lead to elaboration + -- circularities in gigi. + + declare + U_Id : constant Entity_Id := + Defining_Entity (Unit (Comp_Unit)); + Body_Unit : constant Node_Id := + Library_Unit (Comp_Unit); + Item : Node_Id; + + begin + Item := First (Context_Items (Body_Unit)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then Is_Ancestor (U_Id, Name (Item)) + then + Set_Is_Inlined (U_Id, False); + exit; + end if; + + Next (Item); + end loop; + + -- If no suspicious with_clauses, analyze the body. + + if Is_Inlined (U_Id) then + Semantics (Body_Unit); + end if; + end; end if; end if; end; @@ -697,14 +782,14 @@ package body Inline is Instantiate_Bodies; - -- The list of inlined subprograms is an overestimate, because - -- it includes inlined functions called from functions that are - -- compiled as part of an inlined package, but are not themselves - -- called. An accurate computation of just those subprograms that - -- are needed requires that we perform a transitive closure over - -- the call graph, starting from calls in the main program. Here - -- we do one step of the inverse transitive closure, and reset - -- the Is_Called flag on subprograms all of whose callers are not. + -- The list of inlined subprograms is an overestimate, because it + -- includes inlined functions called from functions that are compiled + -- as part of an inlined package, but are not themselves called. An + -- accurate computation of just those subprograms that are needed + -- requires that we perform a transitive closure over the call graph, + -- starting from calls in the main program. Here we do one step of + -- the inverse transitive closure, and reset the Is_Called flag on + -- subprograms all of whose callers are not. for Index in Inlined.First .. Inlined.Last loop S := Inlined.Table (Index).First_Succ; @@ -1124,42 +1209,14 @@ package body Inline is ------------------------ function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is - Comp : Node_Id; - S : Entity_Id; - Ent : Entity_Id := Cunit_Entity (Main_Unit); + Comp : constant Node_Id := Cunit (Get_Code_Unit (Scop)); begin - -- The scope may be within the main unit, or it may be an ancestor - -- of the main unit, if the main unit is a child unit. In both cases - -- it makes no sense to process the body before the main unit. In - -- the second case, this may lead to circularities if a parent body - -- depends on a child spec, and we are analyzing the child. - - S := Scop; - while Scope (S) /= Standard_Standard - and then not Is_Child_Unit (S) - loop - S := Scope (S); - end loop; - - Comp := Parent (S); - while Present (Comp) - and then Nkind (Comp) /= N_Compilation_Unit - loop - Comp := Parent (Comp); - end loop; - - if Is_Child_Unit (Ent) then - while Present (Ent) - and then Is_Child_Unit (Ent) - loop - if Scope (Ent) = S then - return True; - end if; - - Ent := Scope (Ent); - end loop; - end if; + -- Check whether the scope of the subprogram to inline is within the + -- main unit or within its spec. In either case there are no additional + -- bodies to process. If the subprogram appears in a parent of the + -- current unit, the check on whether inlining is possible is done in + -- Analyze_Inlined_Bodies. return Comp = Cunit (Main_Unit) |