Skip to content

R
riscv-gcc-1
Commit f68289d8 by Gary Dismukes Committed by Pierre-Marie de Rodat
Options

[Ada] Generation of procedures for blocks occurring in elaboration code for LLVM 

2019-10-10  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* exp_ch7.adb (Check_Unnesting_Elaboration_Code): Various
	cleanups.
	(Set_Elab_Proc): New procedure to create the defining identifier
	for a procedure created to encapsulate top-level blocks
	occurring as a part of library package elaboration.
	(First_Local_Scope): Function replaced by
	Reset_Scopes_To_Elab_Proc.
	(Reset_Scopes_To_Elab_Proc): New recursive procedure based on
	First_Local_Scope, which it replaces, that is called to traverse
	the statements of a library package body to locate top-level
	blocks and determine whether they contain nested subprograms
	that might address library-level objects of the package. Such
	blocks (and loops) and certain top-level subprograms within the
	statements will have their Scope reset here to match an
	encapsulating procedure created by
	Check_Unnesting_Elaboration_Code that will contain the
	statements.
	(Check_Unnesting_In_Decls_Or_Stmts): Code for handling blocks
	factored out into Unnest_Block. Add handling for package
	declarations and bodies, making recursive calls for
	visible/private declarations, body declarations, statements, and
	exception handlers. Also remove test for Is_Compilation_Unit:
	caller tests for Is_Library_Level_Entity instead.  Also, this
	proc's name was changed from Check_Unnesting_In_Declarations.
	(Check_Unnesting_In_Handlers): New procedure to traverse a
	sequence of exception handlers, calling
	Check_Unnesting_In_Decls_Or_Stmts on the statements of each
	handler.
	(Expand_N_Package_Body): Call Check_Unnesting_* routines only
	when Unnest_Subprogram_Mode is set and the current scope is a
	library-level entity (which includes packages and instantiations
	nested directly within a library unit).
	(Expand_N_Package_Declaration): Call Check_Unnesting_* routines
	only when Unnest_Subprogram_Mode is set and the current scope is
	a library-level entity (which includes packages and
	instantiations nested directly within a library unit).
	(Unnest_Block): New procedure factored out of
	Check_Unnesting_In_Decls_Or_Stmts, for creating a new procedure
	to replace a block statement and resetting the Scope fields of
	the block's top-level entities.

