-----------------------
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
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;
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;
-- 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)
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;
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)
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
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;
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;
------------------------
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)
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- rule imposes extra steps in order to install/remove the private_with
-- clauses of an enclosing unit.
- procedure Load_Needed_Body (N : Node_Id; OK : out Boolean);
- -- Load and analyze the body of a context unit that is generic, or
- -- that contains generic units or inlined units. The body becomes
- -- part of the semantic dependency set of the unit that needs it.
- -- The returned result in OK is True if the load is successful,
- -- and False if the requested file cannot be found.
+ procedure Load_Needed_Body
+ (N : Node_Id;
+ OK : out Boolean;
+ Do_Analyze : Boolean := True);
+ -- Load and analyze the body of a context unit that is generic, or that
+ -- contains generic units or inlined units. The body becomes part of the
+ -- semantic dependency set of the unit that needs it. The returned result
+ -- in OK is True if the load is successful, and False if the requested file
+ -- cannot be found. If the flag Do_Analyze is false, the unit is loaded and
+ -- parsed only. This allows a selective analysis in some inlining cases
+ -- where a full analysis would lead so circularities in the back-end.
end Sem_Ch10;
OSDN Git Service
