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