From 8e8889204245049467914f72b9ff664f31e56e24 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 30 Jul 2014 16:57:28 +0200 Subject: [PATCH] [multiple changes] 2014-07-30 Hristian Kirtchev * checks.adb (Make_Bignum_Block): Use the new secondary stack build routines to manage the mark. * exp_ch7.adb (Create_Finalizer, Expand_Cleanup_Actions): Use the new secodary stack build routines to manage the mark. (Insert_Actions_In_Scope_Around): Add new formal parameter Manage_SS along with comment on its usage. Code and comment reformatting. Mark and release the secondary stack when the context warrants it. (Make_Transient_Block): Update the call to Insert_Actions_In_Scope_Around to account for parameter Manage_SS. (Wrap_Transient_Declaration): Remove local variable Uses_SS. Ensure that the secondary stack is marked and released when the related object declaration appears in a library level package or package body. Code and comment reformatting. * exp_util.ads, exp_util.adb (Build_SS_Mark_Call): New routine. (Build_SS_Release_Call): New routine. 2014-07-30 Steve Baird * exp_attr.adb: Revert previous change, not needed after all. 2014-07-30 Vincent Celier * makeutl.adb (Queue.Insert_Project_Sources): Insert with Closure => True for interfaces of Stand-Alone Libraries. * makeutl.ads (Source_Info (Format => Gprbuild)): Add new Boolean component Closure, defaulted to False. 2014-07-30 Yannick Moy * sem_res.adb: Fix typo in error message. From-SVN: r213291 --- gcc/ada/ChangeLog | 34 +++++++ gcc/ada/checks.adb | 16 +--- gcc/ada/exp_attr.adb | 12 +-- gcc/ada/exp_ch7.adb | 222 ++++++++++++++++++++++++------------------- gcc/ada/exp_util.adb | 43 +++++++++ gcc/ada/exp_util.ads | 12 +++ gcc/ada/makeutl.adb | 70 +++++++++++--- gcc/ada/makeutl.ads | 8 +- gcc/ada/sem_res.adb | 2 +- 9 files changed, 281 insertions(+), 138 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c240e201e67..8d00c1b6676 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2014-07-30 Hristian Kirtchev + + * checks.adb (Make_Bignum_Block): Use the new secondary stack + build routines to manage the mark. + * exp_ch7.adb (Create_Finalizer, Expand_Cleanup_Actions): + Use the new secodary stack build routines to manage the mark. + (Insert_Actions_In_Scope_Around): Add new formal parameter + Manage_SS along with comment on its usage. Code and comment + reformatting. Mark and release the secondary stack when the + context warrants it. + (Make_Transient_Block): Update the call + to Insert_Actions_In_Scope_Around to account for parameter Manage_SS. + (Wrap_Transient_Declaration): Remove local variable + Uses_SS. Ensure that the secondary stack is marked and released + when the related object declaration appears in a library level + package or package body. Code and comment reformatting. + * exp_util.ads, exp_util.adb (Build_SS_Mark_Call): New routine. + (Build_SS_Release_Call): New routine. + +2014-07-30 Steve Baird + + * exp_attr.adb: Revert previous change, not needed after all. + +2014-07-30 Vincent Celier + + * makeutl.adb (Queue.Insert_Project_Sources): Insert with + Closure => True for interfaces of Stand-Alone Libraries. + * makeutl.ads (Source_Info (Format => Gprbuild)): Add new + Boolean component Closure, defaulted to False. + +2014-07-30 Yannick Moy + + * sem_res.adb: Fix typo in error message. + 2014-07-30 Robert Dewar * sem_ch3.adb (Process_Range_Expr_In_Decl): Use _FIRST/_LAST diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index c117319dbff..aea726c5f71 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -7477,22 +7477,12 @@ package body Checks is begin return Make_Block_Statement (Loc, - Declarations => New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => M, - Object_Definition => - New_Occurrence_Of (RTE (RE_Mark_Id), Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc)))), + Declarations => + New_List (Build_SS_Mark_Call (Loc, M)), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_SS_Release), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (M, Loc)))))); + Statements => New_List (Build_SS_Release_Call (Loc, M)))); end Make_Bignum_Block; ---------------------------------- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b121fce43a0..43051fae1a6 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2884,11 +2884,9 @@ package body Exp_Attr is -- For scalar type, if low bound is a reference to an entity, just -- replace with a direct reference. Note that we can only have a -- reference to a constant entity at this stage, anything else would - -- have already been rewritten. We do not do this rewriting if we - -- are in CodePeer mode, since CodePeer prefers to see the explicit - -- First attribute reference. + -- have already been rewritten. - elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then + elsif Is_Scalar_Type (Ptyp) then declare Lo : constant Node_Id := Type_Low_Bound (Ptyp); begin @@ -3562,11 +3560,9 @@ package body Exp_Attr is -- For scalar type, if low bound is a reference to an entity, just -- replace with a direct reference. Note that we can only have a -- reference to a constant entity at this stage, anything else would - -- have already been rewritten. We do not do this rewriting if we - -- are in CodePeer mode, since CodePeer prefers to see the explicit - -- Last attribute reference. + -- have already been rewritten. - elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then + elsif Is_Scalar_Type (Ptyp) then declare Hi : constant Node_Id := Type_High_Bound (Ptyp); begin diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 24773471efa..687ac1fa55a 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -130,10 +130,14 @@ package body Exp_Ch7 is -- pointers of N until it find the appropriate node to wrap. If it returns -- Empty, it means that no transient scope is needed in this context. - procedure Insert_Actions_In_Scope_Around (N : Node_Id; Clean : Boolean); + procedure Insert_Actions_In_Scope_Around + (N : Node_Id; + Clean : Boolean; + Manage_SS : Boolean); -- Insert the before-actions kept in the scope stack before N, and the - -- after-actions after N, which must be a member of a list. If Clean is - -- True, also insert the cleanup actions. + -- after-actions after N, which must be a member of a list. If flag Clean + -- is set, insert any cleanup actions. If flag Manage_SS is set, insert + -- calls to mark and release the secondary stack. function Make_Transient_Block (Loc : Source_Ptr; @@ -1477,12 +1481,7 @@ package body Exp_Ch7 is -- Release the secondary stack mark if Present (Mark_Id) then - Append_To (Finalizer_Stmts, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_SS_Release), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Mark_Id, Loc)))); + Append_To (Finalizer_Stmts, Build_SS_Release_Call (Loc, Mark_Id)); end if; -- Protect the statements with abort defer/undefer. This is only when @@ -3963,15 +3962,7 @@ package body Exp_Ch7 is if Needs_Sec_Stack_Mark then Mark := Make_Temporary (Loc, 'M'); - Append_To (New_Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => Mark, - Object_Definition => - New_Occurrence_Of (RTE (RE_Mark_Id), Loc), - Expression => - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc)))); - + Append_To (New_Decls, Build_SS_Mark_Call (Loc, Mark)); Set_Uses_Sec_Stack (Scop, False); end if; @@ -4590,7 +4581,11 @@ package body Exp_Ch7 is -- Insert_Actions_In_Scope_Around -- ------------------------------------ - procedure Insert_Actions_In_Scope_Around (N : Node_Id; Clean : Boolean) is + procedure Insert_Actions_In_Scope_Around + (N : Node_Id; + Clean : Boolean; + Manage_SS : Boolean) + is Act_Before : constant List_Id := Scope_Stack.Table (Scope_Stack.Last).Actions_To_Be_Wrapped (Before); Act_After : constant List_Id := @@ -4952,6 +4947,15 @@ package body Exp_Ch7 is end if; end Process_Transient_Objects; + -- Local variables + + Loc : constant Source_Ptr := Sloc (N); + Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped; + First_Obj : Node_Id; + Last_Obj : Node_Id; + Mark_Id : Entity_Id; + Target : Node_Id; + -- Start of processing for Insert_Actions_In_Scope_Around begin @@ -4959,79 +4963,85 @@ package body Exp_Ch7 is return; end if; - declare - Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped; - First_Obj : Node_Id; - Last_Obj : Node_Id; - Target : Node_Id; + -- If the node to be wrapped is the trigger of an asynchronous select, + -- it is not part of a statement list. The actions must be inserted + -- before the select itself, which is part of some list of statements. + -- Note that the triggering alternative includes the triggering + -- statement and an optional statement list. If the node to be wrapped + -- is part of that list, the normal insertion applies. - begin - -- If the node to be wrapped is the trigger of an asynchronous - -- select, it is not part of a statement list. The actions must be - -- inserted before the select itself, which is part of some list of - -- statements. Note that the triggering alternative includes the - -- triggering statement and an optional statement list. If the node - -- to be wrapped is part of that list, the normal insertion applies. - - if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative - and then not Is_List_Member (Node_To_Wrap) - then - Target := Parent (Parent (Node_To_Wrap)); - else - Target := N; - end if; + if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative + and then not Is_List_Member (Node_To_Wrap) + then + Target := Parent (Parent (Node_To_Wrap)); + else + Target := N; + end if; - First_Obj := Target; - Last_Obj := Target; + First_Obj := Target; + Last_Obj := Target; - -- Add all actions associated with a transient scope into the main - -- tree. There are several scenarios here: + -- Add all actions associated with a transient scope into the main tree. + -- There are several scenarios here: - -- +--- Before ----+ +----- After ---+ - -- 1) First_Obj ....... Target ........ Last_Obj + -- +--- Before ----+ +----- After ---+ + -- 1) First_Obj ....... Target ........ Last_Obj - -- 2) First_Obj ....... Target + -- 2) First_Obj ....... Target - -- 3) Target ........ Last_Obj + -- 3) Target ........ Last_Obj - if Present (Act_Before) then + -- Flag declarations are inserted before the first object - -- Flag declarations are inserted before the first object + if Present (Act_Before) then + First_Obj := First (Act_Before); + Insert_List_Before (Target, Act_Before); + end if; - First_Obj := First (Act_Before); + -- Finalization calls are inserted after the last object - Insert_List_Before (Target, Act_Before); - end if; + if Present (Act_After) then + Last_Obj := Last (Act_After); + Insert_List_After (Target, Act_After); + end if; - if Present (Act_After) then + -- Mark and release the secondary stack when the context warrants it - -- Finalization calls are inserted after the last object + if Manage_SS then + Mark_Id := Make_Temporary (Loc, 'M'); - Last_Obj := Last (Act_After); + -- Generate: + -- Mnn : constant Mark_Id := SS_Mark; - Insert_List_After (Target, Act_After); - end if; + Insert_Before_And_Analyze + (First_Obj, Build_SS_Mark_Call (Loc, Mark_Id)); - -- Check for transient controlled objects associated with Target and - -- generate the appropriate finalization actions for them. + -- Generate: + -- SS_Release (Mnn); - Process_Transient_Objects - (First_Object => First_Obj, - Last_Object => Last_Obj, - Related_Node => Target); + Insert_After_And_Analyze + (Last_Obj, Build_SS_Release_Call (Loc, Mark_Id)); + end if; - -- Reset the action lists + -- Check for transient controlled objects associated with Target and + -- generate the appropriate finalization actions for them. - Scope_Stack.Table - (Scope_Stack.Last).Actions_To_Be_Wrapped (Before) := No_List; - Scope_Stack.Table - (Scope_Stack.Last).Actions_To_Be_Wrapped (After) := No_List; + Process_Transient_Objects + (First_Object => First_Obj, + Last_Object => Last_Obj, + Related_Node => Target); - if Clean then - Scope_Stack.Table - (Scope_Stack.Last).Actions_To_Be_Wrapped (Cleanup) := No_List; - end if; - end; + -- Reset the action lists + + Scope_Stack.Table + (Scope_Stack.Last).Actions_To_Be_Wrapped (Before) := No_List; + Scope_Stack.Table + (Scope_Stack.Last).Actions_To_Be_Wrapped (After) := No_List; + + if Clean then + Scope_Stack.Table + (Scope_Stack.Last).Actions_To_Be_Wrapped (Cleanup) := No_List; + end if; end Insert_Actions_In_Scope_Around; ------------------------------ @@ -8019,7 +8029,8 @@ package body Exp_Ch7 is -- nodes needed by those actions. Do not insert cleanup actions here, -- they will be transferred to the newly created block. - Insert_Actions_In_Scope_Around (Action, Clean => False); + Insert_Actions_In_Scope_Around + (Action, Clean => False, Manage_SS => False); Insert := Prev (Action); if Present (Insert) then @@ -8145,43 +8156,54 @@ package body Exp_Ch7 is -- [Deep_]Finalize (_v2); procedure Wrap_Transient_Declaration (N : Node_Id) is - Encl_S : Entity_Id; - S : Entity_Id; - Uses_SS : Boolean; + Curr_S : Entity_Id; + Encl_S : Entity_Id; begin - S := Current_Scope; - Encl_S := Scope (S); - - -- Insert Actions kept in the Scope stack. Since we are not generating - -- a block, we must also insert the cleanup actions in the tree now. - - Insert_Actions_In_Scope_Around (N, Clean => True); - - -- If the declaration is consuming some secondary stack, mark the - -- enclosing scope appropriately. - - Uses_SS := Uses_Sec_Stack (S); + Curr_S := Current_Scope; + Encl_S := Scope (Curr_S); + + -- Insert all actions inluding cleanup generated while analyzing or + -- expanding the transient context back into the tree. Manage the + -- secondary stack when the object declaration appears in a library + -- level package [body]. This is not needed for .NET/JVM as those do + -- not support the secondary stack. + + Insert_Actions_In_Scope_Around + (N => N, + Clean => True, + Manage_SS => + VM_Target = No_VM + and then Uses_Sec_Stack (Curr_S) + and then Nkind (N) = N_Object_Declaration + and then Ekind_In (Encl_S, E_Package, E_Package_Body) + and then Is_Library_Level_Entity (Encl_S)); Pop_Scope; - -- Put the local entities back in the enclosing scope, and set the - -- Is_Public flag appropriately. + -- Relocate local entities declared within the transient scope to the + -- enclosing scope. This action sets their Is_Public flag accordingly. + + Transfer_Entities (Curr_S, Encl_S); - Transfer_Entities (S, Encl_S); + -- Mark the enclosing dynamic scope to ensure that the secondary stack + -- is properly released upon exiting the said scope. This is not needed + -- for .NET/JVM as those do not support the secondary stack. - -- Mark the enclosing dynamic scope so that the sec stack will be - -- released upon its exit unless this is a function that returns on - -- the sec stack in which case this will be done by the caller. + if VM_Target = No_VM and then Uses_Sec_Stack (Curr_S) then + Curr_S := Enclosing_Dynamic_Scope (Curr_S); - if VM_Target = No_VM and then Uses_SS then - S := Enclosing_Dynamic_Scope (S); + -- Do not mark a function that returns on the secondary stack as the + -- reclamation is done by the caller. - if Ekind (S) = E_Function - and then Requires_Transient_Scope (Etype (S)) + if Ekind (Curr_S) = E_Function + and then Requires_Transient_Scope (Etype (Curr_S)) then null; + + -- Otherwise mark the enclosing dynamic scope + else - Set_Uses_Sec_Stack (S); + Set_Uses_Sec_Stack (Curr_S); Check_Restriction (No_Secondary_Stack, N); end if; end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 6c2adbac5e8..f12cf6ab4c3 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1013,6 +1013,49 @@ package body Exp_Util is end if; end Build_Runtime_Call; + ------------------------ + -- Build_SS_Mark_Call -- + ------------------------ + + function Build_SS_Mark_Call + (Loc : Source_Ptr; + Mark : Entity_Id) return Node_Id + is + begin + -- Generate: + -- Mark : constant Mark_Id := SS_Mark; + + return + Make_Object_Declaration (Loc, + Defining_Identifier => Mark, + Constant_Present => True, + Object_Definition => + New_Occurrence_Of (RTE (RE_Mark_Id), Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc))); + end Build_SS_Mark_Call; + + --------------------------- + -- Build_SS_Release_Call -- + --------------------------- + + function Build_SS_Release_Call + (Loc : Source_Ptr; + Mark : Entity_Id) return Node_Id + is + begin + -- Generate: + -- SS_Release (Mark); + + return + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_SS_Release), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Mark, Loc))); + end Build_SS_Release_Call; + ---------------------------- -- Build_Task_Array_Image -- ---------------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 2f316ddb8d1..a47c7873237 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -244,6 +244,18 @@ package Exp_Util is -- information for the tree and for error messages. The call node is not -- analyzed on return, the caller is responsible for analyzing it. + function Build_SS_Mark_Call + (Loc : Source_Ptr; + Mark : Entity_Id) return Node_Id; + -- Build a call to routine System.Secondary_Stack.Mark. Mark denotes the + -- entity of the secondary stack mark. + + function Build_SS_Release_Call + (Loc : Source_Ptr; + Mark : Entity_Id) return Node_Id; + -- Build a call to routine System.Secondary_Stack.Release. Mark denotes the + -- entity of the secondary stack mark. + function Build_Task_Image_Decls (Loc : Source_Ptr; Id_Ref : Node_Id; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 3fde64d083e..51f95692f76 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -2754,9 +2754,10 @@ package body Makeutl is Debug_Output (" -> ", Name_Id (Root_Source.Display_File)); Dummy := Queue.Insert_No_Roots - (Source => (Format => Format_Gprbuild, - Tree => Source.Tree, - Id => Root_Source)); + (Source => (Format => Format_Gprbuild, + Tree => Source.Tree, + Id => Root_Source, + Closure => False)); Initialize_Source_Record (Root_Source); @@ -2926,8 +2927,10 @@ package body Makeutl is -- False, put the Ada sources only when they are in a library -- project. - Iter : Source_Iterator; - Source : Prj.Source_Id; + Iter : Source_Iterator; + Source : Prj.Source_Id; + OK : Boolean; + Closure : Boolean; begin -- Nothing to do when "-u" was specified and some files were @@ -2971,10 +2974,46 @@ package body Makeutl is or else Source.Project.Library) and then not Is_Subunit (Source) then - Queue.Insert - (Source => (Format => Format_Gprbuild, - Tree => Tree, - Id => Source)); + OK := True; + Closure := False; + + if Source.Unit /= No_Unit_Index + and then Source.Project.Library + and then Source.Project.Standalone_Library /= No + then + -- Check if the unit is in the interface + OK := False; + + declare + List : String_List_Id := + Source.Project.Lib_Interface_ALIs; + Element : String_Element; + + begin + while List /= Nil_String loop + Element := + Project_Tree.Shared.String_Elements.Table + (List); + + if Element.Value = Name_Id (Source.Dep_Name) + then + OK := True; + Closure := True; + exit; + end if; + + List := Element.Next; + end loop; + end; + end if; + + if OK then + Queue.Insert + (Source => (Format => Format_Gprbuild, + Tree => Tree, + Id => Source, + Closure => Closure)); + end if; end if; end if; end if; @@ -3064,9 +3103,10 @@ package body Makeutl is or else Src_Id.Project.Library_Kind = Static) then Queue.Insert - (Source => (Format => Format_Gprbuild, - Tree => Project_Tree, - Id => Src_Id)); + (Source => (Format => Format_Gprbuild, + Tree => Project_Tree, + Id => Src_Id, + Closure => True)); end if; end if; end loop; @@ -3151,7 +3191,11 @@ package body Makeutl is Data.Need_Linking := False; else - Data.Closure_Needed := Has_Mains; + Data.Closure_Needed := + Has_Mains + or else + (Root_Project.Library + and then Root_Project.Standalone_Library /= No); Data.Need_Compilation := All_Phases or Option_Compile_Only; Data.Need_Binding := All_Phases or Option_Bind_Only; Data.Need_Linking := (All_Phases or Option_Link_Only) diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 370f32ae14e..77f0f04976d 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -489,8 +489,9 @@ package Makeutl is record case Format is when Format_Gprbuild => - Tree : Project_Tree_Ref := No_Project_Tree; - Id : Source_Id := No_Source; + Tree : Project_Tree_Ref := No_Project_Tree; + Id : Source_Id := No_Source; + Closure : Boolean := False; when Format_Gnatmake => File : File_Name_Type := No_File; @@ -504,7 +505,8 @@ package Makeutl is -- depends on the builder, and in particular whether it only supports -- project-based files (in which case we have a full Source_Id record). - No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null); + No_Source_Info : constant Source_Info := + (Format_Gprbuild, null, null, False); procedure Initialize (Queue_Per_Obj_Dir : Boolean; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 43441248eb7..28277bcefaf 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6262,7 +6262,7 @@ package body Sem_Res is -- expressions, that are not handled by GNATprove. elsif Is_Potentially_Unevaluated (N) then - Error_Msg_NE ("?no contextual anlysis of &", N, Nam); + Error_Msg_NE ("?no contextual analysis of &", N, Nam); Error_Msg_N ("\call appears in potentially unevaluated context", N); Set_Is_Inlined_Always (Nam_UA, False); -- 2.30.2