diff options
author | Hristian Kirtchev <kirtchev@adacore.com> | 2018-09-26 09:18:35 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-09-26 09:18:35 +0000 |
commit | abbfd69841b2357d242d47abda8d0430269ab829 (patch) | |
tree | 0780ea6986b51d3e34b042b2235195b6dddbca58 | |
parent | c886a946134d08a3ae3ad2dacbcee8d6b981db1d (diff) | |
download | gcc-abbfd69841b2357d242d47abda8d0430269ab829.zip gcc-abbfd69841b2357d242d47abda8d0430269ab829.tar.gz gcc-abbfd69841b2357d242d47abda8d0430269ab829.tar.bz2 |
[Ada] Spurious dependency on secondary stack
This patch reimplements the handling of the secondary stack when the
iteration scheme of a loop statement requires this support.
Prior to this modification, an iterator loop over a container was
assumed to require unconditional secondary stack management. This is
however not always true because of user-defined iterator types, where
routines First and Next return an iterator that does require the
secondary stack.
------------
-- Source --
------------
-- gnat.adc
pragma Restrictions (No_Secondary_Stack);
-- test.ads
package Test is
type Test_Type is private
with
Default_Initial_Condition,
Iterable => (First => First_Element,
Next => Next_Element,
Has_Element => Has_Element,
Element => Element);
type Cursor_Type is private;
function First_Element (T : Test_Type) return Cursor_Type;
function Next_Element (T : Test_Type; C : Cursor_Type) return Cursor_Type;
function Has_Element (T : Test_Type; C : Cursor_Type) return Boolean;
function Element (T : Test_Type; C : Cursor_Type) return Natural;
private
type Cursor_Type is new Natural;
type Test_Type is record
null;
end record;
function First_Element (T : Test_Type) return Cursor_Type
is (0);
function Next_Element (T : Test_Type; C : Cursor_Type) return Cursor_Type
is (0);
function Has_Element (T : Test_Type; C : Cursor_Type) return Boolean
is (False);
function Element (T : Test_Type; C : Cursor_Type) return Natural
is (0);
end Test;
-- main.adb
with Test; use Test;
procedure Main is
F : Boolean;
M : Test_Type;
begin
for Elem of M loop
null;
end loop;
F := (for all C of M => C = 1);
F := (for all C in M => True);
end Main;
-----------------
-- Compilation --
-----------------
$ gnatmake -q --RTS=zfp -nostdlib main.adb
2018-09-26 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_N_Allocator): Ensure that the use of the
secondary stack does not clash with restriction
No_Secondary_Stack.
* exp_ch6.adb (Expand_N_Extended_Return_Statement): Ensure that
the use of the secondary stack does not clash with restriction
No_Secondary_Stack.
* sem_ch5.adb (Analyze_Loop_Statement): Wrap the loop in a block
prior to analysis in order to either provide a local scope for
an iterator, or ensure that the secondary stack is properly
managed.
(Check_Call): Account for the case where the tree may be
unanalyzed or contain prior errors.
(Has_Call_Using_Secondary_Stack): Renamed to Has_Sec_Stack_Call.
Update all uses of the subprogram.
(Prepare_Loop_Statement): New routine.
From-SVN: r264625
-rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 1 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 3 | ||||
-rw-r--r-- | gcc/ada/sem_ch5.adb | 535 |
4 files changed, 362 insertions, 195 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5996edc..d549a87 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2018-09-26 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch4.adb (Expand_N_Allocator): Ensure that the use of the + secondary stack does not clash with restriction + No_Secondary_Stack. + * exp_ch6.adb (Expand_N_Extended_Return_Statement): Ensure that + the use of the secondary stack does not clash with restriction + No_Secondary_Stack. + * sem_ch5.adb (Analyze_Loop_Statement): Wrap the loop in a block + prior to analysis in order to either provide a local scope for + an iterator, or ensure that the secondary stack is properly + managed. + (Check_Call): Account for the case where the tree may be + unanalyzed or contain prior errors. + (Has_Call_Using_Secondary_Stack): Renamed to Has_Sec_Stack_Call. + Update all uses of the subprogram. + (Prepare_Loop_Statement): New routine. + 2018-09-26 Javier Miranda <miranda@adacore.com> * sem_res.adb (Resolve_Actuals): If the formal is a class-wide diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b08cf37..09a6cd0 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4417,6 +4417,7 @@ package body Exp_Ch4 is Set_Storage_Pool (N, Pool); if Is_RTE (Pool, RE_SS_Pool) then + Check_Restriction (No_Secondary_Stack, N); Set_Procedure_To_Call (N, RTE (RE_SS_Allocate)); -- In the case of an allocator for a simple storage pool, locate diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e08b748..96ee696 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5267,8 +5267,9 @@ package body Exp_Ch6 is Set_Comes_From_Source (Pool_Allocator, True); end if; - -- The allocator is returned on the secondary stack. + -- The allocator is returned on the secondary stack + Check_Restriction (No_Secondary_Stack, N); Set_Storage_Pool (SS_Allocator, RTE (RE_SS_Pool)); Set_Procedure_To_Call (SS_Allocator, RTE (RE_SS_Allocate)); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 95b5660..8c1f949 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -83,7 +83,7 @@ package body Sem_Ch5 is -- messages. This variable is recursively saved on entry to processing the -- construct, and restored on exit. - function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean; + function Has_Sec_Stack_Call (N : Node_Id) return Boolean; -- N is the node for an arbitrary construct. This function searches the -- construct N to see if any expressions within it contain function -- calls that use the secondary stack, returning True if any such call @@ -2850,7 +2850,7 @@ package body Sem_Ch5 is -- proper trace of the value, useful in optimizations that get rid -- of junk range checks. - if not Has_Call_Using_Secondary_Stack (Analyzed_Bound) then + if not Has_Sec_Stack_Call (Analyzed_Bound) then Analyze_And_Resolve (Original_Bound, Typ); -- Ensure that the bound is valid. This check should not be @@ -3360,18 +3360,23 @@ package body Sem_Ch5 is procedure Analyze_Loop_Statement (N : Node_Id) is + -- The following exception is raised by routine Prepare_Loop_Statement + -- to avoid further analysis of a transformed loop. + + Skip_Analysis : exception; + function Disable_Constant (N : Node_Id) return Traverse_Result; -- If N represents an E_Variable entity, set Is_True_Constant To False - function Is_Container_Iterator (Iter : Node_Id) return Boolean; - -- Given a loop iteration scheme, determine whether it is an Ada 2012 - -- container iteration. + procedure Disable_Constants is new Traverse_Proc (Disable_Constant); + -- Helper for Analyze_Loop_Statement, to unset Is_True_Constant on + -- variables referenced within an OpenACC construct. - function Is_Wrapped_In_Block (N : Node_Id) return Boolean; - -- Determine whether loop statement N has been wrapped in a block to - -- capture finalization actions that may be generated for container - -- iterators. Prevents infinite recursion when block is analyzed. - -- Routine is a noop if loop is single statement within source block. + procedure Prepare_Loop_Statement (Iter : Node_Id); + -- Determine whether loop statement N with iteration scheme Iter must be + -- transformed prior to analysis, and if so, perform it. The routine + -- raises Skip_Analysis to prevent further analysis of the transformed + -- loop. ---------------------- -- Disable_Constant -- @@ -3385,104 +3390,328 @@ package body Sem_Ch5 is then Set_Is_True_Constant (Entity (N), False); end if; + return OK; end Disable_Constant; - procedure Disable_Constants is new Traverse_Proc (Disable_Constant); - -- Helper for Analyze_Loop_Statement, to unset Is_True_Constant on - -- variables referenced within an OpenACC environment. + ---------------------------- + -- Prepare_Loop_Statement -- + ---------------------------- + + procedure Prepare_Loop_Statement (Iter : Node_Id) is + function Has_Sec_Stack_Default_Iterator + (Cont_Typ : Entity_Id) return Boolean; + pragma Inline (Has_Sec_Stack_Default_Iterator); + -- Determine whether container type Cont_Typ has a default iterator + -- that requires secondary stack management. + + function Is_Sec_Stack_Iteration_Primitive + (Cont_Typ : Entity_Id; + Iter_Prim_Nam : Name_Id) return Boolean; + pragma Inline (Is_Sec_Stack_Iteration_Primitive); + -- Determine whether container type Cont_Typ has an iteration routine + -- described by its name Iter_Prim_Nam that requires secondary stack + -- management. + + function Is_Wrapped_In_Block (Stmt : Node_Id) return Boolean; + pragma Inline (Is_Wrapped_In_Block); + -- Determine whether arbitrary statement Stmt is the sole statement + -- wrapped within some block, excluding pragmas. + + procedure Prepare_Iterator_Loop (Iter_Spec : Node_Id); + pragma Inline (Prepare_Iterator_Loop); + -- Prepare an iterator loop with iteration specification Iter_Spec + -- for transformation if needed. + + procedure Prepare_Param_Spec_Loop (Param_Spec : Node_Id); + pragma Inline (Prepare_Param_Spec_Loop); + -- Prepare a discrete loop with parameter specification Param_Spec + -- for transformation if needed. + + procedure Wrap_Loop_Statement (Manage_Sec_Stack : Boolean); + pragma Inline (Wrap_Loop_Statement); + -- Wrap loop statement N within a block. Flag Manage_Sec_Stack must + -- be set when the block must mark and release the secondary stack. + + ------------------------------------ + -- Has_Sec_Stack_Default_Iterator -- + ------------------------------------ + + function Has_Sec_Stack_Default_Iterator + (Cont_Typ : Entity_Id) return Boolean + is + Def_Iter : constant Node_Id := + Find_Value_Of_Aspect + (Cont_Typ, Aspect_Default_Iterator); + begin + return + Present (Def_Iter) + and then Requires_Transient_Scope (Etype (Def_Iter)); + end Has_Sec_Stack_Default_Iterator; + + -------------------------------------- + -- Is_Sec_Stack_Iteration_Primitive -- + -------------------------------------- + + function Is_Sec_Stack_Iteration_Primitive + (Cont_Typ : Entity_Id; + Iter_Prim_Nam : Name_Id) return Boolean + is + Iter_Prim : constant Entity_Id := + Get_Iterable_Type_Primitive + (Cont_Typ, Iter_Prim_Nam); + begin + return + Present (Iter_Prim) + and then Requires_Transient_Scope (Etype (Iter_Prim)); + end Is_Sec_Stack_Iteration_Primitive; - --------------------------- - -- Is_Container_Iterator -- - --------------------------- + ------------------------- + -- Is_Wrapped_In_Block -- + ------------------------- - function Is_Container_Iterator (Iter : Node_Id) return Boolean is - begin - -- Infinite loop + function Is_Wrapped_In_Block (Stmt : Node_Id) return Boolean is + Blk_HSS : Node_Id; + Blk_Id : Entity_Id; + Blk_Stmt : Node_Id; - if No (Iter) then - return False; + begin + Blk_Id := Current_Scope; - -- While loop + -- The current context is a block. Inspect the statements of the + -- block to determine whether it wraps Stmt. + + if Ekind (Blk_Id) = E_Block + and then Present (Block_Node (Blk_Id)) + then + Blk_HSS := + Handled_Statement_Sequence (Parent (Block_Node (Blk_Id))); + + -- Skip leading pragmas introduced for invariant and predicate + -- checks. + + Blk_Stmt := First (Statements (Blk_HSS)); + while Present (Blk_Stmt) + and then Nkind (Blk_Stmt) = N_Pragma + loop + Next (Blk_Stmt); + end loop; + + return Blk_Stmt = Stmt and then No (Next (Blk_Stmt)); + end if; - elsif Present (Condition (Iter)) then return False; + end Is_Wrapped_In_Block; - -- for Def_Id in [reverse] Name loop - -- for Def_Id [: Subtype_Indication] of [reverse] Name loop + --------------------------- + -- Prepare_Iterator_Loop -- + --------------------------- - elsif Present (Iterator_Specification (Iter)) then - declare - Nam : constant Node_Id := Name (Iterator_Specification (Iter)); - Nam_Copy : Node_Id; + procedure Prepare_Iterator_Loop (Iter_Spec : Node_Id) is + Cont_Typ : Entity_Id; + Nam : Node_Id; + Nam_Copy : Node_Id; - begin + begin + -- The iterator specification has syntactic errors. Transform the + -- loop into an infinite loop in order to safely perform at least + -- some minor analysis. This check must come first. + + if Error_Posted (Iter_Spec) then + Set_Iteration_Scheme (N, Empty); + Analyze (N); + + raise Skip_Analysis; + + -- Nothing to do when the loop is already wrapped in a block + + elsif Is_Wrapped_In_Block (N) then + null; + + -- Otherwise the iterator loop traverses an array or a container + -- and appears in the form + -- + -- for Def_Id in [reverse] Iterator_Name loop + -- for Def_Id [: Subtyp_Indic] of [reverse] Iterable_Name loop + + else + -- Prepare a copy of the iterated name for preanalysis. The + -- copy is semi inserted into the tree by setting its Parent + -- pointer. + + Nam := Name (Iter_Spec); Nam_Copy := New_Copy_Tree (Nam); Set_Parent (Nam_Copy, Parent (Nam)); + + -- Determine what the loop is iterating on + Preanalyze_Range (Nam_Copy); + Cont_Typ := Etype (Nam_Copy); - -- The only two options here are iteration over a container or - -- an array. + -- The iterator loop is traversing an array. This case does not + -- require any transformation. - return not Is_Array_Type (Etype (Nam_Copy)); - end; + if Is_Array_Type (Cont_Typ) then + null; - -- for Def_Id in [reverse] Discrete_Subtype_Definition loop + -- Otherwise unconditionally wrap the loop statement within + -- a block. The expansion of iterator loops may relocate the + -- iterator outside the loop, thus "leaking" its entity into + -- the enclosing scope. Wrapping the loop statement allows + -- for multiple iterator loops using the same iterator name + -- to coexist within the same scope. + -- + -- The block must manage the secondary stack when the iterator + -- loop is traversing a container using either + -- + -- * A default iterator obtained on the secondary stack + -- + -- * Call to Iterate where the iterator is returned on the + -- secondary stack. + -- + -- * Combination of First, Next, and Has_Element where the + -- first two return a cursor on the secondary stack. - else - declare - LP : constant Node_Id := Loop_Parameter_Specification (Iter); - DS : constant Node_Id := Discrete_Subtype_Definition (LP); - DS_Copy : Node_Id; + else + Wrap_Loop_Statement + (Manage_Sec_Stack => + Has_Sec_Stack_Default_Iterator (Cont_Typ) + or else Has_Sec_Stack_Call (Nam_Copy) + or else Is_Sec_Stack_Iteration_Primitive + (Cont_Typ, Name_First) + or else Is_Sec_Stack_Iteration_Primitive + (Cont_Typ, Name_Next)); + end if; + end if; + end Prepare_Iterator_Loop; - begin - DS_Copy := New_Copy_Tree (DS); - Set_Parent (DS_Copy, Parent (DS)); - Preanalyze_Range (DS_Copy); + ----------------------------- + -- Prepare_Param_Spec_Loop -- + ----------------------------- - -- Check for a call to Iterate () or an expression with - -- an iterator type. + procedure Prepare_Param_Spec_Loop (Param_Spec : Node_Id) is + High : Node_Id; + Low : Node_Id; + Rng : Node_Id; + Rng_Copy : Node_Id; + Rng_Typ : Entity_Id; - return - (Nkind (DS_Copy) = N_Function_Call - and then Needs_Finalization (Etype (DS_Copy))) - or else Is_Iterator (Etype (DS_Copy)); - end; - end if; - end Is_Container_Iterator; + begin + Rng := Discrete_Subtype_Definition (Param_Spec); - ------------------------- - -- Is_Wrapped_In_Block -- - ------------------------- + -- Nothing to do when the loop is already wrapped in a block - function Is_Wrapped_In_Block (N : Node_Id) return Boolean is - HSS : Node_Id; - Stat : Node_Id; + if Is_Wrapped_In_Block (N) then + null; - begin + -- The parameter specification appears in the form + -- + -- for Def_Id in Subtype_Mark Constraint loop - -- Check if current scope is a block that is not a transient block. + elsif Nkind (Rng) = N_Subtype_Indication + and then Nkind (Range_Expression (Constraint (Rng))) = N_Range + then + Rng := Range_Expression (Constraint (Rng)); - if Ekind (Current_Scope) /= E_Block - or else No (Block_Node (Current_Scope)) - then - return False; + -- Preanalyze the bounds of the range constraint - else - HSS := - Handled_Statement_Sequence (Parent (Block_Node (Current_Scope))); + Low := New_Copy_Tree (Low_Bound (Rng)); + High := New_Copy_Tree (High_Bound (Rng)); - -- Skip leading pragmas that may be introduced for invariant and - -- predicate checks. + Preanalyze (Low); + Preanalyze (High); - Stat := First (Statements (HSS)); - while Present (Stat) and then Nkind (Stat) = N_Pragma loop - Stat := Next (Stat); - end loop; + -- The bounds contain at least one function call that returns + -- on the secondary stack. Note that the loop must be wrapped + -- only when such a call exists. + + if Has_Sec_Stack_Call (Low) + or else + Has_Sec_Stack_Call (High) + then + Wrap_Loop_Statement (Manage_Sec_Stack => True); + end if; + + -- Otherwise the parameter specification appears in the form + -- + -- for Def_Id in Range loop + + else + -- Prepare a copy of the discrete range for preanalysis. The + -- copy is semi inserted into the tree by setting its Parent + -- pointer. + + Rng_Copy := New_Copy_Tree (Rng); + Set_Parent (Rng_Copy, Parent (Rng)); + + -- Determine what the loop is iterating on + + Preanalyze_Range (Rng_Copy); + Rng_Typ := Etype (Rng_Copy); + + -- Wrap the loop statement within a block in order to manage + -- the secondary stack when the discrete range is + -- + -- * Either a Forward_Iterator or a Reverse_Iterator + -- + -- * Function call whose return type requires finalization + -- actions. + + -- ??? it is unclear why using Has_Sec_Stack_Call directly on + -- the discrete range causes the freeze node of an itype to be + -- in the wrong scope in complex assertion expressions. + + if Is_Iterator (Rng_Typ) + or else (Nkind (Rng_Copy) = N_Function_Call + and then Needs_Finalization (Rng_Typ)) + then + Wrap_Loop_Statement (Manage_Sec_Stack => True); + end if; + end if; + end Prepare_Param_Spec_Loop; + + ------------------------- + -- Wrap_Loop_Statement -- + ------------------------- - return Stat = N and then No (Next (Stat)); + procedure Wrap_Loop_Statement (Manage_Sec_Stack : Boolean) is + Loc : constant Source_Ptr := Sloc (N); + + Blk : Node_Id; + Blk_Id : Entity_Id; + + begin + Blk := + 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 (Blk, Blk_Id); + Set_Uses_Sec_Stack (Blk_Id, Manage_Sec_Stack); + + Rewrite (N, Blk); + Analyze (N); + + raise Skip_Analysis; + end Wrap_Loop_Statement; + + -- Local variables + + Iter_Spec : constant Node_Id := Iterator_Specification (Iter); + Param_Spec : constant Node_Id := Loop_Parameter_Specification (Iter); + + -- Start of processing for Prepare_Loop_Statement + + begin + if Present (Iter_Spec) then + Prepare_Iterator_Loop (Iter_Spec); + + elsif Present (Param_Spec) then + Prepare_Param_Spec_Loop (Param_Spec); end if; - end Is_Wrapped_In_Block; + end Prepare_Loop_Statement; -- Local declarations @@ -3561,114 +3790,25 @@ package body Sem_Ch5 is Set_Has_Created_Identifier (N); end if; - -- If the iterator specification has a syntactic error, transform - -- construct into an infinite loop to prevent a crash and perform - -- some analysis. - - if Present (Iter) - and then Present (Iterator_Specification (Iter)) - and then Error_Posted (Iterator_Specification (Iter)) - then - Set_Iteration_Scheme (N, Empty); - Analyze (N); - return; - 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 - 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; - - -- Wrap the loop in a block when the evaluation of the loop iterator - -- relies on the secondary stack. Required to ensure releasing the - -- secondary stack as soon as the loop completes. - - if Present (Iter) - and then Present (Loop_Parameter_Specification (Iter)) - and then not Is_Wrapped_In_Block (N) - then - declare - LPS : constant Node_Id := Loop_Parameter_Specification (Iter); - DSD : constant Node_Id := - Original_Node (Discrete_Subtype_Definition (LPS)); - - Block_Id : Entity_Id; - Block_Nod : Node_Id; - HB : Node_Id; - LB : Node_Id; + -- Determine whether the loop statement must be transformed prior to + -- analysis, and if so, perform it. This early modification is needed + -- when: + -- + -- * The loop has an erroneous iteration scheme. In this case the + -- loop is converted into an infinite loop in order to perform + -- minor analysis. + -- + -- * The loop is an Ada 2012 iterator loop. In this case the loop is + -- wrapped within a block to provide a local scope for the iterator. + -- If the iterator specification requires the secondary stack in any + -- way, the block is marked in order to manage it. + -- + -- * The loop is using a parameter specification where the discrete + -- range requires the secondary stack. In this case the loop is + -- wrapped within a block in order to manage the secondary stack. - begin - if Nkind (DSD) = N_Subtype_Indication - and then Nkind (Range_Expression (Constraint (DSD))) = N_Range - then - LB := - New_Copy_Tree - (Low_Bound (Range_Expression (Constraint (DSD)))); - HB := - New_Copy_Tree - (High_Bound (Range_Expression (Constraint (DSD)))); - - Preanalyze (LB); - Preanalyze (HB); - - if Has_Call_Using_Secondary_Stack (LB) - or else Has_Call_Using_Secondary_Stack (HB) - then - 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); - Set_Uses_Sec_Stack (Block_Id); - Rewrite (N, Block_Nod); - Analyze (N); - return; - end if; - end if; - end; + if Present (Iter) then + Prepare_Loop_Statement (Iter); end if; -- Kill current values on entry to loop, since statements in the body of @@ -3842,6 +3982,10 @@ package body Sem_Ch5 is if Is_OpenAcc_Environment (Stmt) then Disable_Constants (Stmt); end if; + + exception + when Skip_Analysis => + null; end Analyze_Loop_Statement; ---------------------------- @@ -4108,11 +4252,11 @@ package body Sem_Ch5 is end if; end Check_Unreachable_Code; - ------------------------------------ - -- Has_Call_Using_Secondary_Stack -- - ------------------------------------ + ------------------------ + -- Has_Sec_Stack_Call -- + ------------------------ - function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean is + function Has_Sec_Stack_Call (N : Node_Id) return Boolean is function Check_Call (N : Node_Id) return Traverse_Result; -- Check if N is a function call which uses the secondary stack @@ -4144,13 +4288,16 @@ package body Sem_Ch5 is end loop; Subp := Entity (Nam); - Typ := Etype (Subp); - if Requires_Transient_Scope (Typ) then - return Abandon; + if Present (Subp) then + Typ := Etype (Subp); - elsif Sec_Stack_Needed_For_Return (Subp) then - return Abandon; + if Requires_Transient_Scope (Typ) then + return Abandon; + + elsif Sec_Stack_Needed_For_Return (Subp) then + return Abandon; + end if; end if; end if; @@ -4161,11 +4308,11 @@ package body Sem_Ch5 is function Check_Calls is new Traverse_Func (Check_Call); - -- Start of processing for Has_Call_Using_Secondary_Stack + -- Start of processing for Has_Sec_Stack_Call begin return Check_Calls (N) = Abandon; - end Has_Call_Using_Secondary_Stack; + end Has_Sec_Stack_Call; ---------------------- -- Preanalyze_Range -- |