1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . S T O R A G E _ P O O L S . S U B P O O L S --
9 -- Copyright (C) 2011, Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
22 -- As a special exception under Section 7 of GPL version 3, you are granted --
23 -- additional permissions described in the GCC Runtime Library Exception, --
24 -- version 3.1, as published by the Free Software Foundation. --
26 -- You should have received a copy of the GNU General Public License and --
27 -- a copy of the GCC Runtime Library Exception along with this program; --
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
29 -- <http://www.gnu.org/licenses/>. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
34 ------------------------------------------------------------------------------
36 with Ada.Finalization;
37 with System.Finalization_Masters;
38 with System.Storage_Elements;
40 package System.Storage_Pools.Subpools is
43 type Root_Storage_Pool_With_Subpools is abstract
44 new Root_Storage_Pool with private;
45 -- The base for all implementations of Storage_Pool_With_Subpools. This
46 -- type is Limited_Controlled by derivation. To use subpools, an access
47 -- type must be associated with an implementation descending from type
48 -- Root_Storage_Pool_With_Subpools.
50 type Root_Subpool is abstract tagged limited private;
51 -- The base for all implementations of Subpool. Objects of this type are
52 -- managed by the pool_with_subpools.
54 type Subpool_Handle is access all Root_Subpool'Class;
55 for Subpool_Handle'Storage_Size use 0;
56 -- Since subpools are limited types by definition, a handle is instead used
57 -- to manage subpool abstractions.
59 overriding procedure Allocate
60 (Pool : in out Root_Storage_Pool_With_Subpools;
61 Storage_Address : out System.Address;
62 Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
63 Alignment : System.Storage_Elements.Storage_Count);
64 -- Allocate an object described by Size_In_Storage_Elements and Alignment
65 -- on the default subpool of Pool. Controlled types allocated through this
66 -- routine will NOT be handled properly.
68 procedure Allocate_From_Subpool
69 (Pool : in out Root_Storage_Pool_With_Subpools;
70 Storage_Address : out System.Address;
71 Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
72 Alignment : System.Storage_Elements.Storage_Count;
73 Subpool : not null Subpool_Handle)
76 -- ??? This precondition causes errors in simple tests, disabled for now
78 -- with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
79 -- This routine requires implementation. Allocate an object described by
80 -- Size_In_Storage_Elements and Alignment on a subpool.
82 function Create_Subpool
83 (Pool : in out Root_Storage_Pool_With_Subpools;
84 Storage_Size : Storage_Elements.Storage_Count :=
85 Storage_Elements.Storage_Count'Last)
86 return not null Subpool_Handle
88 -- This routine requires implementation. Create a subpool within the given
89 -- pool_with_subpools.
91 overriding procedure Deallocate
92 (Pool : in out Root_Storage_Pool_With_Subpools;
93 Storage_Address : System.Address;
94 Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
95 Alignment : System.Storage_Elements.Storage_Count)
98 procedure Deallocate_Subpool
99 (Pool : in out Root_Storage_Pool_With_Subpools;
100 Subpool : in out Subpool_Handle)
103 -- ??? This precondition causes errors in simple tests, disabled for now
105 -- with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
106 -- This routine requires implementation. Reclaim the storage a particular
107 -- subpool occupies in a pool_with_subpools. This routine is called by
108 -- Ada.Unchecked_Deallocate_Subpool.
110 function Default_Subpool_For_Pool
111 (Pool : Root_Storage_Pool_With_Subpools)
112 return not null Subpool_Handle
114 -- This routine requires implementation. Returns a common subpool used for
115 -- allocations without Subpool_Handle_name in the allocator.
117 function Pool_Of_Subpool
118 (Subpool : not null Subpool_Handle)
119 return access Root_Storage_Pool_With_Subpools'Class;
120 -- Return the owner of the subpool
122 procedure Set_Pool_Of_Subpool
123 (Subpool : not null Subpool_Handle;
124 Pool : in out Root_Storage_Pool_With_Subpools'Class);
125 -- Set the owner of the subpool. This is intended to be called from
126 -- Create_Subpool or similar subpool constructors. Raises Program_Error
127 -- if the subpool already belongs to a pool.
131 -- Pool_With_Subpools SP_Node SP_Node SP_Node
132 -- +-->+--------------------+ +-----+ +-----+ +-----+
133 -- | | Subpools -------->| ------->| ------->| ------->
134 -- | +--------------------+ +-----+ +-----+ +-----+
135 -- | |Finalization_Started|<------ |<------- |<------- |<---
136 -- | +--------------------+ +-----+ +-----+ +-----+
137 -- +--- Controller.Encl_Pool| | nul | | + | | + |
138 -- | +--------------------+ +-----+ +--|--+ +--:--+
141 -- | Root_Subpool V |
142 -- | +-------------+ |
143 -- +-------------------------------- Owner | |
144 -- FM_Node FM_Node +-------------+ |
145 -- +-----+ +-----+<-- Master.Objects| |
146 -- <------ |<------ | +-------------+ |
147 -- +-----+ +-----+ | Node -------+
148 -- | ------>| -----> +-------------+
149 -- +-----+ +-----+ : :
154 -- SP_Nodes are created on the heap. FM_Nodes and associated objects are
155 -- created on the pool_with_subpools.
157 type Any_Storage_Pool_With_Subpools_Ptr
158 is access all Root_Storage_Pool_With_Subpools'Class;
159 for Any_Storage_Pool_With_Subpools_Ptr'Storage_Size use 0;
161 -- A pool controller is a special controlled object which ensures the
162 -- proper initialization and finalization of the enclosing pool.
164 type Pool_Controller (Enclosing_Pool : Any_Storage_Pool_With_Subpools_Ptr)
165 is new Ada.Finalization.Limited_Controlled with null record;
167 -- Subpool list types. Each pool_with_subpools contains a list of subpools.
168 -- This is an indirect doubly linked list since subpools are not supposed
169 -- to be allocatable by language design.
172 type SP_Node_Ptr is access all SP_Node;
174 type SP_Node is record
175 Prev : SP_Node_Ptr := null;
176 Next : SP_Node_Ptr := null;
177 Subpool : Subpool_Handle := null;
180 -- Root_Storage_Pool_With_Subpools internal structure. The type uses a
181 -- special controller to perform initialization and finalization actions
182 -- on itself. This is necessary because the end user of this package may
183 -- decide to override Initialize and Finalize, thus disabling the desired
186 -- Pool_With_Subpools SP_Node SP_Node SP_Node
187 -- +-->+--------------------+ +-----+ +-----+ +-----+
188 -- | | Subpools -------->| ------->| ------->| ------->
189 -- | +--------------------+ +-----+ +-----+ +-----+
190 -- | |Finalization_Started| : : : : : :
191 -- | +--------------------+
192 -- +--- Controller.Encl_Pool|
193 -- +--------------------+
197 type Root_Storage_Pool_With_Subpools is abstract
198 new Root_Storage_Pool with
200 Subpools : aliased SP_Node;
201 -- A doubly linked list of subpools
203 Finalization_Started : Boolean := False;
204 pragma Atomic (Finalization_Started);
205 -- A flag which prevents the creation of new subpools while the master
206 -- pool is being finalized. The flag needs to be atomic because it is
207 -- accessed without Lock_Task / Unlock_Task.
209 Controller : Pool_Controller
210 (Root_Storage_Pool_With_Subpools'Unchecked_Access);
211 -- A component which ensures that the enclosing pool is initialized and
212 -- finalized at the appropriate places.
215 -- A subpool is an abstraction layer which sits on top of a pool. It
216 -- contains links to all controlled objects allocated on a particular
219 -- Pool_With_Subpools SP_Node SP_Node SP_Node
220 -- +-->+----------------+ +-----+ +-----+ +-----+
221 -- | | Subpools ------>| ------->| ------->| ------->
222 -- | +----------------+ +-----+ +-----+ +-----+
223 -- | : :<------ |<------- |<------- |
224 -- | : : +-----+ +-----+ +-----+
225 -- | |null | | + | | + |
226 -- | +-----+ +--|--+ +--:--+
228 -- | Root_Subpool V |
229 -- | +-------------+ |
230 -- +---------------------------- Owner | |
232 -- .......... Master | |
239 type Root_Subpool is abstract tagged limited record
240 Owner : Any_Storage_Pool_With_Subpools_Ptr := null;
241 -- A reference to the master pool_with_subpools
243 Master : aliased System.Finalization_Masters.Finalization_Master;
244 -- A heterogeneous collection of controlled objects
246 Node : SP_Node_Ptr := null;
247 -- A link to the doubly linked list node which contains the subpool.
248 -- This back pointer is used in subpool deallocation.
251 -- ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed
254 procedure Allocate_Any_Controlled
255 (Pool : in out Root_Storage_Pool'Class;
256 Context_Subpool : Subpool_Handle;
257 Context_Master : Finalization_Masters.Finalization_Master_Ptr;
258 Fin_Address : Finalization_Masters.Finalize_Address_Ptr;
259 Addr : out System.Address;
260 Storage_Size : System.Storage_Elements.Storage_Count;
261 Alignment : System.Storage_Elements.Storage_Count;
262 Is_Controlled : Boolean;
263 On_Subpool : Boolean);
264 -- Compiler interface. This version of Allocate handles all possible cases,
265 -- either on a pool or a pool_with_subpools, regardless of the controlled
266 -- status of the allocated object. Parameter usage:
268 -- * Pool - The pool associated with the access type. Pool can be any
269 -- derivation from Root_Storage_Pool, including a pool_with_subpools.
271 -- * Context_Subpool - The subpool handle name of an allocator. If no
272 -- subpool handle is present at the point of allocation, the actual
275 -- * Context_Master - The finalization master associated with the access
276 -- type. If the access type's designated type is not controlled, the
277 -- actual would be null.
279 -- * Fin_Address - TSS routine Finalize_Address of the designated type.
280 -- If the designated type is not controlled, the actual would be null.
282 -- * Addr - The address of the allocated object.
284 -- * Storage_Size - The size of the allocated object.
286 -- * Alignment - The alignment of the allocated object.
288 -- * Is_Controlled - A flag which determines whether the allocated object
289 -- is controlled. When set to True, the machinery generates additional
292 -- * On_Subpool - A flag which determines whether the a subpool handle
293 -- name is present at the point of allocation. This is used for error
296 procedure Deallocate_Any_Controlled
297 (Pool : in out Root_Storage_Pool'Class;
298 Addr : System.Address;
299 Storage_Size : System.Storage_Elements.Storage_Count;
300 Alignment : System.Storage_Elements.Storage_Count;
301 Is_Controlled : Boolean);
302 -- Compiler interface. This version of Deallocate handles all possible
303 -- cases, either from a pool or a pool_with_subpools, regardless of the
304 -- controlled status of the deallocated object. Parameter usage:
306 -- * Pool - The pool associated with the access type. Pool can be any
307 -- derivation from Root_Storage_Pool, including a pool_with_subpools.
309 -- * Addr - The address of the allocated object.
311 -- * Storage_Size - The size of the allocated object.
313 -- * Alignment - The alignment of the allocated object.
315 -- * Is_Controlled - A flag which determines whether the allocated object
316 -- is controlled. When set to True, the machinery generates additional
319 overriding procedure Finalize (Controller : in out Pool_Controller);
320 -- Buffer routine, calls Finalize_Pool
322 procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
323 -- Iterate over all subpools of Pool, detach them one by one and finalize
324 -- their masters. This action first detaches a controlled object from a
325 -- particular master, then invokes its Finalize_Address primitive.
327 procedure Finalize_Subpool (Subpool : not null Subpool_Handle);
328 -- Finalize all controlled objects chained on Subpool's master. Remove the
329 -- subpool from its owner's list. Deallocate the associated doubly linked
332 overriding procedure Initialize (Controller : in out Pool_Controller);
333 -- Buffer routine, calls Initialize_Pool
335 procedure Initialize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
336 -- Setup the doubly linked list of subpools
338 procedure Print_Pool (Pool : Root_Storage_Pool_With_Subpools);
339 -- Debug routine, output the contents of a pool_with_subpools
341 procedure Print_Subpool (Subpool : Subpool_Handle);
342 -- Debug routine, output the contents of a subpool
344 end System.Storage_Pools.Subpools;