===================================================================
@@ -3264,7 +3264,7 @@
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
===================================================================
@@ -3558,6 +3558,7 @@
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 @@
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 @@
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 @@
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);
===================================================================
@@ -2767,20 +2767,46 @@
-- 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)))));
+ declare
+ Block_Nod : Node_Id;
+ Block_Id : Entity_Id;
- Analyze (N);
- return;
+ 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
===================================================================
@@ -6383,9 +6383,12 @@
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 @@
-- 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 @@
and then not Are_Wrapped (Statements (N))
and then Requires_Cleanup_Actions (Statements (N), False, False)
then
- Block := Wrap_Statements_In_Block (Statements (N));
+ 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;
===================================================================
@@ -4074,9 +4074,9 @@
-- Protection object (see System.Tasking.Protected_Objects).
-- Uses_Sec_Stack (Flag95)
+-- 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 @@
-- 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
===================================================================
@@ -217,6 +217,33 @@
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 @@
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 --
------------------------------------
===================================================================
@@ -43,6 +43,12 @@
-- 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 @@
-- 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