===================================================================
@@ -31,12 +31,13 @@
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
-with Ada.Unchecked_Deallocation;
with System.Address_Image;
with System.Finalization_Masters; use System.Finalization_Masters;
with System.IO; use System.IO;
with System.Soft_Links; use System.Soft_Links;
with System.Storage_Elements; use System.Storage_Elements;
+with System.Storage_Pools.Subpools.Finalization;
+use System.Storage_Pools.Subpools.Finalization;
package body System.Storage_Pools.Subpools is
@@ -51,11 +52,6 @@
procedure Attach (N : not null SP_Node_Ptr; L : not null SP_Node_Ptr);
-- Attach a subpool node to a pool
- procedure Free is new Ada.Unchecked_Deallocation (SP_Node, SP_Node_Ptr);
-
- procedure Detach (N : not null SP_Node_Ptr);
- -- Unhook a subpool node from an arbitrary subpool list
-
-----------------------------------
-- Adjust_Controlled_Dereference --
-----------------------------------
@@ -544,9 +540,10 @@
-- 2) Remove the the subpool from the owner's list of subpools
-- 3) Deallocate the doubly linked list node associated with the
-- subpool.
+ -- 4) Call Deallocate_Subpool
begin
- Finalize_Subpool (Curr_Ptr.Subpool);
+ Finalize_And_Deallocate (Curr_Ptr.Subpool);
exception
when Fin_Occur : others =>
@@ -565,32 +562,6 @@
end if;
end Finalize_Pool;
- ----------------------
- -- Finalize_Subpool --
- ----------------------
-
- procedure Finalize_Subpool (Subpool : not null Subpool_Handle) is
- begin
- -- Do nothing if the subpool was never used
-
- if Subpool.Owner = null or else Subpool.Node = null then
- return;
- end if;
-
- -- Clean up all controlled objects chained on the subpool's master
-
- Finalize (Subpool.Master);
-
- -- Remove the subpool from its owner's list of subpools
-
- Detach (Subpool.Node);
-
- -- Destroy the associated doubly linked list node which was created in
- -- Set_Pool_Of_Subpool.
-
- Free (Subpool.Node);
- end Finalize_Subpool;
-
------------------------------
-- Header_Size_With_Padding --
------------------------------
===================================================================
@@ -325,6 +325,9 @@
-- is controlled. When set to True, the machinery generates additional
-- data.
+ procedure Detach (N : not null SP_Node_Ptr);
+ -- Unhook a subpool node from an arbitrary subpool list
+
overriding procedure Finalize (Controller : in out Pool_Controller);
-- Buffer routine, calls Finalize_Pool
@@ -333,11 +336,6 @@
-- their masters. This action first detaches a controlled object from a
-- particular master, then invokes its Finalize_Address primitive.
- procedure Finalize_Subpool (Subpool : not null Subpool_Handle);
- -- Finalize all controlled objects chained on Subpool's master. Remove the
- -- subpool from its owner's list. Deallocate the associated doubly linked
- -- list node.
-
function Header_Size_With_Padding
(Alignment : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count;
===================================================================
@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -30,6 +30,9 @@
-- --
------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with System.Finalization_Masters; use System.Finalization_Masters;
+
package body System.Storage_Pools.Subpools.Finalization is
-----------------------------
@@ -37,6 +40,8 @@
-----------------------------
procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle) is
+ procedure Free is new Ada.Unchecked_Deallocation (SP_Node, SP_Node_Ptr);
+
begin
-- Do nothing if the subpool was never created or never used. The latter
-- case may arise with an array of subpool implementations.
@@ -48,10 +53,19 @@
return;
end if;
- -- Clean up all controlled objects allocated through the subpool
+ -- Clean up all controlled objects chained on the subpool's master
- Finalize_Subpool (Subpool);
+ Finalize (Subpool.Master);
+ -- Remove the subpool from its owner's list of subpools
+
+ Detach (Subpool.Node);
+
+ -- Destroy the associated doubly linked list node which was created in
+ -- Set_Pool_Of_Subpools.
+
+ Free (Subpool.Node);
+
-- Dispatch to the user-defined implementation of Deallocate_Subpool
Deallocate_Subpool (Pool_Of_Subpool (Subpool).all, Subpool);
===================================================================
@@ -7,7 +7,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -33,6 +33,7 @@
pragma Compiler_Unit;
package System.Storage_Pools.Subpools.Finalization is
+ pragma Preelaborate;
procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle);
-- This routine performs the following actions: