From 2e44583dfbd498287b4f3d0b486a16eda9f8f9e7 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 25 Feb 2014 15:03:23 +0000 Subject: [PATCH] 2014-02-25 Hristian Kirtchev * einfo.ads Update the usage of flag Uses_Sec_Stack. Uses_Sec_Stack now applies to E_Loop entities. * exp_ch5.adb (Expand_Iterator_Loop): The temporary for a cursor now starts with the letter 'C'. This makes reading expanded code easier. * exp_ch7.adb (Establish_Transient_Scope): Add local variable Iter_Loop. Signal that an Ada 2012 iterator loop requires secondary stack management when creating a transient scope for an element reference. * exp_util.adb (Process_Statements_For_Controlled_Objects): When wrapping the statements of a loop, pass the E_Loop entity to the wrapping machinery. (Wrap_Statements_In_Block): Add formal parameter Scop along with comment on usage. Add local variables Block_Id, Block_Nod and Iter_Loop. Mark the generated block as requiring secondary stack management when the block is created inside an Ada 2012 iterator loop. This ensures that any reference objects are reclaimed on each iteration of the loop. * sem_ch5.adb (Analyze_Loop_Statement): Mark the generated block tasked with the handling of container iterators as requiring secondary stack management. This ensures that iterators are reclaimed when the loop terminates or is exited in any fashion. * sem_util.adb (Add_Block_Identifier): New routine. (Find_Enclosing_Iterator_Loop): New routine. * sem_util.ads (Add_Block_Identifier): New routine. (Find_Enclosing_Iterator_Loop): New routine. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@208133 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++ gcc/ada/einfo.ads | 7 +++--- gcc/ada/exp_ch5.adb | 2 +- gcc/ada/exp_ch7.adb | 57 ++++++++++++++++++++++++++++++++++++++++-------- gcc/ada/exp_util.adb | 51 +++++++++++++++++++++++++++++++++++++------ gcc/ada/sem_ch5.adb | 44 +++++++++++++++++++++++++++++-------- gcc/ada/sem_util.adb | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 11 ++++++++++ 8 files changed, 233 insertions(+), 29 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 527a58f..ed288b3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2014-02-25 Hristian Kirtchev + + * einfo.ads Update the usage of flag + Uses_Sec_Stack. Uses_Sec_Stack now applies to E_Loop entities. + * exp_ch5.adb (Expand_Iterator_Loop): The temporary for a cursor + now starts with the letter 'C'. This makes reading expanded + code easier. + * exp_ch7.adb (Establish_Transient_Scope): Add local variable + Iter_Loop. Signal that an Ada 2012 iterator loop requires + secondary stack management when creating a transient scope for + an element reference. + * exp_util.adb (Process_Statements_For_Controlled_Objects): + When wrapping the statements of a loop, pass the E_Loop entity + to the wrapping machinery. + (Wrap_Statements_In_Block): Add + formal parameter Scop along with comment on usage. Add local + variables Block_Id, Block_Nod and Iter_Loop. Mark the generated + block as requiring secondary stack management when the block is + created inside an Ada 2012 iterator loop. This ensures that any + reference objects are reclaimed on each iteration of the loop. + * sem_ch5.adb (Analyze_Loop_Statement): Mark the generated block + tasked with the handling of container iterators as requiring + secondary stack management. This ensures that iterators are + reclaimed when the loop terminates or is exited in any fashion. + * sem_util.adb (Add_Block_Identifier): New routine. + (Find_Enclosing_Iterator_Loop): New routine. + * sem_util.ads (Add_Block_Identifier): New routine. + (Find_Enclosing_Iterator_Loop): New routine. + 2014-02-25 Robert Dewar * sinfo.ads: Minor reformatting. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 00cc1fa..a9106b2 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4074,9 +4074,9 @@ package Einfo is -- Protection object (see System.Tasking.Protected_Objects). -- Uses_Sec_Stack (Flag95) --- Defined in scope entities (blocks,functions, procedures, tasks, --- entries). Set to True when secondary stack is used in this scope and --- must be released on exit unless Sec_Stack_Needed_For_Return is set. +-- Defined in scope entities (block, entry, function, loop, procedure, +-- task). Set to True when secondary stack is used in this scope and must +-- be released on exit unless Sec_Stack_Needed_For_Return is set. -- Warnings_Off (Flag96) -- Defined in all entities. Set if a pragma Warnings (Off, entity-name) @@ -5633,6 +5633,7 @@ package Einfo is -- Has_Loop_Entry_Attributes (Flag260) -- Has_Master_Entity (Flag21) -- Has_Nested_Block_With_Handler (Flag101) + -- Uses_Sec_Stack (Flag95) -- E_Modular_Integer_Type -- E_Modular_Integer_Subtype diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 5398cd2..2fd38ac 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3264,7 +3264,7 @@ package body Exp_Ch5 is Ent : Entity_Id; begin - Cursor := Make_Temporary (Loc, 'I'); + Cursor := Make_Temporary (Loc, 'C'); -- For an container element iterator, the iterator type -- is obtained from the corresponding aspect, whose return diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 41fe352..dccf831 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3558,6 +3558,7 @@ package body Exp_Ch7 is procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean) is Loc : constant Source_Ptr := Sloc (N); + Iter_Loop : Entity_Id; Wrap_Node : Node_Id; begin @@ -3571,8 +3572,8 @@ package body Exp_Ch7 is return; - -- If we have encountered Standard there are no enclosing - -- transient scopes. + -- If we have encountered Standard there are no enclosing transient + -- scopes. elsif Scope_Stack.Table (S).Entity = Standard_Standard then exit; @@ -3581,17 +3582,17 @@ package body Exp_Ch7 is Wrap_Node := Find_Node_To_Be_Wrapped (N); - -- Case of no wrap node, false alert, no transient scope needed + -- The context does not contain a node that requires a transient scope, + -- nothing to do. if No (Wrap_Node) then null; - -- If the node to wrap is an iteration_scheme, the expression is - -- one of the bounds, and the expansion will make an explicit - -- declaration for it (see Analyze_Iteration_Scheme, sem_ch5.adb), - -- so do not apply any transformations here. Same for an Ada 2012 - -- iterator specification, where a block is created for the expression - -- that build the container. + -- If the node to wrap is an iteration_scheme, the expression is one of + -- the bounds, and the expansion will make an explicit declaration for + -- it (see Analyze_Iteration_Scheme, sem_ch5.adb), so do not apply any + -- transformations here. Same for an Ada 2012 iterator specification, + -- where a block is created for the expression that build the container. elsif Nkind_In (Wrap_Node, N_Iteration_Scheme, N_Iterator_Specification) @@ -3608,13 +3609,51 @@ package body Exp_Ch7 is then null; + -- Create a block entity to act as a transient scope. Note that when the + -- node to be wrapped is an expression or a statement, a real physical + -- block is constructed (see routines Wrap_Transient_Expression and + -- Wrap_Transient_Statement) and inserted into the tree. + else Push_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B')); Set_Scope_Is_Transient; + -- The transient scope must also take care of the secondary stack + -- management. + if Sec_Stack then Set_Uses_Sec_Stack (Current_Scope); Check_Restriction (No_Secondary_Stack, N); + + -- The expansion of iterator loops generates references to objects + -- in order to extract elements from a container: + + -- Ref : Reference_Type_Ptr := Reference (Container, Cursor); + -- Obj : renames Ref.all.Element.all; + + -- These references are controlled and returned on the secondary + -- stack. A new reference is created at each iteration of the loop + -- and as a result it must be finalized and the space occupied by + -- it on the secondary stack reclaimed at the end of the current + -- iteration. + + -- When the context that requires a transient scope is a call to + -- routine Reference, the node to be wrapped is the source object: + + -- for Obj of Container loop + + -- Routine Wrap_Transient_Declaration however does not generate a + -- physical block as wrapping a declaration will kill it too ealy. + -- To handle this peculiar case, mark the related iterator loop as + -- requiring the secondary stack. This signals the finalization + -- machinery to manage the secondary stack (see routine + -- Process_Statements_For_Controlled_Objects). + + Iter_Loop := Find_Enclosing_Iterator_Loop (Current_Scope); + + if Present (Iter_Loop) then + Set_Uses_Sec_Stack (Iter_Loop); + end if; end if; Set_Etype (Current_Scope, Standard_Void_Type); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1ce77c6..f409cb0 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6383,9 +6383,12 @@ package body Exp_Util is function Are_Wrapped (L : List_Id) return Boolean; -- Determine whether list L contains only one statement which is a block - function Wrap_Statements_In_Block (L : List_Id) return Node_Id; + function Wrap_Statements_In_Block + (L : List_Id; + Scop : Entity_Id := Current_Scope) return Node_Id; -- Given a list of statements L, wrap it in a block statement and return - -- the generated node. + -- the generated node. Scop is either the current scope or the scope of + -- the context (if applicable). ----------------- -- Are_Wrapped -- @@ -6404,14 +6407,39 @@ package body Exp_Util is -- Wrap_Statements_In_Block -- ------------------------------ - function Wrap_Statements_In_Block (L : List_Id) return Node_Id is + function Wrap_Statements_In_Block + (L : List_Id; + Scop : Entity_Id := Current_Scope) return Node_Id + is + Block_Id : Entity_Id; + Block_Nod : Node_Id; + Iter_Loop : Entity_Id; + begin - return + Block_Nod := Make_Block_Statement (Loc, - Declarations => No_List, + Declarations => No_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => L)); + + -- Create a label for the block in case the block needs to manage the + -- secondary stack. A label allows for flag Uses_Sec_Stack to be set. + + Add_Block_Identifier (Block_Nod, Block_Id); + + -- When wrapping the statements of an iterator loop, check whether + -- the loop requires secondary stack management and if so, propagate + -- the flag to the block. This way the secondary stack is marked and + -- released at each iteration of the loop. + + Iter_Loop := Find_Enclosing_Iterator_Loop (Scop); + + if Present (Iter_Loop) and then Uses_Sec_Stack (Iter_Loop) then + Set_Uses_Sec_Stack (Block_Id); + end if; + + return Block_Nod; end Wrap_Statements_In_Block; -- Local variables @@ -6475,9 +6503,18 @@ package body Exp_Util is and then not Are_Wrapped (Statements (N)) and then Requires_Cleanup_Actions (Statements (N), False, False) then - Block := Wrap_Statements_In_Block (Statements (N)); - Set_Statements (N, New_List (Block)); + if Nkind (N) = N_Loop_Statement + and then Present (Identifier (N)) + then + Block := + Wrap_Statements_In_Block + (L => Statements (N), + Scop => Entity (Identifier (N))); + else + Block := Wrap_Statements_In_Block (Statements (N)); + end if; + Set_Statements (N, New_List (Block)); Analyze (Block); end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 488ea7b..30c26f0 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2767,20 +2767,46 @@ package body Sem_Ch5 is -- Iteration over a container in Ada 2012 involves the creation of a -- controlled iterator object. Wrap the loop in a block to ensure the -- timely finalization of the iterator and release of container locks. + -- The same applies to the use of secondary stack when obtaining an + -- iterator. if Ada_Version >= Ada_2012 and then Is_Container_Iterator (Iter) and then not Is_Wrapped_In_Block (N) then - Rewrite (N, - Make_Block_Statement (Loc, - Declarations => New_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Relocate_Node (N))))); - - Analyze (N); - return; + declare + Block_Nod : Node_Id; + Block_Id : Entity_Id; + + begin + Block_Nod := + Make_Block_Statement (Loc, + Declarations => New_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List (Relocate_Node (N)))); + + Add_Block_Identifier (Block_Nod, Block_Id); + + -- The expansion of iterator loops generates an iterator in order + -- to traverse the elements of a container: + + -- Iter : := Iterate (Container)'reference; + + -- The iterator is controlled and returned on the secondary stack. + -- The analysis of the call to Iterate establishes a transient + -- scope to deal with the secondary stack management, but never + -- really creates a physical block as this would kill the iterator + -- too early (see Wrap_Transient_Declaration). To address this + -- case, mark the generated block as needing secondary stack + -- management. + + Set_Uses_Sec_Stack (Block_Id); + + Rewrite (N, Block_Nod); + Analyze (N); + return; + end; end if; -- Kill current values on entry to loop, since statements in the body of diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3f87216..d33c235 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -217,6 +217,33 @@ package body Sem_Util is Append_Elmt (A, L); end Add_Access_Type_To_Process; + -------------------------- + -- Add_Block_Identifier -- + -------------------------- + + procedure Add_Block_Identifier (N : Node_Id; Id : out Entity_Id) is + Loc : constant Source_Ptr := Sloc (N); + + begin + pragma Assert (Nkind (N) = N_Block_Statement); + + -- The block already has a label, return its entity + + if Present (Identifier (N)) then + Id := Entity (Identifier (N)); + + -- Create a new block label and set its attributes + + else + Id := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); + Set_Etype (Id, Standard_Void_Type); + Set_Parent (Id, N); + + Set_Identifier (N, New_Occurrence_Of (Id, Loc)); + Set_Block_Node (Id, Identifier (N)); + end if; + end Add_Block_Identifier; + ----------------------- -- Add_Contract_Item -- ----------------------- @@ -5592,6 +5619,40 @@ package body Sem_Util is raise Program_Error; end Find_Corresponding_Discriminant; + ---------------------------------- + -- Find_Enclosing_Iterator_Loop -- + ---------------------------------- + + function Find_Enclosing_Iterator_Loop (Id : Entity_Id) return Entity_Id is + Constr : Node_Id; + S : Entity_Id; + + begin + -- Traverse the scope chain looking for an iterator loop. Such loops are + -- usually transformed into blocks, hence the use of Original_Node. + + S := Id; + while Present (S) and then S /= Standard_Standard loop + if Ekind (S) = E_Loop + and then Nkind (Parent (S)) = N_Implicit_Label_Declaration + then + Constr := Original_Node (Label_Construct (Parent (S))); + + if Nkind (Constr) = N_Loop_Statement + and then Present (Iteration_Scheme (Constr)) + and then Nkind (Iterator_Specification (Iteration_Scheme + (Constr))) = N_Iterator_Specification + then + return S; + end if; + end if; + + S := Scope (S); + end loop; + + return Empty; + end Find_Enclosing_Iterator_Loop; + ------------------------------------ -- Find_Loop_In_Conditional_Block -- ------------------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b6e7632..86a2b52 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -43,6 +43,12 @@ package Sem_Util is -- Add A to the list of access types to process when expanding the -- freeze node of E. + procedure Add_Block_Identifier (N : Node_Id; Id : out Entity_Id); + -- Given a block statement N, generate an internal E_Block label and make + -- it the identifier of the block. Id denotes the generated entity. If the + -- block already has an identifier, Id denotes the entity of the existing + -- label. + procedure Add_Contract_Item (Prag : Node_Id; Id : Entity_Id); -- Add pragma Prag to the contract of an entry, a package [body], a -- subprogram [body] or variable denoted by Id. The following are valid @@ -569,6 +575,11 @@ package Sem_Util is -- analyzed. Subsequent uses of this id on a different type denotes the -- discriminant at the same position in this new type. + function Find_Enclosing_Iterator_Loop (Id : Entity_Id) return Entity_Id; + -- Given an arbitrary entity, try to find the nearest enclosing iterator + -- loop. If such a loop is found, return the entity of its identifier (the + -- E_Loop scope), otherwise return Empty. + function Find_Loop_In_Conditional_Block (N : Node_Id) return Node_Id; -- Find the nested loop statement in a conditional block. Loops subject to -- attribute 'Loop_Entry are transformed into blocks. Parts of the original -- 2.7.4