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-2018, 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
36with Ada.Finalization;
37with System.Finalization_Masters;
38with System.Storage_Elements;
39
40package 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
130private
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
358end System.Storage_Pools.Subpools;
359