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