From f68289d82e55ad4239beea8a8fbb32981f814de0 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Thu, 10 Oct 2019 15:23:24 +0000 Subject: [PATCH] [Ada] Generation of procedures for blocks occurring in elaboration code for LLVM 2019-10-10 Gary Dismukes 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 --- gcc/ada/ChangeLog | 50 ++++-- gcc/ada/exp_ch7.adb | 380 ++++++++++++++++++++++++++------------------ 2 files changed, 269 insertions(+), 161 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 029925a566a..866de1f3516 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,10 +1,42 @@ -2019-10-10 Anthony Leonardo Gracio +2019-10-10 Gary Dismukes - * doc/gnat_ugn/about_this_guide.rst, - doc/gnat_ugn/building_executable_programs_with_gnat.rst, - doc/gnat_ugn/getting_started_with_gnat.rst, - doc/gnat_ugn/gnat_and_program_execution.rst, errout.ads, - exp_ch3.adb, gnatls.adb, impunit.adb, lib-writ.ads, opt.ads, - sem_ch7.adb, sem_prag.adb, sem_res.adb, sem_warn.adb, - terminals.c: Replace GPS by GNAT Studio. - * gnat_ugn.texi: Regenerate. \ No newline at end of file + * 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. \ No newline at end of file diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index b00fc9291d0..f1b72798be0 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -364,20 +364,39 @@ package body Exp_Ch7 is procedure Check_Unnesting_Elaboration_Code (N : Node_Id); -- 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) -- elaboration procedure that executes that statement part. To handle -- properly uplevel references we construct that subprogram explicitly, -- to contain blocks and inner subprograms, The statement part becomes -- a call to this subprogram. This is only done if blocks are present - -- in the statement list of the body. - - procedure Check_Unnesting_In_Declarations (Decls : List_Id); - -- Similarly, the declarations in the package body may have created - -- blocks with nested subprograms. Such a block must be transformed into a - -- procedure followed by a call to it, so that unnesting can handle uplevel - -- references within these nested subprograms (typically generated - -- subprograms to handle finalization actions). + -- 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 + -- they're doing very similar work, but are structured differently. ???) + + procedure Check_Unnesting_In_Decls_Or_Stmts (Decls_Or_Stmts : List_Id); + -- Similarly, the declarations or statements in library-level packages may + -- have created blocks blocks with nested subprograms. Such a block must be + -- 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 (Prim : Final_Primitives; @@ -4020,27 +4039,39 @@ package body Exp_Ch7 is -------------------------------------- procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - First_Ent : Entity_Id := Empty; - Loop_Id : Entity_Id := Empty; - - function First_Local_Scope (L : List_Id) return Entity_Id; - -- Find first entity in the elaboration code of the body that contains - -- or represents 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 encountered - -- is used to reset the scopes of all entities that become local to the - -- new elaboration procedure. This is needed for subsequent unnesting, - -- which depends on the scope links to determine the nesting level of - -- each subprogram. + Loc : constant Source_Ptr := Sloc (N); + Block_Elab_Proc : Entity_Id := Empty; + + procedure Set_Block_Elab_Proc; + -- Create a defining identifier for a procedure that will replace + -- a block with nested subprograms (unless it has already been created, + -- in which case this is a no-op). + + procedure Set_Block_Elab_Proc is + begin + if No (Block_Elab_Proc) then + Block_Elab_Proc := + 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 -- ----------------------- - 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; - Scop : Entity_Id; Stat : Node_Id; begin @@ -4050,41 +4081,36 @@ package body Exp_Ch7 is when N_Block_Statement => Id := Entity (Identifier (Stat)); - if No (First_Ent) then - First_Ent := Id; - end if; + -- The Scope of this block needs to be reset to the new + -- procedure if the block contains nested subprograms. if Present (Id) and then Contains_Subprogram (Id) then - return Id; + Set_Block_Elab_Proc; + Set_Scope (Id, Block_Elab_Proc); end if; when N_Loop_Statement => Id := Entity (Identifier (Stat)); - if No (First_Ent) then - First_Ent := Id; - end if; - - if Contains_Subprogram (Id) then + if Present (Id) and then Contains_Subprogram (Id) then if Scope (Id) = Current_Scope then - Loop_Id := Id; + Set_Block_Elab_Proc; + Set_Scope (Id, Block_Elab_Proc); end if; - - return Id; end if; - when N_If_Statement => - Scop := First_Local_Scope (Then_Statements (Stat)); + -- We traverse the loop's statements as well, which may + -- 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 - return Scop; - end if; + Reset_Scopes_To_Block_Elab_Proc (Statements (Stat)); - Scop := First_Local_Scope (Else_Statements (Stat)); + when N_If_Statement => + Reset_Scopes_To_Block_Elab_Proc (Then_Statements (Stat)); - if Present (Scop) then - return Scop; - end if; + Reset_Scopes_To_Block_Elab_Proc (Else_Statements (Stat)); declare Elif : Node_Id; @@ -4092,11 +4118,8 @@ package body Exp_Ch7 is begin Elif := First (Elsif_Parts (Stat)); while Present (Elif) loop - Scop := First_Local_Scope (Statements (Elif)); - - if Present (Scop) then - return Scop; - end if; + Reset_Scopes_To_Block_Elab_Proc + (Then_Statements (Elif)); Next (Elif); end loop; @@ -4109,24 +4132,19 @@ package body Exp_Ch7 is begin Alt := First (Alternatives (Stat)); while Present (Alt) loop - Scop := First_Local_Scope (Statements (Alt)); - - if Present (Scop) then - return Scop; - end if; + Reset_Scopes_To_Block_Elab_Proc (Statements (Alt)); Next (Alt); end loop; end; + -- Reset the Scope of a subprogram occurring at the top level + when N_Subprogram_Body => Id := Defining_Entity (Stat); - if No (First_Ent) then - First_Ent := Id; - end if; - - return Id; + Set_Block_Elab_Proc; + Set_Scope (Id, Block_Elab_Proc); when others => null; @@ -4134,67 +4152,52 @@ package body Exp_Ch7 is Next (Stat); end loop; - - return Empty; - end First_Local_Scope; + end Reset_Scopes_To_Block_Elab_Proc; -- Local variables H_Seq : constant Node_Id := Handled_Statement_Sequence (N); Elab_Body : Node_Id; Elab_Call : Node_Id; - Elab_Proc : Entity_Id; - Ent : Entity_Id; -- Start of processing for Check_Unnesting_Elaboration_Code begin - if Unnest_Subprogram_Mode - and then Present (H_Seq) - and then Is_Compilation_Unit (Current_Scope) - then - Ent := First_Local_Scope (Statements (H_Seq)); + if Present (H_Seq) then + Reset_Scopes_To_Block_Elab_Proc (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. - if No (Ent) and then Present (Exception_Handlers (H_Seq)) then + if Present (Exception_Handlers (H_Seq)) then declare Handler : Node_Id := First (Exception_Handlers (H_Seq)); begin while Present (Handler) loop - Ent := First_Local_Scope (Statements (Handler)); - if Present (Ent) then - First_Ent := Ent; - exit; - end if; + Reset_Scopes_To_Block_Elab_Proc (Statements (Handler)); Next (Handler); end loop; end; end if; - if Present (Ent) then - Elab_Proc := - Make_Defining_Identifier (Loc, - Chars => New_Internal_Name ('I')); - + if Present (Block_Elab_Proc) then Elab_Body := Make_Subprogram_Body (Loc, Specification => Make_Procedure_Specification (Loc, - Defining_Unit_Name => Elab_Proc), + Defining_Unit_Name => Block_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)); + Name => New_Occurrence_Of (Block_Elab_Proc, Loc)); Append_To (Declarations (N), Elab_Body); Analyze (Elab_Body); - Set_Has_Nested_Subprogram (Elab_Proc); + Set_Has_Nested_Subprogram (Block_Elab_Proc); Set_Handled_Statement_Sequence (N, Make_Handled_Sequence_Of_Statements (Loc, @@ -4202,85 +4205,81 @@ package body Exp_Ch7 is Analyze (Elab_Call); - -- The scope of all blocks and loops 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 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; + -- Could we reset the scopes of entities associated with the new + -- procedure here via a loop over entities rather than doing it in + -- the recursive Reset_Scopes_To_Elab_Proc procedure??? end if; end if; end Check_Unnesting_Elaboration_Code; - ------------------------------------- - -- Check_Unnesting_In_Declarations -- - ------------------------------------- + --------------------------------------- + -- Check_Unnesting_In_Decls_Or_Stmts -- + --------------------------------------- - procedure Check_Unnesting_In_Declarations (Decls : List_Id) is - Decl : Node_Id; - Ent : Entity_Id; - Loc : Source_Ptr; - Local_Body : Node_Id; - Local_Call : Node_Id; - Local_Proc : Entity_Id; + procedure Check_Unnesting_In_Decls_Or_Stmts (Decls_Or_Stmts : List_Id) is + Decl_Or_Stmt : Node_Id; begin - Local_Call := Empty; - if Unnest_Subprogram_Mode - and then Present (Decls) - and then Is_Compilation_Unit (Current_Scope) + and then Present (Decls_Or_Stmts) then - Decl := First (Decls); - while Present (Decl) loop - if Nkind (Decl) = N_Block_Statement - and then Contains_Subprogram (Entity (Identifier (Decl))) + Decl_Or_Stmt := First (Decls_Or_Stmts); + while Present (Decl_Or_Stmt) loop + if Nkind (Decl_Or_Stmt) = N_Block_Statement + and then Contains_Subprogram (Entity (Identifier (Decl_Or_Stmt))) then - Ent := First_Entity (Entity (Identifier (Decl))); - Loc := Sloc (Decl); - 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)); + Unnest_Block (Decl_Or_Stmt); - Insert_After (Decl, Local_Call); - Analyze (Local_Call); + elsif Nkind (Decl_Or_Stmt) = N_Package_Declaration + and then not Modify_Tree_For_C + then + Check_Unnesting_In_Decls_Or_Stmts + (Visible_Declarations (Specification (Decl_Or_Stmt))); + Check_Unnesting_In_Decls_Or_Stmts + (Private_Declarations (Specification (Decl_Or_Stmt))); - while Present (Ent) loop - Set_Scope (Ent, Local_Proc); - Next_Entity (Ent); - end loop; + elsif Nkind (Decl_Or_Stmt) = N_Package_Body + and then not Modify_Tree_For_C + 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; - Next (Decl); + Next (Decl_Or_Stmt); end loop; end if; - end Check_Unnesting_In_Declarations; + end Check_Unnesting_In_Decls_Or_Stmts; + + --------------------------------- + -- Check_Unnesting_In_Handlers -- + --------------------------------- + + procedure Check_Unnesting_In_Handlers (N : Node_Id) is + Stmt_Seq : constant Node_Id := Handled_Statement_Sequence (N); + + 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; + + Next (Handler); + end loop; + end; + end if; + end Check_Unnesting_In_Handlers; ------------------------------ -- Check_Visibly_Controlled -- @@ -5036,8 +5035,20 @@ package body Exp_Ch7 is -- end of the body statements. Expand_Pragma_Initial_Condition (Spec_Id, N); - Check_Unnesting_Elaboration_Code (N); - Check_Unnesting_In_Declarations (Declarations (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_In_Decls_Or_Stmts (Declarations (N)); + Check_Unnesting_In_Handlers (N); + end if; Pop_Scope; end if; @@ -5196,8 +5207,17 @@ package body Exp_Ch7 is Set_Finalizer (Id, Fin_Id); end if; - Check_Unnesting_In_Declarations (Visible_Declarations (Spec)); - Check_Unnesting_In_Declarations (Private_Declarations (Spec)); + -- 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_In_Decls_Or_Stmts (Visible_Declarations (Spec)); + Check_Unnesting_In_Decls_Or_Stmts (Private_Declarations (Spec)); + end if; end Expand_N_Package_Declaration; ---------------------------- @@ -9180,6 +9200,62 @@ package body Exp_Ch7 is Store_Actions_In_Scope (Cleanup, L); 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 -- -------------------------------- -- 2.30.2