blob: b952e015b2b07bc09fe1df77ba42e80c5da604c7 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- 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-2022, 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 --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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;
pragma Preelaborable_Initialization (Root_Storage_Pool_With_Subpools);
-- 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;
pragma Preelaborable_Initialization (Root_Subpool);
-- 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;