* 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
+2014-02-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <dewar@adacore.com>
* sinfo.ads: Minor reformatting.
-- 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)
-- 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
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
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
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;
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)
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 : <object type> 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);
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 --
-- 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
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;
-- 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 : <iterator type> := 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
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 --
-----------------------
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 --
------------------------------------
-- 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
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff