Patchwork [Ada] Missing deallocation of subpool

Oct. 5, 2012, 2:21 p.m.

This patch ensures that Deallocate_Subpool is invoked on each subpool when the
owner pool_with_subpools is finalized.

------------
-- Source --
------------

--  gc_spool.ads

with System.Storage_Pools.Subpools;
private with System.Storage_Elements;

package GC_SPool is
   use System;
   use System.Storage_Pools.Subpools;

   type Store is new Root_Storage_Pool_With_Subpools with private;
   subtype Substore_Handle is System.Storage_Pools.Subpools.Subpool_Handle;

   overriding function Create_Subpool
     (Pool : in out Store) return not null Substore_Handle;
   overriding procedure Deallocate_Subpool
     (Pool    : in out Store;
      Subpool : in out Substore_Handle);

private
   use System.Storage_Elements;

   type Substore is new Root_Subpool with null record;
   type Substore_Access is access all Substore;

   type Store is new Root_Storage_Pool_With_Subpools with record
      Default, S : Substore_Access;
   end record;

   overriding procedure Initialize (Pool : in out Store);
   overriding procedure Allocate_From_Subpool
     (Pool            : in out Store;
      Storage_Address : out System.Address;
      Size            : Storage_Count;
      Alignment       : Storage_Count;
      Subpool         : not null Substore_Handle);
   overriding function Default_Subpool_For_Pool
     (Pool : Store) return not null Substore_Handle;
end GC_SPool;

--  gc_spool.adb

with Ada.Text_IO;

package body GC_SPool is
   use Ada;
   type Handle is access all Storage_Array;

   overriding procedure Initialize (Pool : in out Store) is
   begin
      Text_IO.Put_Line ("Initialize");
      Pool.Default := new Substore;
      Storage_Pools.Subpools.Set_Pool_Of_Subpool
        (Subpool_Handle (Pool.Default), Pool);

      Pool.S := new Substore;
   end Initialize;

   overriding procedure Allocate_From_Subpool
     (Pool            : in out Store;
      Storage_Address : out System.Address;
      Size            : Storage_Count;
      Alignment       : Storage_Count;
      Subpool         : not null Substore_Handle)
   is
      H : Handle := new Storage_Array (1 .. Size);
   begin
      Text_IO.Put_Line ("Allocate from subpool : " & Size'Img);
      Storage_Address := H (1)'Address;
   end Allocate_From_Subpool;

   overriding function Create_Subpool
     (Pool : in out Store) return not null Substore_Handle
   is
      S : Substore_Handle := Pool.S.all'Unchecked_Access;
   begin
      Text_IO.Put_Line ("Create subpool");
      Storage_Pools.Subpools.Set_Pool_Of_Subpool (S, Pool);
      return S;
   end Create_Subpool;

   overriding procedure Deallocate_Subpool
     (Pool    : in out Store;
      Subpool : in out Substore_Handle) is
   begin
      Text_IO.Put_Line ("Deallocate subpool");
   end Deallocate_Subpool;

   overriding function Default_Subpool_For_Pool
     (Pool : Store) return not null Substore_Handle is
   begin
      Text_IO.Put_Line ("Default subpool for pool");
      return Pool.Default.all'Unchecked_Access;
   end Default_Subpool_For_Pool;
end GC_SPool;

--  tpool.adb

with Ada.Text_IO;
with GC_SPool;

procedure Tpool is
   use Ada;
   pragma Default_Storage_Pool (null);

   package Pool renames GC_SPool;
   GCP : Pool.Store;

   type R is record
      A, B, C : Integer;
   end record;

   type AR is access all R;
   for AR'Storage_Pool use GCP;

   GCSP : Pool.Substore_Handle := Pool.Create_Subpool (GCP);
   O1 : AR := new (GCSP) R'(8, 7, 8);

begin
   Text_IO.Put_Line ("Start Tpool");
end Tpool;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q -gnat12 tpool.adb
$ ./tpool
Initialize
Create subpool
Allocate from subpool :  12
Start Tpool
Deallocate subpool
Deallocate subpool

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-spsufi.adb: Add with clause for Ada.Unchecked_Deallocation.
	Add with and use clauses for System.Finalization_Masters.
	(Finalize_And_Deallocate): Add an instance of
	Ada.Unchecked_Deallocation. Merge the code from the now obsolete
	Finalize_Subpool into this routine.
	* s-spsufi.ads: Add pragma Preelaborate.
	* s-stposu.adb: Remove with clause for
	Ada.Unchecked_Deallocation; Add with and use clauses for
	System.Storage_Pools.Subpools.Finalization; (Finalize_Pool):
	Update the comment on all actions takes with respect to a subpool
	finalization. Finalize and deallocate each individual subpool.
	(Finalize_Subpool): Removed.
	(Free): Removed;
	(Detach): Move from package body to spec.
	* s-stposu.ads (Detach): Move from package body to spec.
	(Finalize_Subpool): Removed.

Submitter	Arnaud Charlet
Date	Oct. 5, 2012, 2:21 p.m.
Message ID	<20121005142144.GA5829@adacore.com>
Download	mbox \| patch
Permalink	/patch/189488/
State	New
Headers	show Return-Path: <gcc-patches-return-328192-incoming=patchwork.ozlabs.org@gcc.gnu.org> Comment: DKIM? See http://www.dkim.org Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=NK/w94kvecjXjq1zMCIA/VNUXHZ/CI16P4swGwWVD/sjQ5rp/njYy+N0WDIS/x YdcbAtDUzafmEGZWyP4JdqC/iXGyK8DXdC0kF9xGWZulznNeiI2x/jR7BYAz1lPM vq29Z0irczcPkEKSqbydCchZ24XqAp+79u4C4ISSdW6hU=; Date: Fri, 5 Oct 2012 10:21:45 -0400 From: Arnaud Charlet <charlet@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev <kirtchev@adacore.com> Subject: [Ada] Missing deallocation of subpool Message-ID: <20121005142144.GA5829@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="8t9RHnE3ZwKMSgU+" Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org

Patchwork [Ada] Missing deallocation of subpool

Comments

Patch