-- expression for the value of the actual, EF is the entity for the
-- extra formal.
- procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id);
- -- Check and inline the body of Subp. Invoked when compiling with
- -- optimizations enabled and Subp has pragma inline or inline always.
- -- If the subprogram is a renaming, or if it is inherited, then Subp
- -- references the renamed entity and Orig_Subp is the entity of the
- -- call node N.
-
- procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id);
- -- Check and inline the body of Subp. Invoked when compiling without
- -- optimizations and Subp has pragma inline always. If the subprogram is
- -- a renaming, or if it is inherited, then Subp references the renamed
- -- entity and Orig_Subp is the entity of the call node N.
-
function Inherited_From_Formal (S : Entity_Id) return Entity_Id;
-- Within an instance, a type derived from an untagged formal derived
-- type inherits from the original parent, not from the actual. The
end if;
end Add_Extra_Actual;
- ----------------
- -- Do_Inline --
- ----------------
-
- procedure Do_Inline (Subp : Entity_Id; Orig_Subp : Entity_Id) is
- Spec : constant Node_Id := Unit_Declaration_Node (Subp);
-
- procedure Do_Backend_Inline;
- -- Check that the call can be safely passed to the backend. If true
- -- then register the enclosing unit of Subp to Inlined_Bodies so that
- -- the body of Subp can be retrieved and analyzed by the backend.
-
- -----------------------
- -- Do_Backend_Inline --
- -----------------------
-
- procedure Do_Backend_Inline is
- begin
- -- No extra test needed for init subprograms since we know they
- -- are available to the backend.
-
- if Is_Init_Proc (Subp) then
- Add_Inlined_Body (Subp);
- Register_Backend_Call (Call_Node);
-
- -- Verify that if the body to inline is located in the current
- -- unit the inlining does not occur earlier. This avoids
- -- order-of-elaboration problems in the back end.
-
- elsif In_Same_Extended_Unit (Call_Node, Subp)
- and then Nkind (Spec) = N_Subprogram_Declaration
- and then Earlier_In_Extended_Unit
- (Loc, Sloc (Body_To_Inline (Spec)))
- then
- Error_Msg_NE
- ("cannot inline& (body not seen yet)??", Call_Node, Subp);
-
- else
- declare
- Backend_Inline : Boolean := True;
-
- begin
- -- If we are compiling a package body that is not the
- -- main unit, it must be for inlining/instantiation
- -- purposes, in which case we inline the call to insure
- -- that the same temporaries are generated when compiling
- -- the body by itself. Otherwise link errors can occur.
-
- -- If the function being called is itself in the main
- -- unit, we cannot inline, because there is a risk of
- -- double elaboration and/or circularity: the inlining
- -- can make visible a private entity in the body of the
- -- main unit, that gigi will see before its sees its
- -- proper definition.
-
- if not (In_Extended_Main_Code_Unit (Call_Node))
- and then In_Package_Body
- then
- Backend_Inline :=
- not In_Extended_Main_Source_Unit (Subp);
- end if;
-
- if Backend_Inline then
- Add_Inlined_Body (Subp);
- Register_Backend_Call (Call_Node);
- end if;
- end;
- end if;
- end Do_Backend_Inline;
-
- -- Start of processing for Do_Inline
-
- begin
- -- Verify that the body to inline has already been seen
-
- if No (Spec)
- or else Nkind (Spec) /= N_Subprogram_Declaration
- or else No (Body_To_Inline (Spec))
- then
- if Comes_From_Source (Subp)
- and then Must_Inline (Subp)
- then
- Cannot_Inline
- ("cannot inline& (body not seen yet)?", Call_Node, Subp);
-
- -- Let the back end handle it
-
- else
- Do_Backend_Inline;
- return;
- end if;
-
- -- If this an inherited function that returns a private type, do not
- -- inline if the full view is an unconstrained array, because such
- -- calls cannot be inlined.
-
- elsif Present (Orig_Subp)
- and then Is_Array_Type (Etype (Orig_Subp))
- and then not Is_Constrained (Etype (Orig_Subp))
- then
- Cannot_Inline
- ("cannot inline& (unconstrained array)?", Call_Node, Subp);
-
- else
- Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
- end if;
- end Do_Inline;
-
- ----------------------
- -- Do_Inline_Always --
- ----------------------
-
- procedure Do_Inline_Always (Subp : Entity_Id; Orig_Subp : Entity_Id) is
- Spec : constant Node_Id := Unit_Declaration_Node (Subp);
- Body_Id : Entity_Id;
-
- begin
- if No (Spec)
- or else Nkind (Spec) /= N_Subprogram_Declaration
- or else No (Body_To_Inline (Spec))
- or else Serious_Errors_Detected /= 0
- then
- return;
- end if;
-
- Body_Id := Corresponding_Body (Spec);
-
- -- Verify that the body to inline has already been seen
-
- if No (Body_Id)
- or else not Analyzed (Body_Id)
- then
- Set_Is_Inlined (Subp, False);
-
- if Comes_From_Source (Subp) then
-
- -- Report a warning only if the call is located in the unit of
- -- the called subprogram; otherwise it is an error.
-
- if not In_Same_Extended_Unit (Call_Node, Subp) then
- Cannot_Inline
- ("cannot inline& (body not seen yet)?", Call_Node, Subp,
- Is_Serious => True);
-
- elsif In_Open_Scopes (Subp) then
-
- -- For backward compatibility we generate the same error
- -- or warning of the previous implementation. This will
- -- be changed when we definitely incorporate the new
- -- support ???
-
- if Front_End_Inlining
- and then Optimization_Level = 0
- then
- Error_Msg_N
- ("call to recursive subprogram cannot be inlined?p?",
- N);
-
- -- Do not emit error compiling runtime packages
-
- elsif Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Subp)))
- then
- Error_Msg_N
- ("call to recursive subprogram cannot be inlined??",
- N);
-
- else
- Error_Msg_N
- ("call to recursive subprogram cannot be inlined",
- N);
- end if;
-
- else
- Cannot_Inline
- ("cannot inline& (body not seen yet)?", Call_Node, Subp);
- end if;
- end if;
-
- return;
-
- -- If this an inherited function that returns a private type, do not
- -- inline if the full view is an unconstrained array, because such
- -- calls cannot be inlined.
-
- elsif Present (Orig_Subp)
- and then Is_Array_Type (Etype (Orig_Subp))
- and then not Is_Constrained (Etype (Orig_Subp))
- then
- Cannot_Inline
- ("cannot inline& (unconstrained array)?", Call_Node, Subp);
-
- -- If the called subprogram comes from an instance in the same
- -- unit, and the instance is not yet frozen, inlining might
- -- trigger order-of-elaboration problems.
-
- elsif In_Unfrozen_Instance (Scope (Subp)) then
- Cannot_Inline
- ("cannot inline& (unfrozen instance)?", Call_Node, Subp);
-
- else
- Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
- end if;
- end Do_Inline_Always;
-
---------------------------
-- Inherited_From_Formal --
---------------------------
Set_Needs_Debug_Info (Subp, False);
end if;
- -- Frontend expansion of supported functions returning unconstrained
- -- types and simple renamings inlined by the frontend (see Freeze.
- -- Build_Renamed_Entity).
+ -- Front end expansion of simple functions returning unconstrained
+ -- types (see Check_And_Split_Unconstrained_Function) and simple
+ -- renamings inlined by the front end (see Build_Renamed_Entity).
else
- declare
- Spec : constant Node_Id := Unit_Declaration_Node (Subp);
-
- begin
- if Must_Inline (Subp) then
- if In_Extended_Main_Code_Unit (Call_Node)
- and then In_Same_Extended_Unit (Sloc (Spec), Loc)
- and then not Has_Completion (Subp)
- then
- Cannot_Inline
- ("cannot inline& (body not seen yet)?",
- Call_Node, Subp);
-
- else
- Do_Inline_Always (Subp, Orig_Subp);
- end if;
-
- elsif Optimization_Level > 0 then
- Do_Inline (Subp, Orig_Subp);
- end if;
-
- -- The call may have been inlined or may have been passed to
- -- the backend. No further action needed if it was inlined.
-
- if Nkind (N) /= N_Function_Call then
- return;
- end if;
- end;
+ Expand_Inlined_Call (Call_Node, Subp, Orig_Subp);
end if;
end if;
Error_Msg_NE (Msg & "p?", N, Subp);
end if;
- return;
-
- -- New semantics
+ -- New semantics relying on back end inlining
elsif Is_Serious then
Set_Is_Inlined_Always (Subp, False);
Error_Msg_NE (Msg & "p?", N, Subp);
- -- Do not issue errors/warnings when compiling with optimizations
-
- elsif Optimization_Level = 0 then
+ else
-- Do not emit warning if this is a predefined unit which is not
-- the main unit. This behavior is currently provided for backward
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
- else pragma Assert (Front_End_Inlining);
+ else
Set_Is_Inlined (Subp, False);
- -- When inlining cannot take place we must issue an error.
- -- For backward compatibility we still report a warning.
-
if Ineffective_Inline_Warnings then
Error_Msg_NE (Msg & "p?", N, Subp);
end if;
end if;
-
- -- Compiling with optimizations enabled it is too early to report
- -- problems since the backend may still perform inlining. In order
- -- to report unhandled inlinings the program must be compiled with
- -- -Winline and the error is reported by the backend.
-
- else
- null;
end if;
end Cannot_Inline;
D := First (Decls);
while Present (D) loop
- if Nkind (D) = N_Subprogram_Body then
+ -- First declarations universally excluded
+
+ if Nkind (D) = N_Package_Declaration then
Cannot_Inline
- ("cannot inline & (nested subprogram)?",
+ ("cannot inline & (nested package declaration)?",
+ D, Subp);
+ return True;
+
+ elsif Nkind (D) = N_Package_Instantiation then
+ Cannot_Inline
+ ("cannot inline & (nested package instantiation)?",
D, Subp);
return True;
+ end if;
+
+ -- Then declarations excluded only for front end inlining
+
+ if Back_End_Inlining then
+ null;
elsif Nkind (D) = N_Task_Type_Declaration
or else Nkind (D) = N_Single_Task_Declaration
D, Subp);
return True;
- elsif Nkind (D) = N_Package_Declaration then
+ elsif Nkind (D) = N_Subprogram_Body then
Cannot_Inline
- ("cannot inline & (nested package declaration)?",
+ ("cannot inline & (nested subprogram)?",
D, Subp);
return True;
("cannot inline & (nested procedure instantiation)?",
D, Subp);
return True;
-
- elsif Nkind (D) = N_Package_Instantiation then
- Cannot_Inline
- ("cannot inline & (nested package instantiation)?",
- D, Subp);
- return True;
end if;
Next (D);
projects / gcc.git / commitdiff