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-2018, 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-- 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. -- 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 36with Ada.Finalization; 37with System.Finalization_Masters; 38with System.Storage_Elements; 39 40package 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 130private 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 358end System.Storage_Pools.Subpools; 359