@@ -1777,10 +1777,49 @@ package body Exp_Ch7 is
Set_At_End_Proc (HSS, Empty);
end if;
- -- Release the secondary stack mark
+ -- Release the secondary stack
if Present (Mark_Id) then
- Append_To (Finalizer_Stmts, Build_SS_Release_Call (Loc, Mark_Id));
+ declare
+ Release : Node_Id :=
+ Build_SS_Release_Call (Loc, Mark_Id);
+ begin
+ -- If this is a build-in-place function, then we need to
+ -- release the secondary stack, unless we are returning on the
+ -- secondary stack. We wrap the release call in:
+ -- if BIP_Alloc_Form /= Secondary_Stack then ...
+ -- If we are returning on the secondary stack, then releasing
+ -- is the caller's responsibility (or caller's caller, or ...).
+
+ if Nkind (N) = N_Subprogram_Body then
+ declare
+ Spec_Id : constant Entity_Id :=
+ Unique_Defining_Entity (N);
+ BIP_SS : constant Boolean :=
+ Is_Build_In_Place_Function (Spec_Id)
+ and then Needs_BIP_Alloc_Form (Spec_Id);
+ begin
+ if BIP_SS then
+ Release :=
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
+ New_Occurrence_Of
+ (Build_In_Place_Formal
+ (Spec_Id, BIP_Alloc_Form), Loc),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ UI_From_Int (BIP_Allocation_Form'Pos
+ (Secondary_Stack)))),
+
+ Then_Statements => New_List (Release));
+ end if;
+ end;
+ end if;
+
+ Append_To (Finalizer_Stmts, Release);
+ end;
end if;
-- Protect the statements with abort defer/undefer. This is only when
@@ -4327,10 +4366,22 @@ package body Exp_Ch7 is
and then Is_Task_Allocation_Block (N);
Is_Task_Body : constant Boolean :=
Nkind (Original_Node (N)) = N_Task_Body;
+
+ -- We mark the secondary stack if it is used in this construct, and
+ -- we're not returning a function result on the secondary stack, except
+ -- that a build-in-place function that might or might not return on the
+ -- secondary stack always needs a mark. A run-time test is required in
+ -- the case where the build-in-place function has a BIP_Alloc extra
+ -- parameter (see Create_Finalizer).
+
Needs_Sec_Stack_Mark : constant Boolean :=
- Uses_Sec_Stack (Scop)
- and then
- not Sec_Stack_Needed_For_Return (Scop);
+ (Uses_Sec_Stack (Scop)
+ and then
+ not Sec_Stack_Needed_For_Return (Scop))
+ or else
+ (Is_Build_In_Place_Function (Scop)
+ and then Needs_BIP_Alloc_Form (Scop));
+
Needs_Custom_Cleanup : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Present (Cleanup_Actions (N));
This patch fixes a memory leak. If a build-in-place function with a result whose size is not known at the call site is called, and that function calls a non-build-in-place function that allocates on the secondary stack, the secondary stack was not necessarily cleaned up, which caused a memory leak. The following program should print: "Current allocated space : 0 bytes" (among other things) in the loop. ./bip_leak-main > log grep 'Current allocated' log Current allocated space : 0 bytes Current allocated space : 0 bytes Current allocated space : 0 bytes with Ada.Finalization; package BIP_Leak is subtype Limited_Controlled is Ada.Finalization.Limited_Controlled; type Nonlim_Controlled is new Ada.Finalization.Controlled with null record; type Needs_Fin is record X : Nonlim_Controlled; end record; type Lim_Controlled is new Limited_Controlled with null record; function Return_Lim_Controlled (Source : Boolean) return Lim_Controlled; procedure Dump_SS; end BIP_Leak; with Ada.Text_IO; pragma Warnings (Off); with System.Secondary_Stack; pragma Warnings (On); package body BIP_Leak is function Transform (X : Needs_Fin) return Lim_Controlled is begin return (Limited_Controlled with null record); end; function Return_Needs_Fin (I : Boolean) return Needs_Fin is THR : Needs_Fin; begin return THR; end; function Return_Lim_Controlled (Source : Boolean) return Lim_Controlled is begin return Transform (Return_Needs_Fin (Source)); end Return_Lim_Controlled; procedure Dump_SS_Instance is new System.Secondary_Stack.SS_Info (Ada.Text_IO.Put_Line); procedure Dump_SS renames Dump_SS_Instance; end BIP_Leak; procedure BIP_Leak.Main is begin for Count in 1 .. 350_000 loop declare Msg : constant Lim_Controlled := Return_Lim_Controlled (True); begin if Count mod 100_000 = 0 then Dump_SS; end if; end; end loop; end BIP_Leak.Main; Tested on x86_64-pc-linux-gnu, committed on trunk 2018-05-24 Bob Duff <duff@adacore.com> gcc/ada/ * exp_ch7.adb (Expand_Cleanup_Actions): Create a mark unconditionally for build-in-place functions with a caller-unknown-size result. (Create_Finalizer): For build-in-place functions with a caller-unknown-size result, check at run time whether we need to release the secondary stack.