From-SVN: r276816
parent d408dbfe
Showing with 265 additions and 157 deletions
gcc/ada/ChangeLog
2019-10-10 Anthony Leonardo Gracio <leonardo@adacore.com> 2019-10-10 Gary Dismukes <dismukes@adacore.com>
* doc/gnat_ugn/about_this_guide.rst, * exp_ch7.adb (Check_Unnesting_Elaboration_Code): Various
doc/gnat_ugn/building_executable_programs_with_gnat.rst, cleanups.
doc/gnat_ugn/getting_started_with_gnat.rst, (Set_Elab_Proc): New procedure to create the defining identifier
doc/gnat_ugn/gnat_and_program_execution.rst, errout.ads, for a procedure created to encapsulate top-level blocks
exp_ch3.adb, gnatls.adb, impunit.adb, lib-writ.ads, opt.ads, occurring as a part of library package elaboration.
sem_ch7.adb, sem_prag.adb, sem_res.adb, sem_warn.adb, (First_Local_Scope): Function replaced by
terminals.c: Replace GPS by GNAT Studio. Reset_Scopes_To_Elab_Proc.
* gnat_ugn.texi: Regenerate. (Reset_Scopes_To_Elab_Proc): New recursive procedure based on
\ No newline at end of file First_Local_Scope, which it replaces, that is called to traverse
the statements of a library package body to locate top-level
blocks and determine whether they contain nested subprograms
that might address library-level objects of the package. Such
blocks (and loops) and certain top-level subprograms within the
statements will have their Scope reset here to match an
encapsulating procedure created by
Check_Unnesting_Elaboration_Code that will contain the
statements.
(Check_Unnesting_In_Decls_Or_Stmts): Code for handling blocks
factored out into Unnest_Block. Add handling for package
declarations and bodies, making recursive calls for
visible/private declarations, body declarations, statements, and
exception handlers. Also remove test for Is_Compilation_Unit:
caller tests for Is_Library_Level_Entity instead. Also, this
proc's name was changed from Check_Unnesting_In_Declarations.
(Check_Unnesting_In_Handlers): New procedure to traverse a
sequence of exception handlers, calling
Check_Unnesting_In_Decls_Or_Stmts on the statements of each
handler.
(Expand_N_Package_Body): Call Check_Unnesting_* routines only
when Unnest_Subprogram_Mode is set and the current scope is a
library-level entity (which includes packages and instantiations
nested directly within a library unit).
(Expand_N_Package_Declaration): Call Check_Unnesting_* routines
only when Unnest_Subprogram_Mode is set and the current scope is
a library-level entity (which includes packages and
instantiations nested directly within a library unit).
(Unnest_Block): New procedure factored out of
Check_Unnesting_In_Decls_Or_Stmts, for creating a new procedure
to replace a block statement and resetting the Scope fields of
the block's top-level entities.
\ No newline at end of file
gcc/ada/exp_ch7.adb
...@@ -364,20 +364,39 @@ package body Exp_Ch7 is ...@@ -364,20 +364,39 @@ package body Exp_Ch7 is
procedure Check_Unnesting_Elaboration_Code (N : Node_Id); procedure Check_Unnesting_Elaboration_Code (N : Node_Id);
-- The statement part of a package body that is a compilation unit may -- The statement part of a package body that is a compilation unit may
-- contain blocks that declare local subprograms. In Subprogram_Unnesting -- contain blocks that declare local subprograms. In Subprogram_Unnesting_
-- Mode such subprograms must be handled as nested inside the (implicit) -- Mode such subprograms must be handled as nested inside the (implicit)
-- elaboration procedure that executes that statement part. To handle -- elaboration procedure that executes that statement part. To handle
-- properly uplevel references we construct that subprogram explicitly, -- properly uplevel references we construct that subprogram explicitly,
-- to contain blocks and inner subprograms, The statement part becomes -- to contain blocks and inner subprograms, The statement part becomes
-- a call to this subprogram. This is only done if blocks are present -- a call to this subprogram. This is only done if blocks are present
-- in the statement list of the body. -- in the statement list of the body. (It would be nice to unify this
-- procedure with Check_Unnesting_In_Decls_Or_Stmts, if possible, since
procedure Check_Unnesting_In_Declarations (Decls : List_Id); -- they're doing very similar work, but are structured differently. ???)
-- Similarly, the declarations in the package body may have created
-- blocks with nested subprograms. Such a block must be transformed into a procedure Check_Unnesting_In_Decls_Or_Stmts (Decls_Or_Stmts : List_Id);
-- procedure followed by a call to it, so that unnesting can handle uplevel -- Similarly, the declarations or statements in library-level packages may
-- references within these nested subprograms (typically generated -- have created blocks blocks with nested subprograms. Such a block must be
-- subprograms to handle finalization actions). -- transformed into a procedure followed by a call to it, so that unnesting
-- can handle uplevel references within these nested subprograms (typically
-- subprograms that handle finalization actions). This also applies to
-- nested packages, including instantiations, in which case it must
-- recursively process inner bodies.
procedure Check_Unnesting_In_Handlers (N : Node_Id);
-- Similarly, check for blocks with nested subprograms occurring within
-- a set of exception handlers associated with a package body N.
procedure Unnest_Block (Decl : Node_Id);
-- Blocks that contain nested subprograms with up-level references need to
-- create activation records for them. We do this by rewriting the block as
-- a procedure, followed by a call to it in the same declarative list, to
-- replicate the semantics of the original block.
--
-- A common source for such block is a transient block created for a
-- construct (declaration, assignment, etc.) that involves controlled
-- actions or secondary-stack management, in which case the nested
-- subprogram is a finalizer.
procedure Check_Visibly_Controlled procedure Check_Visibly_Controlled
(Prim : Final_Primitives; (Prim : Final_Primitives;
...@@ -4021,26 +4040,38 @@ package body Exp_Ch7 is ...@@ -4021,26 +4040,38 @@ package body Exp_Ch7 is
procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
First_Ent : Entity_Id := Empty; Block_Elab_Proc : Entity_Id := Empty;
Loop_Id : Entity_Id := Empty;
procedure Set_Block_Elab_Proc;
function First_Local_Scope (L : List_Id) return Entity_Id; -- Create a defining identifier for a procedure that will replace
-- Find first entity in the elaboration code of the body that contains -- a block with nested subprograms (unless it has already been created,
-- or represents a subprogram body. A body can appear within a block or -- in which case this is a no-op).
-- a loop or can appear by itself if generated for an object declaration
-- that involves controlled actions. The first such entity encountered procedure Set_Block_Elab_Proc is
-- is used to reset the scopes of all entities that become local to the begin
-- new elaboration procedure. This is needed for subsequent unnesting, if No (Block_Elab_Proc) then
-- which depends on the scope links to determine the nesting level of Block_Elab_Proc :=
-- each subprogram. Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('I'));
end if;
end Set_Block_Elab_Proc;
procedure Reset_Scopes_To_Block_Elab_Proc (L : List_Id);
-- Find entities in the elaboration code of a library package body that
-- contain or represent a subprogram body. A body can appear within a
-- block or a loop or can appear by itself if generated for an object
-- declaration that involves controlled actions. The first such entity
-- forces creation of a new procedure entity (via Set_Block_Elab_Proc)
-- that will be used to reset the scopes of all entities that become
-- local to the new elaboration procedure. This is needed for subsequent
-- unnesting actions, which depend on proper setting of the Scope links
-- to determine the nesting level of each subprogram.
----------------------- -----------------------
-- Find_Local_Scope -- -- Find_Local_Scope --
----------------------- -----------------------
function First_Local_Scope (L : List_Id) return Entity_Id is procedure Reset_Scopes_To_Block_Elab_Proc (L : List_Id) is
Id : Entity_Id; Id : Entity_Id;
Scop : Entity_Id;
Stat : Node_Id; Stat : Node_Id;
begin begin
...@@ -4050,41 +4081,36 @@ package body Exp_Ch7 is ...@@ -4050,41 +4081,36 @@ package body Exp_Ch7 is
when N_Block_Statement => when N_Block_Statement =>
Id := Entity (Identifier (Stat)); Id := Entity (Identifier (Stat));
if No (First_Ent) then -- The Scope of this block needs to be reset to the new
First_Ent := Id; -- procedure if the block contains nested subprograms.
end if;
if Present (Id) and then Contains_Subprogram (Id) then if Present (Id) and then Contains_Subprogram (Id) then
return Id; Set_Block_Elab_Proc;
Set_Scope (Id, Block_Elab_Proc);
end if; end if;
when N_Loop_Statement => when N_Loop_Statement =>
Id := Entity (Identifier (Stat)); Id := Entity (Identifier (Stat));
if No (First_Ent) then if Present (Id) and then Contains_Subprogram (Id) then
First_Ent := Id;
end if;
if Contains_Subprogram (Id) then
if Scope (Id) = Current_Scope then if Scope (Id) = Current_Scope then
Loop_Id := Id; Set_Block_Elab_Proc;
Set_Scope (Id, Block_Elab_Proc);
end if; end if;
return Id;
end if; end if;
when N_If_Statement => -- We traverse the loop's statements as well, which may
Scop := First_Local_Scope (Then_Statements (Stat)); -- include other block (etc.) statements that need to have
-- their Scope set to Block_Elab_Proc. (Is this really the
-- case, or do such nested blocks refer to the loop scope
-- rather than the loop's enclosing scope???.)
if Present (Scop) then Reset_Scopes_To_Block_Elab_Proc (Statements (Stat));
return Scop;
end if;
Scop := First_Local_Scope (Else_Statements (Stat)); when N_If_Statement =>
Reset_Scopes_To_Block_Elab_Proc (Then_Statements (Stat));
if Present (Scop) then Reset_Scopes_To_Block_Elab_Proc (Else_Statements (Stat));
return Scop;
end if;
declare declare
Elif : Node_Id; Elif : Node_Id;
...@@ -4092,11 +4118,8 @@ package body Exp_Ch7 is ...@@ -4092,11 +4118,8 @@ package body Exp_Ch7 is
begin begin
Elif := First (Elsif_Parts (Stat)); Elif := First (Elsif_Parts (Stat));
while Present (Elif) loop while Present (Elif) loop
Scop := First_Local_Scope (Statements (Elif)); Reset_Scopes_To_Block_Elab_Proc
(Then_Statements (Elif));
if Present (Scop) then
return Scop;
end if;
Next (Elif); Next (Elif);
end loop; end loop;
...@@ -4109,24 +4132,19 @@ package body Exp_Ch7 is ...@@ -4109,24 +4132,19 @@ package body Exp_Ch7 is
begin begin
Alt := First (Alternatives (Stat)); Alt := First (Alternatives (Stat));
while Present (Alt) loop while Present (Alt) loop
Scop := First_Local_Scope (Statements (Alt)); Reset_Scopes_To_Block_Elab_Proc (Statements (Alt));
if Present (Scop) then
return Scop;
end if;
Next (Alt); Next (Alt);
end loop; end loop;
end; end;
-- Reset the Scope of a subprogram occurring at the top level
when N_Subprogram_Body => when N_Subprogram_Body =>
Id := Defining_Entity (Stat); Id := Defining_Entity (Stat);
if No (First_Ent) then Set_Block_Elab_Proc;
First_Ent := Id; Set_Scope (Id, Block_Elab_Proc);
end if;
return Id;
when others => when others =>
null; null;
...@@ -4134,67 +4152,52 @@ package body Exp_Ch7 is ...@@ -4134,67 +4152,52 @@ package body Exp_Ch7 is
Next (Stat); Next (Stat);
end loop; end loop;
end Reset_Scopes_To_Block_Elab_Proc;
return Empty;
end First_Local_Scope;
-- Local variables -- Local variables
H_Seq : constant Node_Id := Handled_Statement_Sequence (N); H_Seq : constant Node_Id := Handled_Statement_Sequence (N);
Elab_Body : Node_Id; Elab_Body : Node_Id;
Elab_Call : Node_Id; Elab_Call : Node_Id;
Elab_Proc : Entity_Id;
Ent : Entity_Id;
-- Start of processing for Check_Unnesting_Elaboration_Code -- Start of processing for Check_Unnesting_Elaboration_Code
begin begin
if Unnest_Subprogram_Mode if Present (H_Seq) then
and then Present (H_Seq) Reset_Scopes_To_Block_Elab_Proc (Statements (H_Seq));
and then Is_Compilation_Unit (Current_Scope)
then
Ent := First_Local_Scope (Statements (H_Seq));
-- There msy be subprograms declared in the exception handlers -- There may be subprograms declared in the exception handlers
-- of the current body. -- of the current body.
if No (Ent) and then Present (Exception_Handlers (H_Seq)) then if Present (Exception_Handlers (H_Seq)) then
declare declare
Handler : Node_Id := First (Exception_Handlers (H_Seq)); Handler : Node_Id := First (Exception_Handlers (H_Seq));
begin begin
while Present (Handler) loop while Present (Handler) loop
Ent := First_Local_Scope (Statements (Handler)); Reset_Scopes_To_Block_Elab_Proc (Statements (Handler));
if Present (Ent) then
First_Ent := Ent;
exit;
end if;
Next (Handler); Next (Handler);
end loop; end loop;
end; end;
end if; end if;
if Present (Ent) then if Present (Block_Elab_Proc) then
Elab_Proc :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('I'));
Elab_Body := Elab_Body :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
Specification => Specification =>
Make_Procedure_Specification (Loc, Make_Procedure_Specification (Loc,
Defining_Unit_Name => Elab_Proc), Defining_Unit_Name => Block_Elab_Proc),
Declarations => New_List, Declarations => New_List,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Relocate_Node (Handled_Statement_Sequence (N))); Relocate_Node (Handled_Statement_Sequence (N)));
Elab_Call := Elab_Call :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Elab_Proc, Loc)); Name => New_Occurrence_Of (Block_Elab_Proc, Loc));
Append_To (Declarations (N), Elab_Body); Append_To (Declarations (N), Elab_Body);
Analyze (Elab_Body); Analyze (Elab_Body);
Set_Has_Nested_Subprogram (Elab_Proc); Set_Has_Nested_Subprogram (Block_Elab_Proc);
Set_Handled_Statement_Sequence (N, Set_Handled_Statement_Sequence (N,
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
...@@ -4202,85 +4205,81 @@ package body Exp_Ch7 is ...@@ -4202,85 +4205,81 @@ package body Exp_Ch7 is
Analyze (Elab_Call); Analyze (Elab_Call);
-- The scope of all blocks and loops in the elaboration code is -- Could we reset the scopes of entities associated with the new
-- now the constructed elaboration procedure. Nested subprograms -- procedure here via a loop over entities rather than doing it in
-- within those blocks will have activation records if they -- the recursive Reset_Scopes_To_Elab_Proc procedure???
-- contain references to entities in the enclosing block or
-- the package itself.
Ent := First_Ent;
while Present (Ent) loop
Set_Scope (Ent, Elab_Proc);
Next_Entity (Ent);
end loop;
if Present (Loop_Id) then
Set_Scope (Loop_Id, Elab_Proc);
end if;
end if; end if;
end if; end if;
end Check_Unnesting_Elaboration_Code; end Check_Unnesting_Elaboration_Code;
------------------------------------- ---------------------------------------
-- Check_Unnesting_In_Declarations -- -- Check_Unnesting_In_Decls_Or_Stmts --
------------------------------------- ---------------------------------------
procedure Check_Unnesting_In_Declarations (Decls : List_Id) is procedure Check_Unnesting_In_Decls_Or_Stmts (Decls_Or_Stmts : List_Id) is
Decl : Node_Id; Decl_Or_Stmt : Node_Id;
Ent : Entity_Id;
Loc : Source_Ptr;
Local_Body : Node_Id;
Local_Call : Node_Id;
Local_Proc : Entity_Id;
begin begin
Local_Call := Empty;
if Unnest_Subprogram_Mode if Unnest_Subprogram_Mode
and then Present (Decls) and then Present (Decls_Or_Stmts)
and then Is_Compilation_Unit (Current_Scope)
then then
Decl := First (Decls); Decl_Or_Stmt := First (Decls_Or_Stmts);
while Present (Decl) loop while Present (Decl_Or_Stmt) loop
if Nkind (Decl) = N_Block_Statement if Nkind (Decl_Or_Stmt) = N_Block_Statement
and then Contains_Subprogram (Entity (Identifier (Decl))) and then Contains_Subprogram (Entity (Identifier (Decl_Or_Stmt)))
then then
Ent := First_Entity (Entity (Identifier (Decl))); Unnest_Block (Decl_Or_Stmt);
Loc := Sloc (Decl);
Local_Proc :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('P'));
Local_Body := elsif Nkind (Decl_Or_Stmt) = N_Package_Declaration
Make_Subprogram_Body (Loc, and then not Modify_Tree_For_C
Specification => then
Make_Procedure_Specification (Loc, Check_Unnesting_In_Decls_Or_Stmts
Defining_Unit_Name => Local_Proc), (Visible_Declarations (Specification (Decl_Or_Stmt)));
Declarations => Declarations (Decl), Check_Unnesting_In_Decls_Or_Stmts
Handled_Statement_Sequence => (Private_Declarations (Specification (Decl_Or_Stmt)));
Handled_Statement_Sequence (Decl));
Rewrite (Decl, Local_Body); elsif Nkind (Decl_Or_Stmt) = N_Package_Body
Analyze (Decl); and then not Modify_Tree_For_C
Set_Has_Nested_Subprogram (Local_Proc); then
Check_Unnesting_In_Decls_Or_Stmts (Declarations (Decl_Or_Stmt));
if Present (Statements
(Handled_Statement_Sequence (Decl_Or_Stmt)))
then
Check_Unnesting_In_Decls_Or_Stmts (Statements
(Handled_Statement_Sequence (Decl_Or_Stmt)));
Check_Unnesting_In_Handlers (Decl_Or_Stmt);
end if;
end if;
Local_Call := Next (Decl_Or_Stmt);
Make_Procedure_Call_Statement (Loc, end loop;
Name => New_Occurrence_Of (Local_Proc, Loc)); end if;
end Check_Unnesting_In_Decls_Or_Stmts;
Insert_After (Decl, Local_Call); ---------------------------------
Analyze (Local_Call); -- Check_Unnesting_In_Handlers --
---------------------------------
while Present (Ent) loop procedure Check_Unnesting_In_Handlers (N : Node_Id) is
Set_Scope (Ent, Local_Proc); Stmt_Seq : constant Node_Id := Handled_Statement_Sequence (N);
Next_Entity (Ent);
end loop; begin
if Present (Stmt_Seq)
and then Present (Exception_Handlers (Stmt_Seq))
then
declare
Handler : Node_Id := First (Exception_Handlers (Stmt_Seq));
begin
while Present (Handler) loop
if Present (Statements (Handler)) then
Check_Unnesting_In_Decls_Or_Stmts (Statements (Handler));
end if; end if;
Next (Decl); Next (Handler);
end loop; end loop;
end;
end if; end if;
end Check_Unnesting_In_Declarations; end Check_Unnesting_In_Handlers;
------------------------------ ------------------------------
-- Check_Visibly_Controlled -- -- Check_Visibly_Controlled --
...@@ -5036,8 +5035,20 @@ package body Exp_Ch7 is ...@@ -5036,8 +5035,20 @@ package body Exp_Ch7 is
-- end of the body statements. -- end of the body statements.
Expand_Pragma_Initial_Condition (Spec_Id, N); Expand_Pragma_Initial_Condition (Spec_Id, N);
-- If this is a library-level package and unnesting is enabled,
-- check for the presence of blocks with nested subprograms occurring
-- in elaboration code, and generate procedures to encapsulate the
-- blocks in case the nested subprograms make up-level references.
if Unnest_Subprogram_Mode
and then
Is_Library_Level_Entity (Current_Scope)
then
Check_Unnesting_Elaboration_Code (N); Check_Unnesting_Elaboration_Code (N);
Check_Unnesting_In_Declarations (Declarations (N)); Check_Unnesting_In_Decls_Or_Stmts (Declarations (N));
Check_Unnesting_In_Handlers (N);
end if;
Pop_Scope; Pop_Scope;
end if; end if;
...@@ -5196,8 +5207,17 @@ package body Exp_Ch7 is ...@@ -5196,8 +5207,17 @@ package body Exp_Ch7 is
Set_Finalizer (Id, Fin_Id); Set_Finalizer (Id, Fin_Id);
end if; end if;
Check_Unnesting_In_Declarations (Visible_Declarations (Spec)); -- If this is a library-level package and unnesting is enabled,
Check_Unnesting_In_Declarations (Private_Declarations (Spec)); -- check for the presence of blocks with nested subprograms occurring
-- in elaboration code, and generate procedures to encapsulate the
-- blocks in case the nested subprograms make up-level references.
if Unnest_Subprogram_Mode
and then Is_Library_Level_Entity (Current_Scope)
then
Check_Unnesting_In_Decls_Or_Stmts (Visible_Declarations (Spec));
Check_Unnesting_In_Decls_Or_Stmts (Private_Declarations (Spec));
end if;
end Expand_N_Package_Declaration; end Expand_N_Package_Declaration;
---------------------------- ----------------------------
...@@ -9180,6 +9200,62 @@ package body Exp_Ch7 is ...@@ -9180,6 +9200,62 @@ package body Exp_Ch7 is
Store_Actions_In_Scope (Cleanup, L); Store_Actions_In_Scope (Cleanup, L);
end Store_Cleanup_Actions_In_Scope; end Store_Cleanup_Actions_In_Scope;
------------------
-- Unnest_Block --
------------------
procedure Unnest_Block (Decl : Node_Id) is
Loc : constant Source_Ptr := Sloc (Decl);
Ent : Entity_Id;
Local_Body : Node_Id;
Local_Call : Node_Id;
Local_Proc : Entity_Id;
Local_Scop : Entity_Id;
begin
Local_Scop := Entity (Identifier (Decl));
Ent := First_Entity (Local_Scop);
Local_Proc :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('P'));
Local_Body :=
Make_Subprogram_Body (Loc,
Specification =>
Make_Procedure_Specification (Loc,
Defining_Unit_Name => Local_Proc),
Declarations => Declarations (Decl),
Handled_Statement_Sequence =>
Handled_Statement_Sequence (Decl));
Rewrite (Decl, Local_Body);
Analyze (Decl);
Set_Has_Nested_Subprogram (Local_Proc);
Local_Call :=
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Local_Proc, Loc));
Insert_After (Decl, Local_Call);
Analyze (Local_Call);
-- The new subprogram has the same scope as the original block
Set_Scope (Local_Proc, Scope (Local_Scop));
-- And the entity list of the new procedure is that of the block
Set_First_Entity (Local_Proc, Ent);
-- Reset the scopes of all the entities to the new procedure
while Present (Ent) loop
Set_Scope (Ent, Local_Proc);
Next_Entity (Ent);
end loop;
end Unnest_Block;
-------------------------------- --------------------------------
-- Wrap_Transient_Declaration -- -- Wrap_Transient_Declaration --
-------------------------------- --------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment