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