From 176dadf6396a67fb74572ceb74c1e66520adbd51 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Aug 2011 12:16:43 +0200 Subject: [PATCH] [multiple changes] 2011-08-02 Robert Dewar * sem_ch3.adb: Minor reformatting Minor comment addition Minor error msg text change 2011-08-02 Javier Miranda * sem_ch5.adb (Analyze_Iteration_Scheme.Uses_Secondary_Stack): New function. Used to be more precise when we generate a variable plus one assignment to remove side effects in the evaluation of the Bound expressions. (Analyze_Iteration_Scheme): Clean attribute analyzed in all the nodes of the bound expression to force its re-analysis and thus expand the associated transient scope (if required). Code cleanup replacing the previous code that declared the constant entity by an invocation to routine Force_Evaluation which centralizes this work in the frontend. From-SVN: r177124 --- gcc/ada/ChangeLog | 18 +++ gcc/ada/sem_ch3.adb | 27 ++-- gcc/ada/sem_ch5.adb | 361 +++++++++++++++++++++++++------------------- 3 files changed, 237 insertions(+), 169 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ffee3e4e579..712f5f77ac2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2011-08-02 Robert Dewar + + * sem_ch3.adb: Minor reformatting + Minor comment addition + Minor error msg text change + +2011-08-02 Javier Miranda + + * sem_ch5.adb (Analyze_Iteration_Scheme.Uses_Secondary_Stack): New + function. Used to be more precise when we generate a variable plus one + assignment to remove side effects in the evaluation of the Bound + expressions. + (Analyze_Iteration_Scheme): Clean attribute analyzed in all the nodes + of the bound expression to force its re-analysis and thus expand the + associated transient scope (if required). Code cleanup replacing the + previous code that declared the constant entity by an invocation to + routine Force_Evaluation which centralizes this work in the frontend. + 2011-08-02 Robert Dewar * einfo.adb (Is_Base_Type): Improve efficiency by using a flag table diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 82bd372e8e6..d17d9151560 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1666,10 +1666,12 @@ package body Sem_Ch3 is ----------------------------------- procedure Analyze_Component_Declaration (N : Node_Id) is - Id : constant Entity_Id := Defining_Identifier (N); - E : constant Node_Id := Expression (N); - T : Entity_Id; - P : Entity_Id; + Id : constant Entity_Id := Defining_Identifier (N); + E : constant Node_Id := Expression (N); + Typ : constant Node_Id := + Subtype_Indication (Component_Definition (N)); + T : Entity_Id; + P : Entity_Id; function Contains_POC (Constr : Node_Id) return Boolean; -- Determines whether a constraint uses the discriminant of a record @@ -1773,8 +1775,6 @@ package body Sem_Ch3 is end if; end Is_Known_Limited; - Typ : constant Node_Id := Subtype_Indication (Component_Definition (N)); - -- Start of processing for Analyze_Component_Declaration begin @@ -4005,8 +4005,9 @@ package body Sem_Ch3 is ("subtype of Boolean cannot have constraint", N); end if; - -- Subtype of String shall have a lower index bound equal to 1 in SPARK - -- or ALFA. + -- String subtype must have a lower bound of 1 in SPARK/ALFA. Note that + -- we do not need to test for the non-static case here, since that was + -- already taken care of in Process_Range_Expr_In_Decl. if Base_Type (T) = Standard_String and then Nkind (Subtype_Indication (N)) = N_Subtype_Indication @@ -4015,6 +4016,7 @@ package body Sem_Ch3 is Cstr : constant Node_Id := Constraint (Subtype_Indication (N)); Drange : Node_Id; Low : Node_Id; + begin if Nkind (Cstr) = N_Index_Or_Discriminant_Constraint and then List_Length (Constraints (Cstr)) = 1 @@ -4028,7 +4030,7 @@ package body Sem_Ch3 is and then Expr_Value (Low) /= 1 then Check_Formal_Restriction - ("subtype of String must have 1 as lower bound", N); + ("String subtype must have lower bound of 1", N); end if; end if; end if; @@ -19011,6 +19013,7 @@ package body Sem_Ch3 is declare Typ : Node_Id; Ctxt : Node_Id; + begin if Nkind (Parent (Def)) = N_Full_Type_Declaration then Typ := Parent (Def); @@ -19027,14 +19030,12 @@ package body Sem_Ch3 is then Check_Formal_Restriction ("type should be defined in package specification", Typ); + elsif Nkind (Ctxt) /= N_Package_Specification - or else - Nkind (Parent (Parent (Ctxt))) /= N_Compilation_Unit + or else Nkind (Parent (Parent (Ctxt))) /= N_Compilation_Unit then Check_Formal_Restriction ("type should be defined in library unit package", Typ); - else - null; end if; end; end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 65880d5604e..0780140cdd8 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -95,9 +95,9 @@ package body Sem_Ch5 is procedure Set_Assignment_Type (Opnd : Node_Id; Opnd_Type : in out Entity_Id); - -- Opnd is either the Lhs or Rhs of the assignment, and Opnd_Type - -- is the nominal subtype. This procedure is used to deal with cases - -- where the nominal subtype must be replaced by the actual subtype. + -- Opnd is either the Lhs or Rhs of the assignment, and Opnd_Type is the + -- nominal subtype. This procedure is used to deal with cases where the + -- nominal subtype must be replaced by the actual subtype. ------------------------------- -- Diagnose_Non_Variable_Lhs -- @@ -105,8 +105,8 @@ package body Sem_Ch5 is procedure Diagnose_Non_Variable_Lhs (N : Node_Id) is begin - -- Not worth posting another error if left hand side already - -- flagged as being illegal in some respect. + -- Not worth posting another error if left hand side already flagged + -- as being illegal in some respect. if Error_Posted (N) then return; @@ -130,8 +130,8 @@ package body Sem_Ch5 is elsif (Is_Prival (Ent) and then (Ekind (Current_Scope) = E_Function - or else Ekind (Enclosing_Dynamic_Scope ( - Current_Scope)) = E_Function)) + or else Ekind (Enclosing_Dynamic_Scope + (Current_Scope)) = E_Function)) or else (Ekind (Ent) = E_Component and then Is_Protected_Type (Scope (Ent))) @@ -202,10 +202,10 @@ package body Sem_Ch5 is Require_Entity (Opnd); -- If the assignment operand is an in-out or out parameter, then we - -- get the actual subtype (needed for the unconstrained case). - -- If the operand is the actual in an entry declaration, then within - -- the accept statement it is replaced with a local renaming, which - -- may also have an actual subtype. + -- get the actual subtype (needed for the unconstrained case). If the + -- operand is the actual in an entry declaration, then within the + -- accept statement it is replaced with a local renaming, which may + -- also have an actual subtype. if Is_Entity_Name (Opnd) and then (Ekind (Entity (Opnd)) = E_Out_Parameter @@ -344,8 +344,8 @@ package body Sem_Ch5 is end if; end if; - -- The resulting assignment type is T1, so now we will resolve the - -- left hand side of the assignment using this determined type. + -- The resulting assignment type is T1, so now we will resolve the left + -- hand side of the assignment using this determined type. Resolve (Lhs, T1); @@ -353,8 +353,8 @@ package body Sem_Ch5 is if not Is_Variable (Lhs) then - -- Ada 2005 (AI-327): Check assignment to the attribute Priority of - -- a protected object. + -- Ada 2005 (AI-327): Check assignment to the attribute Priority of a + -- protected object. declare Ent : Entity_Id; @@ -452,9 +452,9 @@ package body Sem_Ch5 is ("target of assignment operation must not be abstract", Lhs); end if; - -- Resolution may have updated the subtype, in case the left-hand - -- side is a private protected component. Use the correct subtype - -- to avoid scoping issues in the back-end. + -- Resolution may have updated the subtype, in case the left-hand side + -- is a private protected component. Use the correct subtype to avoid + -- scoping issues in the back-end. T1 := Etype (Lhs); @@ -631,7 +631,7 @@ package body Sem_Ch5 is Apply_Scalar_Range_Check (Rhs, Etype (Lhs)); -- For array types, verify that lengths match. If the right hand side - -- if a function call that has been inlined, the assignment has been + -- is a function call that has been inlined, the assignment has been -- rewritten as a block, and the constraint check will be applied to the -- assignment within the block. @@ -648,8 +648,8 @@ package body Sem_Ch5 is -- side is a type conversion to an unconstrained type, a length check -- is performed on the expression itself during expansion. In rare -- cases, the redundant length check is computed on an index type - -- with a different representation, triggering incorrect code in - -- the back end. + -- with a different representation, triggering incorrect code in the + -- back end. Apply_Length_Check (Rhs, Etype (Lhs)); @@ -679,11 +679,11 @@ package body Sem_Ch5 is and then Same_Object (Lhs, Original_Node (Rhs)) - -- But exclude the case where the right side was an operation - -- that got rewritten (e.g. JUNK + K, where K was known to be - -- zero). We don't want to warn in such a case, since it is - -- reasonable to write such expressions especially when K is - -- defined symbolically in some other package. + -- But exclude the case where the right side was an operation that + -- got rewritten (e.g. JUNK + K, where K was known to be zero). We + -- don't want to warn in such a case, since it is reasonable to write + -- such expressions especially when K is defined symbolically in some + -- other package. and then Nkind (Original_Node (Rhs)) not in N_Op then @@ -722,11 +722,11 @@ package body Sem_Ch5 is Set_Referenced_Modified (Lhs, Out_Param => False); end if; - -- Final step. If left side is an entity, then we may be able to - -- reset the current tracked values to new safe values. We only have - -- something to do if the left side is an entity name, and expansion - -- has not modified the node into something other than an assignment, - -- and of course we only capture values if it is safe to do so. + -- Final step. If left side is an entity, then we may be able to reset + -- the current tracked values to new safe values. We only have something + -- to do if the left side is an entity name, and expansion has not + -- modified the node into something other than an assignment, and of + -- course we only capture values if it is safe to do so. if Is_Entity_Name (Lhs) and then Nkind (N) = N_Assignment_Statement @@ -739,8 +739,8 @@ package body Sem_Ch5 is -- If simple variable on left side, warn if this assignment -- blots out another one (rendering it useless) and note - -- location of assignment in case no one references value. - -- We only do this for source assignments, otherwise we can + -- location of assignment in case no one references value. We + -- only do this for source assignments, otherwise we can -- generate bogus warnings when an assignment is rewritten as -- another assignment, and gets tied up with itself. @@ -809,9 +809,8 @@ package body Sem_Ch5 is begin Check_Formal_Restriction ("block statement is not allowed", N); - -- If no handled statement sequence is present, things are really - -- messed up, and we just return immediately (this is a defence - -- against previous errors). + -- If no handled statement sequence is present, things are really messed + -- up, and we just return immediately (defence against previous errors). if No (HSS) then return; @@ -843,10 +842,9 @@ package body Sem_Ch5 is Analyze (Id); Ent := Entity (Id); - -- An error defense. If we have an identifier, but no entity, - -- then something is wrong. If we have previous errors, then - -- just remove the identifier and continue, otherwise raise - -- an exception. + -- An error defense. If we have an identifier, but no entity, then + -- something is wrong. If previous errors, then just remove the + -- identifier and continue, otherwise raise an exception. if No (Ent) then if Total_Errors_Detected /= 0 then @@ -887,9 +885,9 @@ package body Sem_Ch5 is Analyze (HSS); Process_End_Label (HSS, 'e', Ent); - -- If exception handlers are present, then we indicate that - -- enclosing scopes contain a block with handlers. We only - -- need to mark non-generic scopes. + -- If exception handlers are present, then we indicate that enclosing + -- scopes contain a block with handlers. We only need to mark non- + -- generic scopes. if Present (EH) then S := Scope (Ent); @@ -932,17 +930,17 @@ package body Sem_Ch5 is -- Don't care about assigned values Statements_Analyzed : Boolean := False; - -- Set True if at least some statement sequences get analyzed. - -- If False on exit, means we had a serious error that prevented - -- full analysis of the case statement, and as a result it is not - -- a good idea to output warning messages about unreachable code. + -- Set True if at least some statement sequences get analyzed. If False + -- on exit, means we had a serious error that prevented full analysis of + -- the case statement, and as a result it is not a good idea to output + -- warning messages about unreachable code. Save_Unblocked_Exit_Count : constant Nat := Unblocked_Exit_Count; -- Recursively save value of this global, will be restored on exit procedure Non_Static_Choice_Error (Choice : Node_Id); - -- Error routine invoked by the generic instantiation below when - -- the case statement has a non static choice. + -- Error routine invoked by the generic instantiation below when the + -- case statement has a non static choice. procedure Process_Statements (Alternative : Node_Id); -- Analyzes all the statements associated with a case alternative. @@ -981,16 +979,16 @@ package body Sem_Ch5 is Statements_Analyzed := True; -- An interesting optimization. If the case statement expression - -- is a simple entity, then we can set the current value within - -- an alternative if the alternative has one possible value. + -- is a simple entity, then we can set the current value within an + -- alternative if the alternative has one possible value. -- case N is -- when 1 => alpha -- when 2 | 3 => beta -- when others => gamma - -- Here we know that N is initially 1 within alpha, but for beta - -- and gamma, we do not know anything more about the initial value. + -- Here we know that N is initially 1 within alpha, but for beta and + -- gamma, we do not know anything more about the initial value. if Is_Entity_Name (Exp) then Ent := Entity (Exp); @@ -1080,10 +1078,10 @@ package body Sem_Ch5 is return; end if; - -- If the case expression is a formal object of mode in out, then - -- treat it as having a nonstatic subtype by forcing use of the base - -- type (which has to get passed to Check_Case_Choices below). Also - -- use base type when the case expression is parenthesized. + -- If the case expression is a formal object of mode in out, then treat + -- it as having a nonstatic subtype by forcing use of the base type + -- (which has to get passed to Check_Case_Choices below). Also use base + -- type when the case expression is parenthesized. if Paren_Count (Exp) > 0 or else (Is_Entity_Name (Exp) @@ -1148,13 +1146,16 @@ package body Sem_Ch5 is ---------------------------- -- If the exit includes a name, it must be the name of a currently open - -- loop. Otherwise there must be an innermost open loop on the stack, - -- to which the statement implicitly refers. + -- loop. Otherwise there must be an innermost open loop on the stack, to + -- which the statement implicitly refers. -- Additionally, in formal mode: - -- * the exit can only name the closest enclosing loop; - -- * an exit with a when clause must be directly contained in a loop; - -- * an exit without a when clause must be directly contained in an + + -- The exit can only name the closest enclosing loop; + + -- An exit with a when clause must be directly contained in a loop; + + -- An exit without a when clause must be directly contained in an -- if-statement with no elsif or else, which is itself directly contained -- in a loop. The exit must be the last statement in the if-statement. @@ -1177,6 +1178,7 @@ package body Sem_Ch5 is if not In_Open_Scopes (U_Name) or else Ekind (U_Name) /= E_Loop then Error_Msg_N ("invalid loop name in exit statement", N); return; + else if Has_Loop_In_Inner_Open_Scopes (U_Name) then Check_Formal_Restriction @@ -1185,6 +1187,7 @@ package body Sem_Ch5 is Set_Has_Exit (U_Name); end if; + else U_Name := Empty; end if; @@ -1194,7 +1197,8 @@ package body Sem_Ch5 is Kind := Ekind (Scope_Id); if Kind = E_Loop - and then (No (Target) or else Scope_Id = U_Name) then + and then (No (Target) or else Scope_Id = U_Name) + then Set_Has_Exit (Scope_Id); exit; @@ -1339,15 +1343,14 @@ package body Sem_Ch5 is -- A special complication arises in the analysis of if statements - -- The expander has circuitry to completely delete code that it - -- can tell will not be executed (as a result of compile time known - -- conditions). In the analyzer, we ensure that code that will be - -- deleted in this manner is analyzed but not expanded. This is - -- obviously more efficient, but more significantly, difficulties - -- arise if code is expanded and then eliminated (e.g. exception - -- table entries disappear). Similarly, itypes generated in deleted - -- code must be frozen from start, because the nodes on which they - -- depend will not be available at the freeze point. + -- The expander has circuitry to completely delete code that it can tell + -- will not be executed (as a result of compile time known conditions). In + -- the analyzer, we ensure that code that will be deleted in this manner is + -- analyzed but not expanded. This is obviously more efficient, but more + -- significantly, difficulties arise if code is expanded and then + -- eliminated (e.g. exception table entries disappear). Similarly, itypes + -- generated in deleted code must be frozen from start, because the nodes + -- on which they depend will not be available at the freeze point. procedure Analyze_If_Statement (N : Node_Id) is E : Node_Id; @@ -1358,13 +1361,13 @@ package body Sem_Ch5 is Save_In_Deleted_Code : Boolean; Del : Boolean := False; - -- This flag gets set True if a True condition has been found, - -- which means that remaining ELSE/ELSIF parts are deleted. + -- This flag gets set True if a True condition has been found, which + -- means that remaining ELSE/ELSIF parts are deleted. procedure Analyze_Cond_Then (Cnode : Node_Id); - -- This is applied to either the N_If_Statement node itself or - -- to an N_Elsif_Part node. It deals with analyzing the condition - -- and the THEN statements associated with it. + -- This is applied to either the N_If_Statement node itself or to an + -- N_Elsif_Part node. It deals with analyzing the condition and the THEN + -- statements associated with it. ----------------------- -- Analyze_Cond_Then -- @@ -1390,8 +1393,8 @@ package body Sem_Ch5 is elsif Compile_Time_Known_Value (Cond) then Save_In_Deleted_Code := In_Deleted_Code; - -- If condition is True, then analyze the THEN statements - -- and set no expansion for ELSE and ELSIF parts. + -- If condition is True, then analyze the THEN statements and set + -- no expansion for ELSE and ELSIF parts. if Is_True (Expr_Value (Cond)) then Analyze_Statements (Tstm); @@ -1419,9 +1422,9 @@ package body Sem_Ch5 is -- Start of Analyze_If_Statement begin - -- Initialize exit count for else statements. If there is no else - -- part, this count will stay non-zero reflecting the fact that the - -- uncovered else case is an unblocked exit. + -- Initialize exit count for else statements. If there is no else part, + -- this count will stay non-zero reflecting the fact that the uncovered + -- else case is an unblocked exit. Unblocked_Exit_Count := 1; Analyze_Cond_Then (N); @@ -1481,9 +1484,8 @@ package body Sem_Ch5 is -- Analyze_Implicit_Label_Declaration -- ---------------------------------------- - -- An implicit label declaration is generated in the innermost - -- enclosing declarative part. This is done for labels as well as - -- block and loop names. + -- An implicit label declaration is generated in the innermost enclosing + -- declarative part. This is done for labels, and block and loop names. -- Note: any changes in this routine may need to be reflected in -- Analyze_Label_Entity. @@ -1517,6 +1519,12 @@ package body Sem_Ch5 is -- to capture the bounds, so that the function result can be finalized -- in timely fashion. + function Has_Call_Using_Secondary_Stack (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 + -- is found, and False otherwise. + -------------------- -- Process_Bounds -- -------------------- @@ -1571,8 +1579,6 @@ package body Sem_Ch5 is Analyze_And_Resolve (Original_Bound, Typ); - Id := Make_Temporary (Loc, 'S', Original_Bound); - -- Normally, the best approach is simply to generate a constant -- declaration that captures the bound. However, there is a nasty -- case where this is wrong. If the bound is complex, and has a @@ -1584,33 +1590,13 @@ package body Sem_Ch5 is -- proper trace of the value, useful in optimizations that get rid -- of junk range checks. - -- Probably we want something like the Side_Effect_Free routine - -- in Exp_Util, but for now, we just optimize the cases of 'Last - -- and 'First applied to an entity, since these are the important - -- cases for range check optimizations. - - if Nkind (Original_Bound) = N_Attribute_Reference - and then (Attribute_Name (Original_Bound) = Name_First - or else - Attribute_Name (Original_Bound) = Name_Last) - and then Is_Entity_Name (Prefix (Original_Bound)) - then - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Id, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Typ, Loc), - Expression => Relocate_Node (Original_Bound)); - - -- Insert declaration at proper place. If loop comes from an - -- enclosing quantified expression, the insertion point is - -- arbitrarily far up in the tree. - - Insert_Action (Parent (N), Decl); - Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc)); - return Expression (Decl); + if not Has_Call_Using_Secondary_Stack (N) then + Force_Evaluation (Original_Bound); + return Original_Bound; end if; + Id := Make_Temporary (Loc, 'R', Original_Bound); + -- Here we make a declaration with a separate assignment -- statement, and insert before loop header. @@ -1624,6 +1610,14 @@ package body Sem_Ch5 is Name => New_Occurrence_Of (Id, Loc), Expression => Relocate_Node (Original_Bound)); + -- We must recursively clean in the relocated expression the flag + -- analyzed to ensure that the expression is reanalyzed. Required + -- to ensure that the transient scope is established now (because + -- Establish_Transient_Scope discarded generating transient scopes + -- in the analysis of the iteration scheme). + + Reset_Analyzed_Flags (Expression (Assign)); + Insert_Actions (Parent (N), New_List (Decl, Assign)); Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc)); @@ -1638,11 +1632,11 @@ package body Sem_Ch5 is -- Start of processing for Process_Bounds begin - -- Determine expected type of range by analyzing separate copy - -- Do the analysis and resolution of the copy of the bounds with - -- expansion disabled, to prevent the generation of finalization - -- actions on each bound. This prevents memory leaks when the - -- bounds contain calls to functions returning controlled arrays. + -- Determine expected type of range by analyzing separate copy Do the + -- analysis and resolution of the copy of the bounds with expansion + -- disabled, to prevent the generation of finalization actions on + -- each bound. This prevents memory leaks when the bounds contain + -- calls to functions returning controlled arrays. Set_Parent (R_Copy, Parent (R)); Save_Analysis := Full_Analysis; @@ -1699,11 +1693,10 @@ package body Sem_Ch5 is Typ := Etype (R_Copy); - -- If the type of the discrete range is Universal_Integer, then - -- the bound's type must be resolved to Integer, and any object - -- used to hold the bound must also have type Integer, unless the - -- literal bounds are constant-folded expressions that carry a user- - -- defined type. + -- If the type of the discrete range is Universal_Integer, then the + -- bound's type must be resolved to Integer, and any object used to + -- hold the bound must also have type Integer, unless the literal + -- bounds are constant-folded expressions with a user-defined type. if Typ = Universal_Integer then if Nkind (Lo) = N_Integer_Literal @@ -1789,12 +1782,70 @@ package body Sem_Ch5 is end if; end Check_Controlled_Array_Attribute; + ------------------------------------ + -- Has_Call_Using_Secondary_Stack -- + ------------------------------------ + + function Has_Call_Using_Secondary_Stack (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 + + ---------------- + -- Check_Call -- + ---------------- + + function Check_Call (N : Node_Id) return Traverse_Result is + Nam : Node_Id; + Subp : Entity_Id; + Return_Typ : Entity_Id; + + begin + if Nkind (N) = N_Function_Call then + Nam := Name (N); + + -- Call using access to subprogram with explicit dereference + + if Nkind (Nam) = N_Explicit_Dereference then + Subp := Etype (Nam); + + -- Normal case + + else + Subp := Entity (Nam); + end if; + + Return_Typ := Etype (Subp); + + if Is_Composite_Type (Return_Typ) + and then not Is_Constrained (Return_Typ) + then + return Abandon; + + elsif Sec_Stack_Needed_For_Return (Subp) then + return Abandon; + end if; + end if; + + -- Continue traversing the tree + + return OK; + end Check_Call; + + function Check_Calls is new Traverse_Func (Check_Call); + + -- Start of processing for Has_Call_Using_Secondary_Stack + + begin + return Check_Calls (N) = Abandon; + end Has_Call_Using_Secondary_Stack; + -- Start of processing for Analyze_Iteration_Scheme begin - -- If this is a rewritten quantified expression, the iteration - -- scheme has been analyzed already. Do no repeat analysis because - -- the loop variable is already declared. + -- If this is a rewritten quantified expression, the iteration scheme + -- has been analyzed already. Do no repeat analysis because the loop + -- variable is already declared. if Analyzed (N) then return; @@ -1812,8 +1863,8 @@ package body Sem_Ch5 is Cond : constant Node_Id := Condition (N); begin - -- For WHILE loop, verify that the condition is a Boolean - -- expression and resolve and check it. + -- For WHILE loop, verify that the condition is a Boolean expression + -- and resolve and check it. if Present (Cond) then Analyze_And_Resolve (Cond, Any_Boolean); @@ -1835,8 +1886,8 @@ package body Sem_Ch5 is begin Enter_Name (Id); - -- We always consider the loop variable to be referenced, - -- since the loop may be used just for counting purposes. + -- We always consider the loop variable to be referenced, since + -- the loop may be used just for counting purposes. Generate_Reference (Id, N, ' '); @@ -2000,8 +2051,8 @@ package body Sem_Ch5 is if not Inside_A_Generic and then not In_Instance then - -- Specialize msg if invalid values could make - -- the loop non-null after all. + -- Specialize msg if invalid values could make the + -- loop non-null after all. if Compile_Time_Compare (L, H, Assume_Valid => False) = GT @@ -2010,9 +2061,9 @@ package body Sem_Ch5 is ("?loop range is null, loop will not execute", DS); - -- Since we know the range of the loop is - -- null, set the appropriate flag to remove - -- the loop entirely during expansion. + -- Since we know the range of the loop is null, + -- set the appropriate flag to remove the loop + -- entirely during expansion. Set_Is_Null_Loop (Parent (N)); @@ -2179,8 +2230,8 @@ package body Sem_Ch5 is begin if Present (Id) then - -- Make name visible, e.g. for use in exit statements. Loop - -- labels are always considered to be referenced. + -- Make name visible, e.g. for use in exit statements. Loop labels + -- are always considered to be referenced. Analyze (Id); Ent := Entity (Id); @@ -2227,10 +2278,10 @@ package body Sem_Ch5 is Set_Parent (Ent, Loop_Statement); end if; - -- Kill current values on entry to loop, since statements in body of - -- loop may have been executed before the loop is entered. Similarly we - -- kill values after the loop, since we do not know that the body of the - -- loop was executed. + -- Kill current values on entry to loop, since statements in the body of + -- the loop may have been executed before the loop is entered. Similarly + -- we kill values after the loop, since we do not know that the body of + -- the loop was executed. Kill_Current_Values; Push_Scope (Ent); @@ -2251,8 +2302,8 @@ package body Sem_Ch5 is Check_Infinite_Loop_Warning (N); end if; - -- Code after loop is unreachable if the loop has no WHILE or FOR - -- and contains no EXIT statements within the body of the loop. + -- Code after loop is unreachable if the loop has no WHILE or FOR and + -- contains no EXIT statements within the body of the loop. if No (Iter) and then not Has_Exit (Ent) then Check_Unreachable_Code (N); @@ -2282,9 +2333,9 @@ package body Sem_Ch5 is begin -- The labels declared in the statement list are reachable from - -- statements in the list. We do this as a prepass so that any - -- goto statement will be properly flagged if its target is not - -- reachable. This is not required, but is nice behavior! + -- statements in the list. We do this as a prepass so that any goto + -- statement will be properly flagged if its target is not reachable. + -- This is not required, but is nice behavior! S := First (L); while Present (S) loop @@ -2331,10 +2382,9 @@ package body Sem_Ch5 is Conditional_Statements_End; - -- Make labels unreachable. Visibility is not sufficient, because - -- labels in one if-branch for example are not reachable from the - -- other branch, even though their declarations are in the enclosing - -- declarative part. + -- Make labels unreachable. Visibility is not sufficient, because labels + -- in one if-branch for example are not reachable from the other branch, + -- even though their declarations are in the enclosing declarative part. S := First (L); while Present (S) loop @@ -2365,9 +2415,8 @@ package body Sem_Ch5 is Nxt := Original_Node (Next (N)); -- If a label follows us, then we never have dead code, since - -- someone could branch to the label, so we just ignore it, - -- unless we are in formal mode where goto statements are not - -- allowed. + -- someone could branch to the label, so we just ignore it, unless + -- we are in formal mode where goto statements are not allowed. if Nkind (Nxt) = N_Label and then not Formal_Verification_Mode then return; @@ -2433,10 +2482,10 @@ package body Sem_Ch5 is end if; end if; - -- If the unconditional transfer of control instruction is - -- the last statement of a sequence, then see if our parent - -- is one of the constructs for which we count unblocked exits, - -- and if so, adjust the count. + -- If the unconditional transfer of control instruction is the + -- last statement of a sequence, then see if our parent is one of + -- the constructs for which we count unblocked exits, and if so, + -- adjust the count. else P := Parent (N); -- 2.30.2