File : s-stposu.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
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 --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
10 -- --
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. --
14 -- --
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. --
21 -- --
22 -- --
23 -- --
24 -- --
25 -- --
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/>. --
30 -- --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 -- --
34 ------------------------------------------------------------------------------
35
36 with Ada.Finalization;
37 with System.Finalization_Masters;
38 with System.Storage_Elements;
39
40 package System.Storage_Pools.Subpools is
41 pragma Preelaborate;
42
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.
49
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.
53
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.
58
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.
67
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) is abstract;
74
75 -- ??? This precondition causes errors in simple tests, disabled for now
76
77 -- with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
78 -- This routine requires implementation. Allocate an object described by
79 -- Size_In_Storage_Elements and Alignment on a subpool.
80
81 function Create_Subpool
82 (Pool : in out Root_Storage_Pool_With_Subpools)
83 return not null Subpool_Handle is abstract;
84 -- This routine requires implementation. Create a subpool within the given
85 -- pool_with_subpools.
86
87 overriding procedure Deallocate
88 (Pool : in out Root_Storage_Pool_With_Subpools;
89 Storage_Address : System.Address;
90 Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
91 Alignment : System.Storage_Elements.Storage_Count)
92 is null;
93
94 procedure Deallocate_Subpool
95 (Pool : in out Root_Storage_Pool_With_Subpools;
96 Subpool : in out Subpool_Handle)
97 is abstract;
98 -- This precondition causes errors in simple tests, disabled for now???
99 -- with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
100
101 -- This routine requires implementation. Reclaim the storage a particular
102 -- subpool occupies in a pool_with_subpools. This routine is called by
103 -- Ada.Unchecked_Deallocate_Subpool.
104
105 function Default_Subpool_For_Pool
106 (Pool : in out Root_Storage_Pool_With_Subpools)
107 return not null Subpool_Handle;
108 -- Return a common subpool which is used for object allocations without a
109 -- Subpool_Handle_Name in the allocator. The default implementation of this
110 -- routine raises Program_Error.
111
112 function Pool_Of_Subpool
113 (Subpool : not null Subpool_Handle)
114 return access Root_Storage_Pool_With_Subpools'Class;
115 -- Return the owner of the subpool
116
117 procedure Set_Pool_Of_Subpool
118 (Subpool : not null Subpool_Handle;
119 To : in out Root_Storage_Pool_With_Subpools'Class);
120 -- Set the owner of the subpool. This is intended to be called from
121 -- Create_Subpool or similar subpool constructors. Raises Program_Error
122 -- if the subpool already belongs to a pool.
123
124 overriding function Storage_Size
125 (Pool : Root_Storage_Pool_With_Subpools)
126 return System.Storage_Elements.Storage_Count
127 is
128 (System.Storage_Elements.Storage_Count'Last);
129
130 private
131 -- Model
132 -- Pool_With_Subpools SP_Node SP_Node SP_Node
133 -- +-->+--------------------+ +-----+ +-----+ +-----+
134 -- | | Subpools -------->| ------->| ------->| ------->
135 -- | +--------------------+ +-----+ +-----+ +-----+
136 -- | |Finalization_Started|<------ |<------- |<------- |<---
137 -- | +--------------------+ +-----+ +-----+ +-----+
138 -- +--- Controller.Encl_Pool| | nul | | + | | + |
139 -- | +--------------------+ +-----+ +--|--+ +--:--+
140 -- | : : Dummy | ^ :
141 -- | : : | | :
142 -- | Root_Subpool V |
143 -- | +-------------+ |
144 -- +-------------------------------- Owner | |
145 -- FM_Node FM_Node +-------------+ |
146 -- +-----+ +-----+<-- Master.Objects| |
147 -- <------ |<------ | +-------------+ |
148 -- +-----+ +-----+ | Node -------+
149 -- | ------>| -----> +-------------+
150 -- +-----+ +-----+ : :
151 -- |ctrl | Dummy : :
152 -- | obj |
153 -- +-----+
154 --
155 -- SP_Nodes are created on the heap. FM_Nodes and associated objects are
156 -- created on the pool_with_subpools.
157
158 type Any_Storage_Pool_With_Subpools_Ptr
159 is access all Root_Storage_Pool_With_Subpools'Class;
160 for Any_Storage_Pool_With_Subpools_Ptr'Storage_Size use 0;
161
162 -- A pool controller is a special controlled object which ensures the
163 -- proper initialization and finalization of the enclosing pool.
164
165 type Pool_Controller (Enclosing_Pool : Any_Storage_Pool_With_Subpools_Ptr)
166 is new Ada.Finalization.Limited_Controlled with null record;
167
168 -- Subpool list types. Each pool_with_subpools contains a list of subpools.
169 -- This is an indirect doubly linked list since subpools are not supposed
170 -- to be allocatable by language design.
171
172 type SP_Node;
173 type SP_Node_Ptr is access all SP_Node;
174
175 type SP_Node is record
176 Prev : SP_Node_Ptr := null;
177 Next : SP_Node_Ptr := null;
178 Subpool : Subpool_Handle := null;
179 end record;
180
181 -- Root_Storage_Pool_With_Subpools internal structure. The type uses a
182 -- special controller to perform initialization and finalization actions
183 -- on itself. This is necessary because the end user of this package may
184 -- decide to override Initialize and Finalize, thus disabling the desired
185 -- behavior.
186
187 -- Pool_With_Subpools SP_Node SP_Node SP_Node
188 -- +-->+--------------------+ +-----+ +-----+ +-----+
189 -- | | Subpools -------->| ------->| ------->| ------->
190 -- | +--------------------+ +-----+ +-----+ +-----+
191 -- | |Finalization_Started| : : : : : :
192 -- | +--------------------+
193 -- +--- Controller.Encl_Pool|
194 -- +--------------------+
195 -- : End-user :
196 -- : components :
197
198 type Root_Storage_Pool_With_Subpools is abstract
199 new Root_Storage_Pool with
200 record
201 Subpools : aliased SP_Node;
202 -- A doubly linked list of subpools
203
204 Finalization_Started : Boolean := False;
205 pragma Atomic (Finalization_Started);
206 -- A flag which prevents the creation of new subpools while the master
207 -- pool is being finalized. The flag needs to be atomic because it is
208 -- accessed without Lock_Task / Unlock_Task.
209
210 Controller : Pool_Controller
211 (Root_Storage_Pool_With_Subpools'Unchecked_Access);
212 -- A component which ensures that the enclosing pool is initialized and
213 -- finalized at the appropriate places.
214 end record;
215
216 -- A subpool is an abstraction layer which sits on top of a pool. It
217 -- contains links to all controlled objects allocated on a particular
218 -- subpool.
219
220 -- Pool_With_Subpools SP_Node SP_Node SP_Node
221 -- +-->+----------------+ +-----+ +-----+ +-----+
222 -- | | Subpools ------>| ------->| ------->| ------->
223 -- | +----------------+ +-----+ +-----+ +-----+
224 -- | : :<------ |<------- |<------- |
225 -- | : : +-----+ +-----+ +-----+
226 -- | |null | | + | | + |
227 -- | +-----+ +--|--+ +--:--+
228 -- | | ^ :
229 -- | Root_Subpool V |
230 -- | +-------------+ |
231 -- +---------------------------- Owner | |
232 -- +-------------+ |
233 -- .......... Master | |
234 -- +-------------+ |
235 -- | Node -------+
236 -- +-------------+
237 -- : End-user :
238 -- : components :
239
240 type Root_Subpool is abstract tagged limited record
241 Owner : Any_Storage_Pool_With_Subpools_Ptr := null;
242 -- A reference to the master pool_with_subpools
243
244 Master : aliased System.Finalization_Masters.Finalization_Master;
245 -- A heterogeneous collection of controlled objects
246
247 Node : SP_Node_Ptr := null;
248 -- A link to the doubly linked list node which contains the subpool.
249 -- This back pointer is used in subpool deallocation.
250 end record;
251
252 procedure Adjust_Controlled_Dereference
253 (Addr : in out System.Address;
254 Storage_Size : in out System.Storage_Elements.Storage_Count;
255 Alignment : System.Storage_Elements.Storage_Count);
256 -- Given the memory attributes of a heap-allocated object that is known to
257 -- be controlled, adjust the address and size of the object to include the
258 -- two hidden pointers inserted by the finalization machinery.
259
260 -- ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed
261 -- to Allocate_Any.
262
263 procedure Allocate_Any_Controlled
264 (Pool : in out Root_Storage_Pool'Class;
265 Context_Subpool : Subpool_Handle;
266 Context_Master : Finalization_Masters.Finalization_Master_Ptr;
267 Fin_Address : Finalization_Masters.Finalize_Address_Ptr;
268 Addr : out System.Address;
269 Storage_Size : System.Storage_Elements.Storage_Count;
270 Alignment : System.Storage_Elements.Storage_Count;
271 Is_Controlled : Boolean;
272 On_Subpool : Boolean);
273 -- Compiler interface. This version of Allocate handles all possible cases,
274 -- either on a pool or a pool_with_subpools, regardless of the controlled
275 -- status of the allocated object. Parameter usage:
276 --
277 -- * Pool - The pool associated with the access type. Pool can be any
278 -- derivation from Root_Storage_Pool, including a pool_with_subpools.
279 --
280 -- * Context_Subpool - The subpool handle name of an allocator. If no
281 -- subpool handle is present at the point of allocation, the actual
282 -- would be null.
283 --
284 -- * Context_Master - The finalization master associated with the access
285 -- type. If the access type's designated type is not controlled, the
286 -- actual would be null.
287 --
288 -- * Fin_Address - TSS routine Finalize_Address of the designated type.
289 -- If the designated type is not controlled, the actual would be null.
290 --
291 -- * Addr - The address of the allocated object.
292 --
293 -- * Storage_Size - The size of the allocated object.
294 --
295 -- * Alignment - The alignment of the allocated object.
296 --
297 -- * Is_Controlled - A flag which determines whether the allocated object
298 -- is controlled. When set to True, the machinery generates additional
299 -- data.
300 --
301 -- * On_Subpool - A flag which determines whether the a subpool handle
302 -- name is present at the point of allocation. This is used for error
303 -- diagnostics.
304
305 procedure Deallocate_Any_Controlled
306 (Pool : in out Root_Storage_Pool'Class;
307 Addr : System.Address;
308 Storage_Size : System.Storage_Elements.Storage_Count;
309 Alignment : System.Storage_Elements.Storage_Count;
310 Is_Controlled : Boolean);
311 -- Compiler interface. This version of Deallocate handles all possible
312 -- cases, either from a pool or a pool_with_subpools, regardless of the
313 -- controlled status of the deallocated object. Parameter usage:
314 --
315 -- * Pool - The pool associated with the access type. Pool can be any
316 -- derivation from Root_Storage_Pool, including a pool_with_subpools.
317 --
318 -- * Addr - The address of the allocated object.
319 --
320 -- * Storage_Size - The size of the allocated object.
321 --
322 -- * Alignment - The alignment of the allocated object.
323 --
324 -- * Is_Controlled - A flag which determines whether the allocated object
325 -- is controlled. When set to True, the machinery generates additional
326 -- data.
327
328 procedure Detach (N : not null SP_Node_Ptr);
329 -- Unhook a subpool node from an arbitrary subpool list
330
331 overriding procedure Finalize (Controller : in out Pool_Controller);
332 -- Buffer routine, calls Finalize_Pool
333
334 procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
335 -- Iterate over all subpools of Pool, detach them one by one and finalize
336 -- their masters. This action first detaches a controlled object from a
337 -- particular master, then invokes its Finalize_Address primitive.
338
339 function Header_Size_With_Padding
340 (Alignment : System.Storage_Elements.Storage_Count)
341 return System.Storage_Elements.Storage_Count;
342 -- Given an arbitrary alignment, calculate the size of the header which
343 -- precedes a controlled object as the nearest multiple rounded up of the
344 -- alignment.
345
346 overriding procedure Initialize (Controller : in out Pool_Controller);
347 -- Buffer routine, calls Initialize_Pool
348
349 procedure Initialize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
350 -- Setup the doubly linked list of subpools
351
352 procedure Print_Pool (Pool : Root_Storage_Pool_With_Subpools);
353 -- Debug routine, output the contents of a pool_with_subpools
354
355 procedure Print_Subpool (Subpool : Subpool_Handle);
356 -- Debug routine, output the contents of a subpool
357
358 end System.Storage_Pools.Subpools;