------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- 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 -- -- -- -- S p e c -- -- -- -- Copyright (C) 2011-2017, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- -- apply solely to the contents of the part following the private keyword. -- -- -- -- 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Ada.Finalization; with System.Finalization_Masters; with System.Storage_Elements; package System.Storage_Pools.Subpools is pragma Preelaborate; type Root_Storage_Pool_With_Subpools is abstract new Root_Storage_Pool with private; -- The base for all implementations of Storage_Pool_With_Subpools. This -- type is Limited_Controlled by derivation. To use subpools, an access -- type must be associated with an implementation descending from type -- Root_Storage_Pool_With_Subpools. type Root_Subpool is abstract tagged limited private; -- The base for all implementations of Subpool. Objects of this type are -- managed by the pool_with_subpools. type Subpool_Handle is access all Root_Subpool'Class; for Subpool_Handle'Storage_Size use 0; -- Since subpools are limited types by definition, a handle is instead used -- to manage subpool abstractions. overriding procedure Allocate (Pool : in out Root_Storage_Pool_With_Subpools; Storage_Address : out System.Address; Size_In_Storage_Elements : System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count); -- Allocate an object described by Size_In_Storage_Elements and Alignment -- on the default subpool of Pool. Controlled types allocated through this -- routine will NOT be handled properly. procedure Allocate_From_Subpool (Pool : in out Root_Storage_Pool_With_Subpools; Storage_Address : out System.Address; Size_In_Storage_Elements : System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count; Subpool : not null Subpool_Handle) is abstract; -- ??? This precondition causes errors in simple tests, disabled for now -- with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access; -- This routine requires implementation. Allocate an object described by -- Size_In_Storage_Elements and Alignment on a subpool. function Create_Subpool (Pool : in out Root_Storage_Pool_With_Subpools) return not null Subpool_Handle is abstract; -- This routine requires implementation. Create a subpool within the given -- pool_with_subpools. overriding procedure Deallocate (Pool : in out Root_Storage_Pool_With_Subpools; Storage_Address : System.Address; Size_In_Storage_Elements : System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count) is null; procedure Deallocate_Subpool (Pool : in out Root_Storage_Pool_With_Subpools; Subpool : in out Subpool_Handle) is abstract; -- This precondition causes errors in simple tests, disabled for now??? -- with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access; -- This routine requires implementation. Reclaim the storage a particular -- subpool occupies in a pool_with_subpools. This routine is called by -- Ada.Unchecked_Deallocate_Subpool. function Default_Subpool_For_Pool (Pool : in out Root_Storage_Pool_With_Subpools) return not null Subpool_Handle; -- Return a common subpool which is used for object allocations without a -- Subpool_Handle_Name in the allocator. The default implementation of this -- routine raises Program_Error. function Pool_Of_Subpool (Subpool : not null Subpool_Handle) return access Root_Storage_Pool_With_Subpools'Class; -- Return the owner of the subpool procedure Set_Pool_Of_Subpool (Subpool : not null Subpool_Handle; To : in out Root_Storage_Pool_With_Subpools'Class); -- Set the owner of the subpool. This is intended to be called from -- Create_Subpool or similar subpool constructors. Raises Program_Error -- if the subpool already belongs to a pool. overriding function Storage_Size (Pool : Root_Storage_Pool_With_Subpools) return System.Storage_Elements.Storage_Count is (System.Storage_Elements.Storage_Count'Last); private -- Model -- Pool_With_Subpools SP_Node SP_Node SP_Node -- +-->+--------------------+ +-----+ +-----+ +-----+ -- | | Subpools -------->| ------->| ------->| -------> -- | +--------------------+ +-----+ +-----+ +-----+ -- | |Finalization_Started|<------ |<------- |<------- |<--- -- | +--------------------+ +-----+ +-----+ +-----+ -- +--- Controller.Encl_Pool| | nul | | + | | + | -- | +--------------------+ +-----+ +--|--+ +--:--+ -- | : : Dummy | ^ : -- | : : | | : -- | Root_Subpool V | -- | +-------------+ | -- +-------------------------------- Owner | | -- FM_Node FM_Node +-------------+ | -- +-----+ +-----+<-- Master.Objects| | -- <------ |<------ | +-------------+ | -- +-----+ +-----+ | Node -------+ -- | ------>| -----> +-------------+ -- +-----+ +-----+ : : -- |ctrl | Dummy : : -- | obj | -- +-----+ -- -- SP_Nodes are created on the heap. FM_Nodes and associated objects are -- created on the pool_with_subpools. type Any_Storage_Pool_With_Subpools_Ptr is access all Root_Storage_Pool_With_Subpools'Class; for Any_Storage_Pool_With_Subpools_Ptr'Storage_Size use 0; -- A pool controller is a special controlled object which ensures the -- proper initialization and finalization of the enclosing pool. type Pool_Controller (Enclosing_Pool : Any_Storage_Pool_With_Subpools_Ptr) is new Ada.Finalization.Limited_Controlled with null record; -- Subpool list types. Each pool_with_subpools contains a list of subpools. -- This is an indirect doubly linked list since subpools are not supposed -- to be allocatable by language design. type SP_Node; type SP_Node_Ptr is access all SP_Node; type SP_Node is record Prev : SP_Node_Ptr := null; Next : SP_Node_Ptr := null; Subpool : Subpool_Handle := null; end record; -- Root_Storage_Pool_With_Subpools internal structure. The type uses a -- special controller to perform initialization and finalization actions -- on itself. This is necessary because the end user of this package may -- decide to override Initialize and Finalize, thus disabling the desired -- behavior. -- Pool_With_Subpools SP_Node SP_Node SP_Node -- +-->+--------------------+ +-----+ +-----+ +-----+ -- | | Subpools -------->| ------->| ------->| -------> -- | +--------------------+ +-----+ +-----+ +-----+ -- | |Finalization_Started| : : : : : : -- | +--------------------+ -- +--- Controller.Encl_Pool| -- +--------------------+ -- : End-user : -- : components : type Root_Storage_Pool_With_Subpools is abstract new Root_Storage_Pool with record Subpools : aliased SP_Node; -- A doubly linked list of subpools Finalization_Started : Boolean := False; pragma Atomic (Finalization_Started); -- A flag which prevents the creation of new subpools while the master -- pool is being finalized. The flag needs to be atomic because it is -- accessed without Lock_Task / Unlock_Task. Controller : Pool_Controller (Root_Storage_Pool_With_Subpools'Unchecked_Access); -- A component which ensures that the enclosing pool is initialized and -- finalized at the appropriate places. end record; -- A subpool is an abstraction layer which sits on top of a pool. It -- contains links to all controlled objects allocated on a particular -- subpool. -- Pool_With_Subpools SP_Node SP_Node SP_Node -- +-->+----------------+ +-----+ +-----+ +-----+ -- | | Subpools ------>| ------->| ------->| -------> -- | +----------------+ +-----+ +-----+ +-----+ -- | : :<------ |<------- |<------- | -- | : : +-----+ +-----+ +-----+ -- | |null | | + | | + | -- | +-----+ +--|--+ +--:--+ -- | | ^ : -- | Root_Subpool V | -- | +-------------+ | -- +---------------------------- Owner | | -- +-------------+ | -- .......... Master | | -- +-------------+ | -- | Node -------+ -- +-------------+ -- : End-user : -- : components : type Root_Subpool is abstract tagged limited record Owner : Any_Storage_Pool_With_Subpools_Ptr := null; -- A reference to the master pool_with_subpools Master : aliased System.Finalization_Masters.Finalization_Master; -- A heterogeneous collection of controlled objects Node : SP_Node_Ptr := null; -- A link to the doubly linked list node which contains the subpool. -- This back pointer is used in subpool deallocation. end record; procedure Adjust_Controlled_Dereference (Addr : in out System.Address; Storage_Size : in out System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count); -- Given the memory attributes of a heap-allocated object that is known to -- be controlled, adjust the address and size of the object to include the -- two hidden pointers inserted by the finalization machinery. -- ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed -- to Allocate_Any. procedure Allocate_Any_Controlled (Pool : in out Root_Storage_Pool'Class; Context_Subpool : Subpool_Handle; Context_Master : Finalization_Masters.Finalization_Master_Ptr; Fin_Address : Finalization_Masters.Finalize_Address_Ptr; Addr : out System.Address; Storage_Size : System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count; Is_Controlled : Boolean; On_Subpool : Boolean); -- Compiler interface. This version of Allocate handles all possible cases, -- either on a pool or a pool_with_subpools, regardless of the controlled -- status of the allocated object. Parameter usage: -- -- * Pool - The pool associated with the access type. Pool can be any -- derivation from Root_Storage_Pool, including a pool_with_subpools. -- -- * Context_Subpool - The subpool handle name of an allocator. If no -- subpool handle is present at the point of allocation, the actual -- would be null. -- -- * Context_Master - The finalization master associated with the access -- type. If the access type's designated type is not controlled, the -- actual would be null. -- -- * Fin_Address - TSS routine Finalize_Address of the designated type. -- If the designated type is not controlled, the actual would be null. -- -- * Addr - The address of the allocated object. -- -- * Storage_Size - The size of the allocated object. -- -- * Alignment - The alignment of the allocated object. -- -- * Is_Controlled - A flag which determines whether the allocated object -- is controlled. When set to True, the machinery generates additional -- data. -- -- * On_Subpool - A flag which determines whether the a subpool handle -- name is present at the point of allocation. This is used for error -- diagnostics. procedure Deallocate_Any_Controlled (Pool : in out Root_Storage_Pool'Class; Addr : System.Address; Storage_Size : System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count; Is_Controlled : Boolean); -- Compiler interface. This version of Deallocate handles all possible -- cases, either from a pool or a pool_with_subpools, regardless of the -- controlled status of the deallocated object. Parameter usage: -- -- * Pool - The pool associated with the access type. Pool can be any -- derivation from Root_Storage_Pool, including a pool_with_subpools. -- -- * Addr - The address of the allocated object. -- -- * Storage_Size - The size of the allocated object. -- -- * Alignment - The alignment of the allocated object. -- -- * Is_Controlled - A flag which determines whether the allocated object -- 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 procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools); -- Iterate over all subpools of Pool, detach them one by one and finalize -- their masters. This action first detaches a controlled object from a -- particular master, then invokes its Finalize_Address primitive. function Header_Size_With_Padding (Alignment : System.Storage_Elements.Storage_Count) return System.Storage_Elements.Storage_Count; -- Given an arbitrary alignment, calculate the size of the header which -- precedes a controlled object as the nearest multiple rounded up of the -- alignment. overriding procedure Initialize (Controller : in out Pool_Controller); -- Buffer routine, calls Initialize_Pool procedure Initialize_Pool (Pool : in out Root_Storage_Pool_With_Subpools); -- Setup the doubly linked list of subpools procedure Print_Pool (Pool : Root_Storage_Pool_With_Subpools); -- Debug routine, output the contents of a pool_with_subpools procedure Print_Subpool (Subpool : Subpool_Handle); -- Debug routine, output the contents of a subpool end System.Storage_Pools.Subpools;