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