359 lines
17 KiB
Ada
359 lines
17 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-2015, 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;
|
|
-- 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;
|