begin
-- For restricted run-time libraries (Ravenscar), tasks are
- -- non-terminating and they can only appear at library level, so we do
- -- not want finalization of task objects.
+ -- non-terminating and they can only appear at library level,
+ -- so we do not want finalization of task objects.
if Restricted_Profile then
return Empty;
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('I'));
- Elab_Body := Make_Subprogram_Body (Loc,
- Specification =>
- Make_Procedure_Specification (Loc,
- Defining_Unit_Name => Elab_Proc),
- Declarations => New_List,
- Handled_Statement_Sequence =>
- Relocate_Node (Handled_Statement_Sequence (N)));
+ Elab_Body :=
+ Make_Subprogram_Body (Loc,
+ Specification =>
+ Make_Procedure_Specification (Loc,
+ Defining_Unit_Name => Elab_Proc),
+ Declarations => New_List,
+ Handled_Statement_Sequence =>
+ Relocate_Node (Handled_Statement_Sequence (N)));
+
+ Elab_Call :=
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Elab_Proc, Loc));
- Elab_Call := Make_Procedure_Call_Statement (Loc,
- New_Occurrence_Of (Elab_Proc, Loc));
Append_To (Declarations (N), Elab_Body);
Analyze (Elab_Body);
Set_Has_Nested_Subprogram (Elab_Proc);
Set_Handled_Statement_Sequence (N,
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (Elab_Call)));
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => New_List (Elab_Call)));
+
Analyze (Elab_Call);
- -- The scope of all blocks in the elaboration code is
- -- now the constructed elaboration procedure. Nested
- -- subprograms within those blocks will have activation
- -- records if they contain references to entities in the
- -- enclosing block.
+ -- The scope of all blocks in the elaboration code is now the
+ -- constructed elaboration procedure. Nested subprograms within
+ -- those blocks will have activation records if they contain
+ -- references to entities in the enclosing block.
+
+ Stat :=
+ First (Statements (Handled_Statement_Sequence (Elab_Body)));
- Stat := First
- (Statements (Handled_Statement_Sequence (Elab_Body)));
while Present (Stat) loop
if Nkind (Stat) = N_Block_Statement then
Set_Scope (Entity (Identifier (Stat)), Elab_Proc);
end if;
+
Next (Stat);
end loop;
end if;
procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is
L : constant Nat := Get_Level (Subp, E);
+
begin
Subps.Append
((Ent => E,
ARECnPT => Empty,
ARECnP => Empty,
ARECnU => Empty));
+
Set_Subps_Index (E, UI_From_Int (Subps.Last));
end Register_Subprogram;
-- Record a subprogram call
- when N_Procedure_Call_Statement | N_Function_Call =>
+ when N_Function_Call
+ | N_Procedure_Call_Statement
+ =>
-- We are only interested in direct calls, not indirect
- -- calls (where Name (N) is an explicit dereference).
- -- at least for now!
+ -- calls (where Name (N) is an explicit dereference) at
+ -- least for now!
if Nkind (Name (N)) in N_Has_Entity then
Ent := Entity (Name (N));
-- for uplevel references.
declare
- Subp : Entity_Id;
Actual : Entity_Id;
- Formal : Node_Id;
DT : Boolean := False;
+ Formal : Node_Id;
+ Subp : Entity_Id;
begin
if Nkind (Name (N)) = N_Explicit_Dereference then
end loop;
end;
- -- An At_End_Proc in a statement sequence indicates that
- -- there's a call from the enclosing construct or block
- -- to that subprogram. As above, the called entity must
- -- be local and not imported.
+ -- An At_End_Proc in a statement sequence indicates that there
+ -- is a call from the enclosing construct or block to that
+ -- subprogram. As above, the called entity must be local and
+ -- not imported.
when N_Handled_Sequence_Of_Statements =>
if Present (At_End_Proc (N))
and then Scope_Within (Entity (At_End_Proc (N)), Subp)
and then not Is_Imported (Entity (At_End_Proc (N)))
then
- Append_Unique_Call ((N, Current_Subprogram,
- Entity (At_End_Proc (N))));
+ Append_Unique_Call
+ ((N, Current_Subprogram, Entity (At_End_Proc (N))));
end if;
-- A 'Access reference is a (potential) call.
declare
DT : Boolean := False;
begin
- Check_Static_Type (Etype (Prefix (N)),
- Empty, DT);
+ Check_Static_Type
+ (Etype (Prefix (N)), Empty, DT);
end;
return OK;
end if;
-- Make new entry in subprogram table if not already made
+
Register_Subprogram (Ent, N);
-- We make a recursive call to scan the subprogram body, so
return Skip;
- -- If we have a body stub, visit the associated subunit,
- -- which is a semantic descendant of the stub.
+ -- If we have a body stub, visit the associated subunit, which
+ -- is a semantic descendant of the stub.
when N_Body_Stub =>
Visit (Library_Unit (N));
-- Otherwise record an uplevel reference
when others =>
- if
- Nkind (N) in N_Has_Entity and then Present (Entity (N))
+ if Nkind (N) in N_Has_Entity
+ and then Present (Entity (N))
then
Ent := Entity (N);
and then
Chars (Enclosing_Subprogram (Ent)) /= Name_uParent
- -- Constants and variables are potentially
- -- uplevel references to global declarations.
+ -- Constants and variables are potentially uplevel
+ -- references to global declarations.
and then
(Ekind_In (Ent, E_Constant, E_Variable)
- -- Formals are interesting, but not if being used as mere
- -- names of parameters for name notation calls.
+ -- Formals are interesting, but not if being used as
+ -- mere names of parameters for name notation calls.
or else
(Is_Formal (Ent)
and then Selector_Name (Parent (N)) = N))
-- Types other than known Is_Static types are
- -- potentially interesting
+ -- potentially interesting.
or else (Is_Type (Ent)
and then not Is_Static_Type (Ent)))
return;
end if;
- -- A specification will contain bodies if it contains instantiations
- -- so examine package or subprogram declaration of the main unit,
- -- when it is present.
+ -- A specification will contain bodies if it contains instantiations so
+ -- examine package or subprogram declaration of the main unit, when it
+ -- is present.
if Nkind (Unit (N)) = N_Package_Body
- or else (Nkind (Unit (N)) = N_Subprogram_Body
- and then not Acts_As_Spec (N))
+ or else (Nkind (Unit (N)) = N_Subprogram_Body
+ and then not Acts_As_Spec (N))
then
Do_Search (Library_Unit (N));
end if;
projects / gcc.git / commitdiff