From patchwork Thu May 24 13:07:08 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 919833 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-478381-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="A+MZPROI"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 40s8n35mWqz9ryk for ; Thu, 24 May 2018 23:07:35 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=uQbsf2kna35sBZkDVQFplbNoGNh2A+zIi8w+izQyNHi+UU+Hjt X2DUUhMkynzm19VvSTs0PjRwoecrTE9U8ID9Xzd2e6oNBEFi7NIfmwBLz36ZyB7x gAdnjZUuX4Tw6+kn8+Bkecr7ShtOZZDbZd8PDnE/w1614ttisJ0qx8mfk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=t6+aBS1ilMUUyUGs8sTX3pkeTDc=; b=A+MZPROIKh6pVdZmcLek IR9/HRgaWbqx5URM7F0lSGBU6MzVxZWKUWJFV4TlYl8PlgzkH5pJUK0b2Rvhemkk qiELdaj4iwKjRRVZavSX1Xn1/HNdBN+79/2Cyg4dpY0mHmPOn47iNnClT56nRlZC KHBIEeYkkyRfSMkd5zvqVzw= Received: (qmail 60835 invoked by alias); 24 May 2018 13:07:17 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 60716 invoked by uid 89); 24 May 2018 13:07:17 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=sk:Create_, build-in-place, buildinplace, sk:Return_ X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 24 May 2018 13:07:10 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B13A0117EEB; Thu, 24 May 2018 09:07:08 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id tt8YT2cEQ+78; Thu, 24 May 2018 09:07:08 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 9F54C117D97; Thu, 24 May 2018 09:07:08 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 9E3D34C2; Thu, 24 May 2018 09:07:08 -0400 (EDT) Date: Thu, 24 May 2018 09:07:08 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Memory leak mixing limited and nonlimited functions Message-ID: <20180524130708.GA91331@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes 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 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. --- gcc/ada/exp_ch7.adb +++ gcc/ada/exp_ch7.adb @@ -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));