gcc/ada/s-stposu.ads

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