-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
+with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Ch12; use Sem_Ch12;
-- one needs to be recorded.
J := Inlined.Table (P1).First_Succ;
-
while J /= No_Succ loop
-
if Successors.Table (J).Subp = P2 then
return;
end if;
-- inlined under ZCX because the numeric suffix generated by gigi
-- will be different in the body and the place of the inlined call.
--
- -- This procedure must be carefully coordinated with the back end
+ -- If the body to be inlined contains calls to subprograms declared
+ -- in the same body that have no previous spec, the back-end cannot
+ -- inline either because the bodies to be inlined are processed before
+ -- the rest of the enclosing package body, and gigi will then find
+ -- references to entities that have not been elaborated yet.
+ --
+ -- This procedure must be carefully coordinated with the back end.
----------------------------
-- Back_End_Cannot_Inline --
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
Body_Ent : Entity_Id;
Ent : Entity_Id;
+ Bad_Call : Node_Id;
+
+ function Process (N : Node_Id) return Traverse_Result;
+ -- Look for calls to subprograms with no previous spec, declared
+ -- in the same enclosiong package body.
+
+ -------------
+ -- Process --
+ -------------
+
+ function Process (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) = N_Procedure_Call_Statement
+ or else Nkind (N) = N_Function_Call
+ then
+ if Is_Entity_Name (Name (N))
+ and then Comes_From_Source (Entity (Name (N)))
+ and then
+ Nkind (Unit_Declaration_Node (Entity (Name (N))))
+ = N_Subprogram_Body
+ and then In_Same_Extended_Unit (Subp, Entity (Name (N)))
+ then
+ Bad_Call := N;
+ return Abandon;
+ else
+ return OK;
+ end if;
+ else
+ return OK;
+ end if;
+ end Process;
+
+ function Has_Exposed_Call is new Traverse_Func (Process);
+
+ -- Start of processing for Back_End_Cannot_Inline
begin
if Nkind (Decl) = N_Subprogram_Declaration
if Present
(Exception_Handlers
(Handled_Statement_Sequence
- (Unit_Declaration_Node (Corresponding_Body (Decl)))))
+ (Unit_Declaration_Node (Corresponding_Body (Decl)))))
then
return True;
end if;
Ent := First_Entity (Body_Ent);
-
while Present (Ent) loop
if Is_Subprogram (Ent)
and then Is_Generic_Instance (Ent)
Next_Entity (Ent);
end loop;
- return False;
+
+ if Has_Exposed_Call
+ (Unit_Declaration_Node (Corresponding_Body (Decl))) = Abandon
+ then
+ if Ineffective_Inline_Warnings then
+ Error_Msg_N
+ ("?call to subprogram with no separate spec"
+ & " prevents inlining!!", Bad_Call);
+ end if;
+
+ return True;
+ else
+ return False;
+ end if;
end Back_End_Cannot_Inline;
-- Start of processing for Add_Inlined_Subprogram
end if;
Inlined.Table (Index).Listed := True;
- Succ := Inlined.Table (Index).First_Succ;
+ -- Now add to the list those callers of the current subprogram that
+ -- are themselves called. They may appear on the graph as callers
+ -- of the current one, even if they are themselves not called, and
+ -- there is no point in including them in the list for the backend.
+ -- Furthermore, they might not even be public, in which case the
+ -- back-end cannot handle them at all.
+
+ Succ := Inlined.Table (Index).First_Succ;
while Succ /= No_Succ loop
Subp := Successors.Table (Succ).Subp;
Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
- if Inlined.Table (Subp).Count = 0 then
+ if Inlined.Table (Subp).Count = 0
+ and then Is_Called (Inlined.Table (Subp).Name)
+ then
Add_Inlined_Subprogram (Subp);
end if;
declare
S : Entity_Id;
+
begin
S := Scope (Inst);
while Present (S) and then S /= Standard_Standard loop
end;
Elmt := First_Elmt (To_Clean);
-
while Present (Elmt) loop
-
if Node (Elmt) = Scop then
return;
end if;
else
J := Hash_Headers (Index);
-
while J /= No_Subp loop
-
if Inlined.Table (J).Name = E then
return J;
else
and then Serious_Errors_Detected = 0
loop
Pack := Inlined_Bodies.Table (J);
-
while Present (Pack)
and then Scope (Pack) /= Standard_Standard
and then not Is_Child_Unit (Pack)
Load_Needed_Body (Comp_Unit, OK);
if not OK then
+
+ -- Warn that a body was not available for inlining
+ -- by the back-end.
+
Error_Msg_Unit_1 := Bname;
Error_Msg_N
- ("one or more inlined subprograms accessed in $!",
+ ("one or more inlined subprograms accessed in $!?",
Comp_Unit);
Error_Msg_File_1 :=
Get_File_Name (Bname, Subunit => False);
- Error_Msg_N ("\but file{ was not found!", Comp_Unit);
- raise Unrecoverable_Error;
+ Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
end if;
end if;
end;
Set_Is_Called (Inlined.Table (Index).Name, False);
while S /= No_Succ loop
-
if Is_Called
(Inlined.Table (Successors.Table (S).Subp).Name)
or else Inlined.Table (Successors.Table (S).Subp).Main_Call
and then not Is_Generic_Instance (P)
then
Bname := Get_Body_Name (Get_Unit_Name (Unit (N)));
- E := First_Entity (P);
+ E := First_Entity (P);
while Present (E) loop
if Has_Pragma_Inline_Always (E)
or else (Front_End_Inlining and then Has_Pragma_Inline (E))
if OK then
- -- Check that we are not trying to inline a parent
- -- whose body depends on a child, when we are compiling
- -- the body of the child. Otherwise we have a potential
- -- elaboration circularity with inlined subprograms and
- -- with Taft-Amendment types.
+ -- Check we are not trying to inline a parent whose body
+ -- depends on a child, when we are compiling the body of
+ -- the child. Otherwise we have a potential elaboration
+ -- circularity with inlined subprograms and with
+ -- Taft-Amendment types.
declare
Comp : Node_Id; -- Body just compiled
and then Present (Body_Entity (P))
then
Child_Spec :=
- Defining_Entity (
- (Unit (Library_Unit (Cunit (Main_Unit)))));
+ Defining_Entity
+ ((Unit (Library_Unit (Cunit (Main_Unit)))));
Comp :=
Parent (Unit_Declaration_Node (Body_Entity (P)));
- With_Clause := First (Context_Items (Comp));
-
-- Check whether the context of the body just
-- compiled includes a child of itself, and that
-- child is the spec of the main compilation.
+ With_Clause := First (Context_Items (Comp));
while Present (With_Clause) loop
if Nkind (With_Clause) = N_With_Clause
and then
-- and keep Taft-amendment types incomplete.
Ent := First_Entity (P);
-
while Present (Ent) loop
if Is_Type (Ent)
and then Has_Completion_In_Body (Ent)
begin
Elmt := First_Elmt (To_Clean);
-
while Present (Elmt) loop
Scop := Node (Elmt);
-- cleanup operations have been delayed, and the subprogram
-- has been rewritten in the expansion of the enclosing
-- protected body. It is the corresponding subprogram that
- -- may require the cleanup operations.
+ -- may require the cleanup operations, so propagate the
+ -- information that triggers cleanup activity.
Set_Uses_Sec_Stack
(Protected_Body_Subprogram (Scop),
Uses_Sec_Stack (Scop));
+ Set_Finalization_Chain_Entity
+ (Protected_Body_Subprogram (Scop),
+ Finalization_Chain_Entity (Scop));
Scop := Protected_Body_Subprogram (Scop);
end if;
else
Decl := First (Declarations (E_Body));
-
while Present (Decl) loop
if Nkind (Decl) = N_Full_Type_Declaration
---------------
function Is_Nested (E : Entity_Id) return Boolean is
- Scop : Entity_Id := Scope (E);
+ Scop : Entity_Id;
begin
+ Scop := Scope (E);
while Scop /= Standard_Standard loop
if Ekind (Scop) in Subprogram_Kind then
return True;
--------------------------
procedure Remove_Dead_Instance (N : Node_Id) is
- J : Int;
+ J : Int;
begin
J := 0;
-
while J <= Pending_Instantiations.Last loop
-
if Pending_Instantiations.Table (J).Inst_Node = N then
Pending_Instantiations.Table (J).Inst_Node := Empty;
return;
function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is
Comp : Node_Id;
- S : Entity_Id := Scop;
+ S : Entity_Id;
Ent : Entity_Id := Cunit_Entity (Main_Unit);
begin
-- 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
end loop;
Comp := Parent (S);
-
while Present (Comp)
and then Nkind (Comp) /= N_Compilation_Unit
loop
end loop;
if Is_Child_Unit (Ent) then
-
while Present (Ent)
and then Is_Child_Unit (Ent)
loop
OSDN Git Service
