From ccc2a6139062395fb5747d0846a1ed6de25293c2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 16 Jul 2018 14:11:52 +0000 Subject: [PATCH] [Ada] Major code cleanup 2018-07-16 Ed Schonberg gcc/ada/ * einfo.adb (Set_Is_Uplevel_Referenced_Entity): Flag can appear on loop parameters. * exp_ch7.adb (Check_Unnesting_Elaboration_Code): Handle subprogram bodies. * exp_ch9.adb (Reset_Scopes_To): Set the scopes of entities local to an entry body to be the corresponding generated subprogram, for correct analysis of uplevel references. * exp_unst.adb (Visit_Node): Handle properly binary and unary operators Ignore pragmas, fix component associations. (Register_Subprograms): Subprograms in synchronized types must be treated as reachable. From-SVN: r262723 --- gcc/ada/ChangeLog | 14 +++++++ gcc/ada/einfo.adb | 2 +- gcc/ada/exp_ch7.adb | 3 ++ gcc/ada/exp_ch9.adb | 74 ++++++++++++++++++++++++++++++++++- gcc/ada/exp_unst.adb | 107 ++++++++++++++++++++++++++++++++++++++++++++------- 5 files changed, 184 insertions(+), 16 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9644f6f..8a0250d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2018-07-16 Ed Schonberg + + * einfo.adb (Set_Is_Uplevel_Referenced_Entity): Flag can appear on + loop parameters. + * exp_ch7.adb (Check_Unnesting_Elaboration_Code): Handle subprogram + bodies. + * exp_ch9.adb (Reset_Scopes_To): Set the scopes of entities local to an + entry body to be the corresponding generated subprogram, for correct + analysis of uplevel references. + * exp_unst.adb (Visit_Node): Handle properly binary and unary operators + Ignore pragmas, fix component associations. + (Register_Subprograms): Subprograms in synchronized types must be + treated as reachable. + 2018-07-16 Hristian Kirtchev * sem_util.adb (Check_No_Hidden_State): Ignore internally-generated diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index c41dc30..f7742ec 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -5972,7 +5972,7 @@ package body Einfo is procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is begin pragma Assert - (Ekind_In (Id, E_Constant, E_Variable, E_Discriminant) + (Ekind_In (Id, E_Constant, E_Variable, E_Loop_Parameter) or else Is_Formal (Id) or else Is_Type (Id)); Set_Flag283 (Id, V); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 663d974..d14cd7e 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4048,6 +4048,9 @@ package body Exp_Ch7 is and then Present (Identifier (Stat)) then Set_Scope (Entity (Identifier (Stat)), Elab_Proc); + + elsif Nkind (Stat) = N_Subprogram_Body then + Set_Scope (Defining_Entity (Stat), Elab_Proc); end if; Next (Stat); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index ea03fe2..7d1ba35 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -474,6 +474,11 @@ package body Exp_Ch9 is -- ... -- := P.; + procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id); + -- Reset the scope of declarations and blocks at the top level of + -- Proc_Body to be E. Used after expanding entry bodies into their + -- corresponding procedures. + function Trivial_Accept_OK return Boolean; -- If there is no DO-END block for an accept, or if the DO-END block has -- only null statements, then it is possible to do the Rendezvous with much @@ -3558,6 +3563,7 @@ package body Exp_Ch9 is Bod_Stmts : List_Id; Complete : Node_Id; Ohandle : Node_Id; + Proc_Body : Node_Id; EH_Loc : Source_Ptr; -- Used for the exception handler, inserted at end of the body @@ -3670,7 +3676,7 @@ package body Exp_Ch9 is -- Create body of entry procedure. The renaming declarations are -- placed ahead of the block that contains the actual entry body. - return + Proc_Body := Make_Subprogram_Body (Loc, Specification => Bod_Spec, Declarations => Bod_Decls, @@ -3699,6 +3705,9 @@ package body Exp_Ch9 is Name => New_Occurrence_Of (RTE (RE_Get_GNAT_Exception), Loc))))))))); + + Reset_Scopes_To (Proc_Body, Bod_Id); + return Proc_Body; end if; end Build_Protected_Entry; @@ -10554,6 +10563,8 @@ package body Exp_Ch9 is Expr : Node_Id; Call : Node_Id; + -- Start of processing for Add_Accept + begin if No (Ann) then Ann := Node (Last_Elmt (Accept_Address (Eent))); @@ -10592,7 +10603,7 @@ package body Exp_Ch9 is Make_Defining_Identifier (Eloc, New_External_Name (Chars (Ename), 'A', Num_Accept)); - -- Link the acceptor to the original receiving entry + -- Link the acceptor to the original receiving entry. Set_Ekind (PB_Ent, E_Procedure); Set_Receiving_Entry (PB_Ent, Eent); @@ -10610,6 +10621,8 @@ package body Exp_Ch9 is Handled_Statement_Sequence => Build_Accept_Body (Accept_Statement (Alt))); + Reset_Scopes_To (Proc_Body, PB_Ent); + -- During the analysis of the body of the accept statement, any -- zero cost exception handler records were collected in the -- Accept_Handler_Records field of the N_Accept_Alternative node. @@ -14713,6 +14726,63 @@ package body Exp_Ch9 is end if; end Parameter_Block_Unpack; + --------------------- + -- Reset_Scopes_To -- + --------------------- + + procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id) is + + function Reset_Scope (N : Node_Id) return Traverse_Result; + -- Temporaries may have been declared during expansion of the + -- procedure alternative. Indicate that their scope is the new + -- body, to prevent generation of spurious uplevel references + -- for these entities. + + procedure Reset_Scopes is new Traverse_Proc (Reset_Scope); + + ----------------- + -- Reset_Scope -- + ----------------- + + function Reset_Scope (N : Node_Id) return Traverse_Result is + Decl : Node_Id; + + begin + -- If this is a block statement with an Identifier, it forms + -- a scope, so we want to reset its scope but not look inside. + + if Nkind (N) = N_Block_Statement and then Present (Identifier (N)) + then + Set_Scope (Entity (Identifier (N)), E); + return Skip; + + elsif Nkind (N) = N_Package_Declaration then + Set_Scope (Defining_Entity (N), E); + return Skip; + + elsif N = Proc_Body then + + -- Scan declarations + + Decl := First (Declarations (N)); + while Present (Decl) loop + Reset_Scopes (Decl); + Next (Decl); + end loop; + + elsif N /= Proc_Body and then Nkind (N) in N_Proper_Body then + return Skip; + elsif Nkind (N) = N_Defining_Identifier then + Set_Scope (N, E); + end if; + + return OK; + end Reset_Scope; + + begin + Reset_Scopes (Proc_Body); + end Reset_Scopes_To; + ---------------------- -- Set_Discriminals -- ---------------------- diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 1ac9636..9a2a482 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -526,6 +526,23 @@ package body Exp_Unst is end loop; end; + -- Binary operator cases. These can apply + -- to arrays for which we may need bounds. + + elsif Nkind (N) in N_Binary_Op then + Note_Uplevel_Bound (Left_Opnd (N), Ref); + Note_Uplevel_Bound (Right_Opnd (N), Ref); + + -- Unary operator case + + elsif Nkind (N) in N_Unary_Op then + Note_Uplevel_Bound (Right_Opnd (N), Ref); + + -- Explicit dereference case + + elsif Nkind (N) = N_Explicit_Dereference then + Note_Uplevel_Bound (Prefix (N), Ref); + -- Conversion case elsif Nkind (N) = N_Type_Conversion then @@ -694,12 +711,16 @@ package body Exp_Unst is procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is L : constant Nat := Get_Level (Subp, E); + -- Subprograms declared in tasks and protected types cannot + -- be eliminated because calls to them may be in other units, + -- so they must be treated as reachable. + begin Subps.Append ((Ent => E, Bod => Bod, Lev => L, - Reachable => False, + Reachable => In_Synchronized_Unit (E), Uplevel_Ref => L, Declares_AREC => False, Uents => No_Elist, @@ -890,7 +911,9 @@ package body Exp_Unst is -- no relevant code generation. when N_Component_Association => - if No (Etype (Expression (N))) then + if No (Expression (N)) + or else No (Etype (Expression (N))) + then return Skip; end if; @@ -932,6 +955,29 @@ package body Exp_Unst is end; end if; + -- For EQ/NE comparisons, we need the type of the operands + -- in order to do the comparison, which means we need the + -- bounds. + + when N_Op_Eq | N_Op_Ne => + declare + DT : Boolean := False; + begin + Check_Static_Type (Etype (Left_Opnd (N)), Empty, DT); + Check_Static_Type (Etype (Right_Opnd (N)), Empty, DT); + end; + + -- Likewise we need the sizes to compute how much to move in + -- an assignment. + + when N_Assignment_Statement => + declare + DT : Boolean := False; + begin + Check_Static_Type (Etype (Name (N)), Empty, DT); + Check_Static_Type (Etype (Expression (N)), Empty, DT); + end; + -- Record a subprogram. We record a subprogram body that acts -- as a spec. Otherwise we record a subprogram declaration, -- providing that it has a corresponding body we can get hold @@ -1013,6 +1059,11 @@ package body Exp_Unst is return Skip; end if; + -- Pragmas and component declarations can be ignored. + + when N_Pragma | N_Component_Declaration => + return Skip; + -- Otherwise record an uplevel reference in a local -- identifier. @@ -1036,7 +1087,8 @@ package body Exp_Unst is -- references to global declarations. and then - (Ekind_In (Ent, E_Constant, E_Variable) + (Ekind_In + (Ent, E_Constant, E_Variable, E_Loop_Parameter) -- Formals are interesting, but not if being used as -- mere names of parameters for name notation calls. @@ -1222,7 +1274,26 @@ package body Exp_Unst is -- mark as requiring activation records. exit when No (S); - Subps.Table (Subp_Index (S)).Declares_AREC := True; + + declare + SUBI : Subp_Entry renames Subps.Table (Subp_Index (S)); + begin + SUBI.Declares_AREC := True; + + -- If this entity was marked reachable because it is + -- in a task or protected type, there may not appear + -- to be any calls to it, which would normally + -- adjust the levels of the parent subprograms. + -- So we need to be sure that the uplevel reference + -- of that entity takes into account possible calls. + + if In_Synchronized_Unit (SUBF.Ent) + and then SUBT.Lev < SUBI.Uplevel_Ref + then + SUBI.Uplevel_Ref := SUBT.Lev; + end if; + end; + exit when S = URJ.Callee; end loop; @@ -1272,13 +1343,6 @@ package body Exp_Unst is Decl : Node_Id; begin - -- Subprograms declared in tasks and protected types are - -- reachable and cannot be eliminated. - - if In_Synchronized_Unit (STJ.Ent) then - STJ.Reachable := True; - end if; - -- Subprogram is reachable, copy and reset index if STJ.Reachable then @@ -1796,7 +1860,8 @@ package body Exp_Unst is -- right after the declaration of ARECnP. -- For all other entities, we insert -- the assignment immediately after the - -- declaration of the entity. + -- declaration of the entity or after + -- the freeze node if present. -- Note: we don't need to mark the entity -- as being aliased, because the address @@ -1805,6 +1870,10 @@ package body Exp_Unst is if Is_Formal (Ent) then Ins := Decl_ARECnP; + + elsif Has_Delayed_Freeze (Ent) then + Ins := Freeze_Node (Ent); + else Ins := Dec; end if; @@ -1837,7 +1906,19 @@ package body Exp_Unst is New_Occurrence_Of (Ent, Loc), Attribute_Name => Attr)); - Insert_After (Ins, Asn); + -- If we have a loop parameter, we have + -- to insert before the first statement + -- of the loop. Ins points to the + -- N_Loop_Parametrer_Specification. + + if Ekind (Ent) = E_Loop_Parameter then + Ins := First (Statements + (Parent (Parent (Ins)))); + Insert_Before (Ins, Asn); + + else + Insert_After (Ins, Asn); + end if; -- Analyze the assignment statement. We do -- not need to establish the relevant scope -- 2.7.4