gcc/ada/libgnat/s-finmas.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --           S Y S T E M . F I N A L I Z A T I O N _ M A S T E R S          --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2011-2023, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Finalization;
  33 with System.Storage_Elements;
  34 with System.Storage_Pools;
  35
  36 package System.Finalization_Masters is
  37    pragma Preelaborate;
  38
  39    --  A reference to primitive Finalize_Address. The expander generates an
  40    --  implementation of this procedure for each controlled and class-wide
  41    --  type. Since controlled objects are simply viewed as addresses once
  42    --  allocated through a master, Finalize_Address provides a backward
  43    --  indirection from an address to a type-specific context.
  44
  45    type Finalize_Address_Ptr is access procedure (Obj : System.Address);
  46
  47    --  Heterogeneous collection type structure
  48
  49    type FM_Node is private;
  50    type FM_Node_Ptr is access all FM_Node;
  51    pragma No_Strict_Aliasing (FM_Node_Ptr);
  52
  53    --  A reference to any derivation from Root_Storage_Pool. Since this type
  54    --  may not be used to allocate objects, its storage size is zero.
  55
  56    type Any_Storage_Pool_Ptr is
  57      access System.Storage_Pools.Root_Storage_Pool'Class;
  58    for Any_Storage_Pool_Ptr'Storage_Size use 0;
  59
  60    --  Finalization master type structure. A unique master is associated with
  61    --  each access-to-controlled or access-to-class-wide type. Masters also act
  62    --  as components of subpools. By default, a master contains objects of the
  63    --  same designated type but it may also accommodate heterogeneous objects.
  64
  65    type Finalization_Master is
  66      new Ada.Finalization.Limited_Controlled with private;
  67
  68    --  A reference to a finalization master. Since this type may not be used
  69    --  to allocate objects, its storage size is zero.
  70
  71    type Finalization_Master_Ptr is access all Finalization_Master;
  72    for Finalization_Master_Ptr'Storage_Size use 0;
  73
  74    procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
  75    --  Compiler interface, do not call from within the run-time. Prepend a
  76    --  node to a specific finalization master.
  77
  78    procedure Attach_Unprotected
  79      (N : not null FM_Node_Ptr;
  80       L : not null FM_Node_Ptr);
  81    --  Prepend a node to a specific finalization master
  82
  83    procedure Delete_Finalize_Address_Unprotected (Obj : System.Address);
  84    --  Destroy the relation pair object - Finalize_Address from the internal
  85    --  hash table.
  86
  87    procedure Detach_Unprotected (N : not null FM_Node_Ptr);
  88    --  Remove a node from an arbitrary finalization master
  89
  90    overriding procedure Finalize (Master : in out Finalization_Master);
  91    --  Lock the master to prevent allocations during finalization. Iterate over
  92    --  the list of allocated controlled objects, finalizing each one by calling
  93    --  its specific Finalize_Address. In the end, deallocate the dummy head.
  94
  95    function Finalize_Address
  96      (Master : Finalization_Master) return Finalize_Address_Ptr;
  97    --  Return a reference to the TSS primitive Finalize_Address associated with
  98    --  a master.
  99
 100    function Finalize_Address_Unprotected
 101      (Obj : System.Address) return Finalize_Address_Ptr;
 102    --  Retrieve the Finalize_Address primitive associated with a particular
 103    --  object.
 104
 105    function Finalization_Started (Master : Finalization_Master) return Boolean;
 106    --  Return the finalization status of a master
 107
 108    function Header_Size return System.Storage_Elements.Storage_Count;
 109    --  Return the size of type FM_Node as Storage_Count
 110
 111    function Is_Homogeneous (Master : Finalization_Master) return Boolean;
 112    --  Return the behavior flag of a master
 113
 114    function Objects (Master : Finalization_Master) return FM_Node_Ptr;
 115    --  Return the header of the doubly-linked list of controlled objects
 116
 117    procedure Print_Master (Master : Finalization_Master);
 118    --  Debug routine, outputs the contents of a master
 119
 120    procedure Set_Finalize_Address
 121      (Master       : in out Finalization_Master;
 122       Fin_Addr_Ptr : Finalize_Address_Ptr);
 123    --  Compiler interface, do not call from within the run-time. Set the clean
 124    --  up routine of a finalization master
 125
 126    procedure Set_Finalize_Address_Unprotected
 127      (Master       : in out Finalization_Master;
 128       Fin_Addr_Ptr : Finalize_Address_Ptr);
 129    --  Set the clean up routine of a finalization master
 130
 131    procedure Set_Heterogeneous_Finalize_Address_Unprotected
 132      (Obj          : System.Address;
 133       Fin_Addr_Ptr : Finalize_Address_Ptr);
 134    --  Add a relation pair object - Finalize_Address to the internal hash
 135    --  table. This is done in the context of allocation on a heterogeneous
 136    --  finalization master where a single master services multiple anonymous
 137    --  access-to-controlled types.
 138
 139    procedure Set_Is_Heterogeneous (Master : in out Finalization_Master);
 140    --  Mark the master as being a heterogeneous collection of objects
 141
 142 private
 143    --  Heterogeneous collection type structure
 144
 145    type FM_Node is record
 146       Prev : FM_Node_Ptr := null;
 147       Next : FM_Node_Ptr := null;
 148    end record;
 149
 150    --  Finalization master type structure. A unique master is associated with
 151    --  each access-to-controlled or access-to-class-wide type. Masters also act
 152    --  as components of subpools. By default, a master contains objects of the
 153    --  same designated type but it may also accommodate heterogeneous objects.
 154
 155    type Finalization_Master is
 156      new Ada.Finalization.Limited_Controlled with
 157    record
 158       Is_Homogeneous : Boolean := True;
 159       --  A flag which controls the behavior of the master. A value of False
 160       --  denotes a heterogeneous collection.
 161
 162       Base_Pool : Any_Storage_Pool_Ptr := null;
 163       --  A reference to the pool which this finalization master services. This
 164       --  field is used in conjunction with the build-in-place machinery.
 165
 166       Objects : aliased FM_Node;
 167       --  A doubly linked list which contains the headers of all controlled
 168       --  objects allocated in a [sub]pool.
 169
 170       Finalize_Address : Finalize_Address_Ptr := null;
 171       --  A reference to the routine reponsible for object finalization. This
 172       --  is used only when the master is in homogeneous mode.
 173
 174       Finalization_Started : Boolean := False;
 175       --  A flag used to detect allocations which occur during the finalization
 176       --  of a master. The allocations must raise Program_Error. This scenario
 177       --  may arise in a multitask environment.
 178    end record;
 179
 180    --  Since RTSfind cannot contain names of the form RE_"+", the following
 181    --  routine serves as a wrapper around System.Storage_Elements."+".
 182
 183    function Add_Offset_To_Address
 184      (Addr   : System.Address;
 185       Offset : System.Storage_Elements.Storage_Offset) return System.Address;
 186
 187    function Base_Pool
 188      (Master : Finalization_Master) return Any_Storage_Pool_Ptr;
 189    --  Return a reference to the underlying storage pool on which the master
 190    --  operates.
 191
 192    overriding procedure Initialize (Master : in out Finalization_Master);
 193    --  Initialize the dummy head of a finalization master
 194
 195    procedure Set_Base_Pool
 196      (Master   : in out Finalization_Master;
 197       Pool_Ptr : Any_Storage_Pool_Ptr);
 198    --  Set the underlying pool of a finalization master
 199
 200 end System.Finalization_Masters;