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