Next : Succ_Index;
end record;
- -- The following table stores list elements for the successor lists.
- -- These lists cannot be chained directly through entries in the Inlined
- -- table, because a given subprogram can appear in several such lists.
+ -- The following table stores list elements for the successor lists. These
+ -- lists cannot be chained directly through entries in the Inlined table,
+ -- because a given subprogram can appear in several such lists.
package Successors is new Table.Table (
Table_Component_Type => Succ_Info,
function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id;
pragma Inline (Get_Code_Unit_Entity);
- -- Return the entity node for the unit containing E. Always return
- -- the spec for a package.
+ -- Return the entity node for the unit containing E. Always return the spec
+ -- for a package.
function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean;
-- Return True if E is in the main unit or its spec or in a subunit
-- non-trivial initialization procedures, they are not worth inlining.
function Is_Nested (E : Entity_Id) return Boolean;
- -- If the function is nested inside some other function, it will
- -- always be compiled if that function is, so don't add it to the
- -- inline list. We cannot compile a nested function outside the
- -- scope of the containing function anyway. This is also the case if
- -- the function is defined in a task body or within an entry (for
- -- example, an initialization procedure).
+ -- If the function is nested inside some other function, it will always
+ -- be compiled if that function is, so don't add it to the inline list.
+ -- We cannot compile a nested function outside the scope of the containing
+ -- function anyway. This is also the case if the function is defined in a
+ -- task body or within an entry (for example, an initialization procedure).
procedure Add_Inlined_Subprogram (Index : Subp_Index);
-- Add the subprogram to the list of inlined subprogram for the unit
------------------------------
-- The cleanup actions for scopes that contain instantiations is delayed
- -- until after expansion of those instantiations, because they may
- -- contain finalizable objects or tasks that affect the cleanup code.
- -- A scope that contains instantiations only needs to be finalized once,
- -- even if it contains more than one instance. We keep a list of scopes
- -- that must still be finalized, and call cleanup_actions after all the
- -- instantiations have been completed.
+ -- until after expansion of those instantiations, because they may contain
+ -- finalizable objects or tasks that affect the cleanup code. A scope
+ -- that contains instantiations only needs to be finalized once, even
+ -- if it contains more than one instance. We keep a list of scopes
+ -- that must still be finalized, and call cleanup_actions after all
+ -- the instantiations have been completed.
To_Clean : Elist_Id;
while Scope (Scop) /= Standard_Standard
and then not Is_Child_Unit (Scop)
loop
- if Is_Overloadable (Scop)
- and then Is_Inlined (Scop)
- then
+ if Is_Overloadable (Scop) and then Is_Inlined (Scop) then
Add_Call (E, Scop);
if Inline_Level = 1 then
end if;
if Present
- (Exception_Handlers
- (Handled_Statement_Sequence
- (Unit_Declaration_Node (Corresponding_Body (Decl)))))
+ (Exception_Handlers
+ (Handled_Statement_Sequence
+ (Unit_Declaration_Node (Corresponding_Body (Decl)))))
then
return True;
end if;
if Is_Inlined (E)
and then (Is_Inlined (Pack)
- or else Is_Generic_Instance (Pack)
- or else Is_Internal (E))
+ or else Is_Generic_Instance (Pack)
+ or else Is_Internal (E))
and then not In_Main_Unit_Or_Subunit (E)
and then not Is_Nested (E)
and then not Has_Initialized_Type (E)
-- elementary statements, as a measure of acceptable size.
function Has_Pending_Instantiation return Boolean;
- -- If some enclosing body contains instantiations that appear before the
- -- corresponding generic body, the enclosing body has a freeze node so
- -- that it can be elaborated after the generic itself. This might
+ -- If some enclosing body contains instantiations that appear before
+ -- the corresponding generic body, the enclosing body has a freeze node
+ -- so that it can be elaborated after the generic itself. This might
-- conflict with subsequent inlinings, so that it is unsafe to try to
-- inline in such a case.
D := First (Decls);
while Present (D) loop
if (Nkind (D) = N_Function_Instantiation
- and then not Is_Unchecked_Conversion (D))
+ and then not Is_Unchecked_Conversion (D))
or else Nkind_In (D, N_Protected_Type_Declaration,
N_Package_Declaration,
N_Package_Instantiation,
elsif Present (Handled_Statement_Sequence (S))
and then
(Present
- (Exception_Handlers (Handled_Statement_Sequence (S)))
- or else
- Has_Excluded_Statement
- (Statements (Handled_Statement_Sequence (S))))
+ (Exception_Handlers (Handled_Statement_Sequence (S)))
+ or else
+ Has_Excluded_Statement
+ (Statements (Handled_Statement_Sequence (S))))
then
return True;
end if;
elsif Nkind (S) = N_Extended_Return_Statement then
if Has_Excluded_Statement
- (Statements (Handled_Statement_Sequence (S)))
- or else Present
- (Exception_Handlers (Handled_Statement_Sequence (S)))
+ (Statements (Handled_Statement_Sequence (S)))
+ or else
+ Present
+ (Exception_Handlers (Handled_Statement_Sequence (S)))
then
return True;
end if;
First (Exception_Handlers (Handled_Statement_Sequence (N))),
Subp);
return;
+
elsif
- Has_Excluded_Statement
- (Statements (Handled_Statement_Sequence (N)))
+ Has_Excluded_Statement (Statements (Handled_Statement_Sequence (N)))
then
return;
end if;
-- We need to capture references to the formals in order to substitute
-- the actuals at the point of inlining, i.e. instantiation. To treat
- -- the formals as globals to the body to inline, we nest it within
- -- a dummy parameterless subprogram, declared within the real one.
- -- To avoid generating an internal name (which is never public, and
- -- which affects serial numbers of other generated names), we use
- -- an internal symbol that cannot conflict with user declarations.
+ -- the formals as globals to the body to inline, we nest it within a
+ -- dummy parameterless subprogram, declared within the real one. To
+ -- avoid generating an internal name (which is never public, and which
+ -- affects serial numbers of other generated names), we use an internal
+ -- symbol that cannot conflict with user declarations.
Set_Parameter_Specifications (Specification (Original_Body), No_List);
Set_Defining_Unit_Name
Gen_P : constant Entity_Id := Generic_Parent (Parent (Subp));
begin
if Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Gen_P)))
+ (Unit_File_Name (Get_Source_Unit (Gen_P)))
then
Set_Is_Inlined (Subp, False);
Error_Msg_NE (Msg & "p?", N, Subp);
D := First (Decls);
while Present (D) loop
if (Nkind (D) = N_Function_Instantiation
- and then not Is_Unchecked_Conversion (D))
+ and then not Is_Unchecked_Conversion (D))
or else Nkind_In (D, N_Protected_Type_Declaration,
N_Package_Declaration,
N_Package_Instantiation,
elsif Present (Handled_Statement_Sequence (S)) then
if Present
- (Exception_Handlers (Handled_Statement_Sequence (S)))
+ (Exception_Handlers (Handled_Statement_Sequence (S)))
then
Cannot_Inline
("cannot inline& (exception handler)?",
First (Exception_Handlers
- (Handled_Statement_Sequence (S))),
+ (Handled_Statement_Sequence (S))),
Subp);
return True;
elsif Has_Excluded_Statement
- (Statements (Handled_Statement_Sequence (S)))
+ (Statements (Handled_Statement_Sequence (S)))
then
return True;
end if;
elsif Present (Handled_Statement_Sequence (S))
and then
Present (Exception_Handlers
- (Handled_Statement_Sequence (S)))
+ (Handled_Statement_Sequence (S)))
then
Cannot_Inline
("cannot inline& (exception handler)?",
begin
S := Current_Scope;
while Present (S) loop
- if Is_Compilation_Unit (S)
- or else Is_Child_Unit (S)
- then
+ if Is_Compilation_Unit (S) or else Is_Child_Unit (S) then
return False;
elsif Ekind (S) = E_Package
if Present (Expression (N)) then
declare
Orig_Expr : constant Node_Id :=
- Original_Node (Expression (N));
+ Original_Node (Expression (N));
begin
if Nkind_In (Orig_Expr, N_Integer_Literal,
- N_Real_Literal,
- N_Character_Literal)
+ N_Real_Literal,
+ N_Character_Literal)
then
return OK;
then
Cannot_Inline
("cannot inline& (exception handler)?",
- First
- (Exception_Handlers (Handled_Statement_Sequence (N))),
+ First (Exception_Handlers (Handled_Statement_Sequence (N))),
Subp);
-
return False;
elsif Has_Excluded_Statement
- (Statements (Handled_Statement_Sequence (N)))
+ (Statements (Handled_Statement_Sequence (N)))
then
return False;
end if;
Cannot_Inline
("cannot inline& (forward instance within enclosing body)?",
N, Subp);
-
return False;
end if;
-- Build a procedure containing the statements found in the extended
-- return statement of the unconstrained function body N.
+ ---------------------
+ -- Build_Procedure --
+ ---------------------
+
procedure Build_Procedure
(Proc_Id : out Entity_Id;
Decl_List : out List_Id)
is
- Formal : Entity_Id;
- Formal_List : constant List_Id := New_List;
- Proc_Spec : Node_Id;
- Proc_Body : Node_Id;
- Subp_Name : constant Name_Id := New_Internal_Name ('F');
+ Formal : Entity_Id;
+ Formal_List : constant List_Id := New_List;
+ Proc_Spec : Node_Id;
+ Proc_Body : Node_Id;
+ Subp_Name : constant Name_Id := New_Internal_Name ('F');
Body_Decl_List : List_Id := No_List;
- Param_Type : Node_Id;
+ Param_Type : Node_Id;
begin
if Nkind (Object_Definition (Ret_Obj)) = N_Identifier then
- Param_Type := New_Copy (Object_Definition (Ret_Obj));
+ Param_Type :=
+ New_Copy (Object_Definition (Ret_Obj));
else
Param_Type :=
New_Copy (Subtype_Mark (Object_Definition (Ret_Obj)));
Append_To (Formal_List,
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
+ Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier (Ret_Obj))),
- In_Present => False,
- Out_Present => True,
+ In_Present => False,
+ Out_Present => True,
Null_Exclusion_Present => False,
- Parameter_Type => Param_Type));
+ Parameter_Type => Param_Type));
Formal := First_Formal (Spec_Id);
while Present (Formal) loop
Append_To (Formal_List,
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
+ Defining_Identifier =>
Make_Defining_Identifier (Sloc (Formal),
Chars => Chars (Formal)),
- In_Present => In_Present (Parent (Formal)),
- Out_Present => Out_Present (Parent (Formal)),
+ In_Present => In_Present (Parent (Formal)),
+ Out_Present => Out_Present (Parent (Formal)),
Null_Exclusion_Present =>
Null_Exclusion_Present (Parent (Formal)),
- Parameter_Type =>
+ Parameter_Type =>
New_Occurrence_Of (Etype (Formal), Loc),
- Expression =>
+ Expression =>
Copy_Separate_Tree (Expression (Parent (Formal)))));
Next_Formal (Formal);
end loop;
- Proc_Id :=
- Make_Defining_Identifier (Loc, Chars => Subp_Name);
+ Proc_Id := Make_Defining_Identifier (Loc, Chars => Subp_Name);
Proc_Spec :=
Make_Procedure_Specification (Loc,
- Defining_Unit_Name => Proc_Id,
+ Defining_Unit_Name => Proc_Id,
Parameter_Specifications => Formal_List);
Decl_List := New_List;
begin
-- Build the associated procedure, analyze it and insert it before
- -- the function body N
+ -- the function body N.
declare
Scope : constant Entity_Id := Current_Scope;
Proc_Call :=
Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Proc_Id, Loc),
+ Name => New_Occurrence_Of (Proc_Id, Loc),
Parameter_Associations => Actual_List);
end;
Blk_Stmt :=
Make_Block_Statement (Loc,
- Declarations => New_List (New_Obj),
+ Declarations => New_List (New_Obj),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
-- Start of processing for Check_And_Build_Body_To_Inline
begin
- -- Do not inline any subprogram that contains nested subprograms, since
- -- the backend inlining circuit seems to generate uninitialized
+ -- Do not inline any subprogram that contains nested subprograms,
+ -- since the backend inlining circuit seems to generate uninitialized
-- references in this case. We know this happens in the case of front
- -- end ZCX support, but it also appears it can happen in other cases as
- -- well. The backend often rejects attempts to inline in the case of
- -- nested procedures anyway, so little if anything is lost by this.
- -- Note that this is test is for the benefit of the back-end. There is
- -- a separate test for front-end inlining that also rejects nested
+ -- end ZCX support, but it also appears it can happen in other cases
+ -- as well. The backend often rejects attempts to inline in the case
+ -- of nested procedures anyway, so little if anything is lost by this.
+ -- Note that this is test is for the benefit of the back-end. There
+ -- is a separate test for front-end inlining that also rejects nested
-- subprograms.
-- Do not do this test if errors have been detected, because in some
if Comes_From_Source (Body_Id)
and then (Has_Pragma_Inline_Always (Spec_Id)
- or else Optimization_Level > 0)
+ or else Optimization_Level > 0)
and then Serious_Errors_Detected = 0
then
declare
end if;
end if;
end Check_And_Build_Body_To_Inline;
+
-----------------------------
-- Check_Body_For_Inlining --
-----------------------------
Ent := First_Entity (P);
while Present (Ent) loop
if Is_Type (Ent)
- and then Has_Completion_In_Body (Ent)
+ and then Has_Completion_In_Body (Ent)
then
Set_Full_View (Ent, Empty);
and then Is_Protected_Type (Scope (Scop))
and then Present (Protected_Body_Subprogram (Scop))
then
- -- If a protected operation contains an instance, its
- -- 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, so propagate the
- -- information that triggers cleanup activity.
+ -- If a protected operation contains an instance, its 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, so propagate the information that triggers cleanup
+ -- activity.
Set_Uses_Sec_Stack
(Protected_Body_Subprogram (Scop),
else
Decl := Unit_Declaration_Node (Scop);
- if Nkind (Decl) = N_Subprogram_Declaration
- or else Nkind (Decl) = N_Task_Type_Declaration
- or else Nkind (Decl) = N_Subprogram_Body_Stub
+ if Nkind_In (Decl, N_Subprogram_Declaration,
+ N_Task_Type_Declaration,
+ N_Subprogram_Body_Stub)
then
Decl := Unit_Declaration_Node (Corresponding_Body (Decl));
end if;
is
Loc : constant Source_Ptr := Sloc (N);
Is_Predef : constant Boolean :=
- Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Subp)));
+ Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Subp)));
Orig_Bod : constant Node_Id :=
Body_To_Inline (Unit_Declaration_Node (Subp));
Blk : Node_Id;
Decl : Node_Id;
Decls : constant List_Id := New_List;
- Exit_Lab : Entity_Id := Empty;
+ Exit_Lab : Entity_Id := Empty;
F : Entity_Id;
A : Node_Id;
Lab_Decl : Node_Id;
Exit_Lab := Make_Label (Loc, Lab_Id);
Lab_Decl :=
Make_Implicit_Label_Declaration (Loc,
- Defining_Identifier => Lab_Ent,
- Label_Construct => Exit_Lab);
+ Defining_Identifier => Lab_Ent,
+ Label_Construct => Exit_Lab);
end if;
end Make_Exit_Label;
Ret :=
Make_Qualified_Expression (Sloc (N),
Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
- Expression => Relocate_Node (Expression (N)));
+ Expression => Relocate_Node (Expression (N)));
else
Ret :=
Unchecked_Convert_To
Bod := Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True);
Blk :=
Make_Block_Statement (Loc,
- Declarations => Declarations (Bod),
+ Declarations => Declarations (Bod),
Handled_Statement_Sequence =>
Handled_Statement_Sequence (Bod));
Copy_Generic_Node (Orig_Bod, Empty, Instantiating => True);
Blk :=
Make_Block_Statement (Loc,
- Declarations => Declarations (Bod),
- Handled_Statement_Sequence =>
- Handled_Statement_Sequence (Bod));
+ Declarations => Declarations (Bod),
+ Handled_Statement_Sequence =>
+ Handled_Statement_Sequence (Bod));
-- Inline a call to a function that returns an unconstrained type.
-- The semantic analyzer checked that frontend-inlined functions
pragma Assert
(Nkind
(First
- (Statements (Handled_Statement_Sequence (Orig_Bod))))
- = N_Block_Statement);
+ (Statements (Handled_Statement_Sequence (Orig_Bod)))) =
+ N_Block_Statement);
declare
Blk_Stmt : constant Node_Id :=
- First
- (Statements
- (Handled_Statement_Sequence (Orig_Bod)));
+ First (Statements (Handled_Statement_Sequence (Orig_Bod)));
First_Stmt : constant Node_Id :=
- First
- (Statements
- (Handled_Statement_Sequence (Blk_Stmt)));
+ First (Statements (Handled_Statement_Sequence (Blk_Stmt)));
Second_Stmt : constant Node_Id := Next (First_Stmt);
begin
-- eventually be possible to remove that temporary and use the
-- result variable directly.
- if Is_Unc
- and then Nkind (Parent (N)) /= N_Assignment_Statement
+ if Is_Unc and then Nkind (Parent (N)) /= N_Assignment_Statement
then
Decl :=
Make_Object_Declaration (Loc,
Next_Formal (F);
end loop;
end Expand_Inlined_Call;
+
--------------------------
-- Get_Code_Unit_Entity --
--------------------------
else
Decl := First (Declarations (E_Body));
while Present (Decl) loop
-
if Nkind (Decl) = N_Full_Type_Declaration
and then Present (Init_Proc (Defining_Identifier (Decl)))
then