From e8427749a9c5ad6ec2c0653dcc4edea5b41efc31 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 17 Jul 2018 08:06:09 +0000 Subject: [PATCH] [Ada] Secondary stack leak in loop iterator When the evaluation of the loop iterator invokes a function whose result relies on the secondary stack the compiler does not generate code to release the consumed memory as soon as the loop terminates. After this patch the following test works fine. with Text_IO; use Text_IO; pragma Warnings (Off); with System.Secondary_Stack; pragma Warnings (On); procedure Sec_Stack_Leak is function F (X : String) return Integer is begin return 10; end F; function G (X : Integer) return String is begin return (1 .. X => 'x'); end G; procedure Info is new System.Secondary_Stack.Ss_Info (Put_Line); procedure Nest is begin for I in Integer range 1 .. 100 loop for J in Integer range 1 .. F (G (10_000)) loop null; end loop; Info; end loop; Info; end Nest; begin Info; Nest; Info; end Sec_Stack_Leak; Commands: gnatmake -q sec_stack_leak.adb sec_stack_leak | grep "Current allocated space :" | uniq Output: Current allocated space : 0 bytes 2018-07-17 Javier Miranda gcc/ada/ * sem_ch5.adb (Has_Call_Using_Secondary_Stack): Moved to library level to reuse it. (Analyze_Loop_Statement): Wrap the loop in a block when the evaluation of the loop iterator relies on the secondary stack. From-SVN: r262774 --- gcc/ada/ChangeLog | 7 ++ gcc/ada/sem_ch5.adb | 180 ++++++++++++++++++++++++++++---------------- 2 files changed, 122 insertions(+), 65 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2be7d3be5df..db369ccbada 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-07-17 Javier Miranda + + * sem_ch5.adb (Has_Call_Using_Secondary_Stack): Moved to library level + to reuse it. + (Analyze_Loop_Statement): Wrap the loop in a block when the evaluation + of the loop iterator relies on the secondary stack. + 2018-07-17 Piotr Trojanek * sem_util.adb (Next_Actual): If the parent is a N_Null_Statement, diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 3ce57ea3d4b..ad592fb42c2 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -83,6 +83,12 @@ 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; + -- 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. + procedure Preanalyze_Range (R_Copy : Node_Id); -- Determine expected type of range or domain of iteration of Ada 2012 -- loop by analyzing separate copy. Do the analysis and resolution of the @@ -2692,12 +2698,6 @@ package body Sem_Ch5 is -- forms. In this case it is not sufficent to check the static predicate -- function only, look for a dynamic predicate aspect as well. - 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. - procedure Process_Bounds (R : Node_Id); -- If the iteration is given by a range, create temporaries and -- assignment statements block to capture the bounds and perform @@ -2782,65 +2782,6 @@ package body Sem_Ch5 is end if; end Check_Predicate_Use; - ------------------------------------ - -- 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; - Typ : Entity_Id; - - begin - if Nkind (N) = N_Function_Call then - Nam := Name (N); - - -- Obtain the subprogram being invoked - - loop - if Nkind (Nam) = N_Explicit_Dereference then - Nam := Prefix (Nam); - - elsif Nkind (Nam) = N_Selected_Component then - Nam := Selector_Name (Nam); - - else - exit; - end if; - end loop; - - Subp := Entity (Nam); - Typ := Etype (Subp); - - if Requires_Transient_Scope (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; - -------------------- -- Process_Bounds -- -------------------- @@ -3644,6 +3585,56 @@ package body Sem_Ch5 is 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_Nod : Node_Id; + Block_Id : Entity_Id; + HB : Node_Id; + LB : Node_Id; + + 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; + end if; + -- 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 @@ -4072,6 +4063,65 @@ package body Sem_Ch5 is end if; end Check_Unreachable_Code; + ------------------------------------ + -- 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; + Typ : Entity_Id; + + begin + if Nkind (N) = N_Function_Call then + Nam := Name (N); + + -- Obtain the subprogram being invoked + + loop + if Nkind (Nam) = N_Explicit_Dereference then + Nam := Prefix (Nam); + + elsif Nkind (Nam) = N_Selected_Component then + Nam := Selector_Name (Nam); + + else + exit; + end if; + end loop; + + Subp := Entity (Nam); + Typ := Etype (Subp); + + if Requires_Transient_Scope (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; + ---------------------- -- Preanalyze_Range -- ---------------------- -- 2.30.2