diff options
Diffstat (limited to 'gcc-4.8.3/gcc/ada/s-stposu.ads')
| -rw-r--r-- | gcc-4.8.3/gcc/ada/s-stposu.ads | 358 |
1 files changed, 358 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/s-stposu.ads b/gcc-4.8.3/gcc/ada/s-stposu.ads new file mode 100644 index 000000000..c80dd9e34 --- /dev/null +++ b/gcc-4.8.3/gcc/ada/s-stposu.ads @@ -0,0 +1,358 @@ +------------------------------------------------------------------------------ +-- -- +-- 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-2012, 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 : 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; |