-- visible entity with that name.
procedure Install_Entity (E : Entity_Id);
- -- Make single entity visible. Used for generic formals as well.
+ -- Make single entity visible. Used for generic formals as well
procedure Install_Formals (Id : Entity_Id);
-- On entry to a subprogram body, make the formals visible. Note
end loop;
end if;
- -- Visible generic entity is callable within its own body.
+ -- Visible generic entity is callable within its own body
Set_Ekind (Gen_Id, Ekind (Body_Id));
Set_Ekind (Body_Id, E_Subprogram_Body);
if Nkind (N) = N_Subprogram_Body_Stub then
- -- No body to analyze, so restore state of generic unit.
+ -- No body to analyze, so restore state of generic unit
Set_Ekind (Gen_Id, Kind);
Set_Ekind (Body_Id, Kind);
End_Scope;
Check_Subprogram_Order (N);
- -- Outside of its body, unit is generic again.
+ -- Outside of its body, unit is generic again
Set_Ekind (Gen_Id, Kind);
Generate_Reference (Gen_Id, Body_Id, 'b', Set_Ref => False);
Analyze (P);
Analyze_Call_And_Resolve;
- -- Anything else is an error.
+ -- Anything else is an error
else
Error_Msg_N ("Invalid procedure or entry call", N);
if Nkind (Parent (N)) = N_Subunit
and then Comes_From_Source (N)
and then not Error_Posted (Body_Id)
+ and then Nkind (Corresponding_Stub (Parent (N))) =
+ N_Subprogram_Body_Stub
then
declare
Old_Id : constant Entity_Id :=
then
Set_Categorization_From_Scope (Designator, Scop);
else
- -- For a compilation unit, check for library-unit pragmas.
+ -- For a compilation unit, check for library-unit pragmas
New_Scope (Designator);
Set_Categorization_From_Pragmas (N);
Stat_Count : Integer := 0;
function Has_Excluded_Declaration (Decls : List_Id) return Boolean;
- -- Check for declarations that make inlining not worthwhile.
+ -- Check for declarations that make inlining not worthwhile
function Has_Excluded_Statement (Stats : List_Id) return Boolean;
-- Check for statements that make inlining not worthwhile: any
-- Remove it from body to inline. The analysis of the non-inlined
-- body will handle the pragma properly.
+ function Uses_Secondary_Stack (Bod : Node_Id) return Boolean;
+ -- If the body of the subprogram includes a call that returns an
+ -- unconstrained type, the secondary stack is involved, and it
+ -- is not worth inlining.
+
------------------------------
-- Has_Excluded_Declaration --
------------------------------
end loop;
end Remove_Pragmas;
+ --------------------------
+ -- Uses_Secondary_Stack --
+ --------------------------
+
+ function Uses_Secondary_Stack (Bod : Node_Id) return Boolean is
+ function Check_Call (N : Node_Id) return Traverse_Result;
+ -- Look for function calls that return an unconstrained type
+
+ ----------------
+ -- Check_Call --
+ ----------------
+
+ function Check_Call (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) = N_Function_Call
+ and then Is_Entity_Name (Name (N))
+ and then Is_Composite_Type (Etype (Entity (Name (N))))
+ and then not Is_Constrained (Etype (Entity (Name (N))))
+ then
+ Cannot_Inline
+ ("cannot inline & (call returns unconstrained type)?",
+ N, Subp);
+ return Abandon;
+ else
+ return OK;
+ end if;
+ end Check_Call;
+
+ function Check_Calls is new Traverse_Func (Check_Call);
+
+ begin
+ return Check_Calls (Bod) = Abandon;
+ end Uses_Secondary_Stack;
+
-- Start of processing for Build_Body_To_Inline
begin
Remove (Body_To_Analyze);
Expander_Mode_Restore;
- Set_Body_To_Inline (Decl, Original_Body);
- Set_Ekind (Defining_Entity (Original_Body), Ekind (Subp));
- Set_Is_Inlined (Subp);
if In_Instance then
Restore_Env;
end if;
+
+ -- If secondary stk used there is no point in inlining. We have
+ -- already issued the warning in this case, so nothing to do.
+
+ if Uses_Secondary_Stack (Body_To_Analyze) then
+ return;
+ end if;
+
+ Set_Body_To_Inline (Decl, Original_Body);
+ Set_Ekind (Defining_Entity (Original_Body), Ekind (Subp));
+ Set_Is_Inlined (Subp);
end Build_Body_To_Inline;
-------------------
null;
elsif Is_Always_Inlined (Subp) then
+
+ -- Remove last character (question mark) to make this into an error,
+ -- because the Inline_Always pragma cannot be obeyed.
+
Error_Msg_NE (Msg (1 .. Msg'Length - 1), N, Subp);
elsif Ineffective_Inline_Warnings then
-- match explicit actuals with the same value.
function FCO (Op_Node, Call_Node : Node_Id) return Boolean;
- -- Compare an operator node with a function call.
+ -- Compare an operator node with a function call
---------
-- FCL --
-- body is replaced with the discriminal of the enclosing type.
function Conforming_Ranges (R1, R2 : Node_Id) return Boolean;
- -- Check both bounds.
+ -- Check both bounds
function Conforming_Bounds (B1, B2 : Node_Id) return Boolean is
begin
B : Entity_Id;
begin
- -- Check that equality was properly defined.
+ -- Check that equality was properly defined
if No (Next_Formal (First_Formal (S))) then
return;
if not Is_Dispatching_Operation (E) then
Set_Is_Immediately_Visible (E, False);
else
-
- -- work done in Override_Dispatching_Operation.
+ -- Work done in Override_Dispatching_Operation,
+ -- so nothing else need to be done here.
null;
end if;
while Present (Formal) loop
T := Etype (Formal);
- -- We never need an actual subtype for a constrained formal.
+ -- We never need an actual subtype for a constrained formal
if Is_Constrained (T) then
AS_Needed := False;
projects / gcc.git / commitdiff