Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--        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         --

--                                                                          --

--                                 S p e c                                  --

--                                                                          --

--            Copyright (C) 2011, Free Software Foundation, Inc.            --

--                                                                          --

-- This specification is derived from the Ada Reference Manual for use with --

-- GNAT. The copyright notice above, and the license provisions that follow --

-- apply solely to the  contents of the part following the private keyword. --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

--                                                                          --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- version 3.1, as published by the Free Software Foundation.               --

--                                                                          --

-- You should have received a copy of the GNU General Public License and    --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Ada.Finalization;

with System.Finalization_Masters;

with System.Storage_Elements;

package System.Storage_Pools.Subpools is

   pragma Preelaborate;

   type Root_Storage_Pool_With_Subpools is abstract

     new Root_Storage_Pool with private;

   --  The base for all implementations of Storage_Pool_With_Subpools. This

   --  type is Limited_Controlled by derivation. To use subpools, an access

   --  type must be associated with an implementation descending from type

   --  Root_Storage_Pool_With_Subpools.

   type Root_Subpool is abstract tagged limited private;

   --  The base for all implementations of Subpool. Objects of this type are

   --  managed by the pool_with_subpools.

   type Subpool_Handle is access all Root_Subpool'Class;

   for Subpool_Handle'Storage_Size use 0;

   --  Since subpools are limited types by definition, a handle is instead used

   --  to manage subpool abstractions.

   overriding procedure Allocate

     (Pool                     : in out Root_Storage_Pool_With_Subpools;

      Storage_Address          : out System.Address;

      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;

      Alignment                : System.Storage_Elements.Storage_Count);

   --  Allocate an object described by Size_In_Storage_Elements and Alignment

   --  on the default subpool of Pool. Controlled types allocated through this

   --  routine will NOT be handled properly.

   procedure Allocate_From_Subpool

     (Pool                     : in out Root_Storage_Pool_With_Subpools;

      Storage_Address          : out System.Address;

      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;

      Alignment                : System.Storage_Elements.Storage_Count;

      Subpool                  : not null Subpool_Handle) is abstract;

   --  ??? This precondition causes errors in simple tests, disabled for now

   --      with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;

   --  This routine requires implementation. Allocate an object described by

   --  Size_In_Storage_Elements and Alignment on a subpool.

   function Create_Subpool

     (Pool : in out Root_Storage_Pool_With_Subpools)

      return not null Subpool_Handle is abstract;

   --  This routine requires implementation. Create a subpool within the given

   --  pool_with_subpools.

   overriding procedure Deallocate

     (Pool                     : in out Root_Storage_Pool_With_Subpools;

      Storage_Address          : System.Address;

      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;

      Alignment                : System.Storage_Elements.Storage_Count)

   is null;

   procedure Deallocate_Subpool

     (Pool    : in out Root_Storage_Pool_With_Subpools;

      Subpool : in out Subpool_Handle)

   is abstract;

   --  ??? This precondition causes errors in simple tests, disabled for now

   --      with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;

   --  This routine requires implementation. Reclaim the storage a particular

   --  subpool occupies in a pool_with_subpools. This routine is called by

   --  Ada.Unchecked_Deallocate_Subpool.

   function Default_Subpool_For_Pool

     (Pool : Root_Storage_Pool_With_Subpools) return not null Subpool_Handle;

   --  Return a common subpool which is used for object allocations without a

   --  Subpool_Handle_name in the allocator. The default implementation of this

   --  routine raises Program_Error.

   function Pool_Of_Subpool

     (Subpool : not null Subpool_Handle)

      return access Root_Storage_Pool_With_Subpools'Class;

   --  Return the owner of the subpool

   procedure Set_Pool_Of_Subpool

     (Subpool : not null Subpool_Handle;

      To      : in out Root_Storage_Pool_With_Subpools'Class);

   --  Set the owner of the subpool. This is intended to be called from

   --  Create_Subpool or similar subpool constructors. Raises Program_Error

   --  if the subpool already belongs to a pool.

   overriding function Storage_Size

     (Pool : Root_Storage_Pool_With_Subpools)

      return System.Storage_Elements.Storage_Count

   is

      (System.Storage_Elements.Storage_Count'Last);

private

   --  Model

   --             Pool_With_Subpools     SP_Node    SP_Node    SP_Node

   --       +-->+--------------------+   +-----+    +-----+    +-----+

   --       |   |      Subpools -------->|  ------->|  ------->|  ------->

   --       |   +--------------------+   +-----+    +-----+    +-----+

   --       |   |Finalization_Started|<------  |<-------  |<-------  |<---

   --       |   +--------------------+   +-----+    +-----+    +-----+

   --       +--- Controller.Encl_Pool|   | nul |    |  +  |    |  +  |

   --       |   +--------------------+   +-----+    +--|--+    +--:--+

   --       |   :                    :    Dummy        |  ^       :

   --       |   :                    :                 |  |       :

   --       |                            Root_Subpool  V  |

   --       |                            +-------------+  |

   --       +-------------------------------- Owner    |  |

   --               FM_Node   FM_Node    +-------------+  |

   --               +-----+   +-----+<-- Master.Objects|  |

   --            <------  |<------  |    +-------------+  |

   --               +-----+   +-----+    |    Node -------+

   --               |  ------>|  ----->  +-------------+

   --               +-----+   +-----+    :             :

   --               |ctrl |    Dummy     :             :

   --               | obj |

   --               +-----+

   --

   --  SP_Nodes are created on the heap. FM_Nodes and associated objects are

   --  created on the pool_with_subpools.

   type Any_Storage_Pool_With_Subpools_Ptr

     is access all Root_Storage_Pool_With_Subpools'Class;

   for Any_Storage_Pool_With_Subpools_Ptr'Storage_Size use 0;

   --  A pool controller is a special controlled object which ensures the

   --  proper initialization and finalization of the enclosing pool.

   type Pool_Controller (Enclosing_Pool : Any_Storage_Pool_With_Subpools_Ptr)

     is new Ada.Finalization.Limited_Controlled with null record;

   --  Subpool list types. Each pool_with_subpools contains a list of subpools.

   --  This is an indirect doubly linked list since subpools are not supposed

   --  to be allocatable by language design.

   type SP_Node;

   type SP_Node_Ptr is access all SP_Node;

   type SP_Node is record

      Prev    : SP_Node_Ptr := null;

      Next    : SP_Node_Ptr := null;

      Subpool : Subpool_Handle := null;

   end record;

   --  Root_Storage_Pool_With_Subpools internal structure. The type uses a

   --  special controller to perform initialization and finalization actions

   --  on itself. This is necessary because the end user of this package may

   --  decide to override Initialize and Finalize, thus disabling the desired

   --  behavior.

   --          Pool_With_Subpools     SP_Node    SP_Node    SP_Node

   --    +-->+--------------------+   +-----+    +-----+    +-----+

   --    |   |      Subpools -------->|  ------->|  ------->|  ------->

   --    |   +--------------------+   +-----+    +-----+    +-----+

   --    |   |Finalization_Started|   :     :    :     :    :     :

   --    |   +--------------------+

   --    +--- Controller.Encl_Pool|

   --        +--------------------+

   --        :       End-user     :

   --        :      components    :

   type Root_Storage_Pool_With_Subpools is abstract

     new Root_Storage_Pool with

   record

      Subpools : aliased SP_Node;

      --  A doubly linked list of subpools

      Finalization_Started : Boolean := False;

      pragma Atomic (Finalization_Started);

      --  A flag which prevents the creation of new subpools while the master

      --  pool is being finalized. The flag needs to be atomic because it is

      --  accessed without Lock_Task / Unlock_Task.

      Controller : Pool_Controller

                     (Root_Storage_Pool_With_Subpools'Unchecked_Access);

      --  A component which ensures that the enclosing pool is initialized and

      --  finalized at the appropriate places.

   end record;

   --  A subpool is an abstraction layer which sits on top of a pool. It

   --  contains links to all controlled objects allocated on a particular

   --  subpool.

   --        Pool_With_Subpools   SP_Node    SP_Node    SP_Node

   --    +-->+----------------+   +-----+    +-----+    +-----+

   --    |   |    Subpools ------>|  ------->|  ------->|  ------->

   --    |   +----------------+   +-----+    +-----+    +-----+

   --    |   :                :<------  |<-------  |<-------  |

   --    |   :                :   +-----+    +-----+    +-----+

   --    |                        |null |    |  +  |    |  +  |

   --    |                        +-----+    +--|--+    +--:--+

   --    |                                      |  ^       :

   --    |                        Root_Subpool  V  |

   --    |                        +-------------+  |

   --    +---------------------------- Owner    |  |

   --                             +-------------+  |

   --                      .......... Master    |  |

   --                             +-------------+  |

   --                             |    Node -------+

   --                             +-------------+

   --                             :   End-user  :

   --                             :  components :

   type Root_Subpool is abstract tagged limited record

      Owner : Any_Storage_Pool_With_Subpools_Ptr := null;

      --  A reference to the master pool_with_subpools

      Master : aliased System.Finalization_Masters.Finalization_Master;

      --  A heterogeneous collection of controlled objects

      Node : SP_Node_Ptr := null;

      --  A link to the doubly linked list node which contains the subpool.

      --  This back pointer is used in subpool deallocation.

   end record;

   --  ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed

   --  to Allocate_Any.

   procedure Allocate_Any_Controlled

     (Pool            : in out Root_Storage_Pool'Class;

      Context_Subpool : Subpool_Handle;

      Context_Master  : Finalization_Masters.Finalization_Master_Ptr;

      Fin_Address     : Finalization_Masters.Finalize_Address_Ptr;

      Addr            : out System.Address;

      Storage_Size    : System.Storage_Elements.Storage_Count;

      Alignment       : System.Storage_Elements.Storage_Count;

      Is_Controlled   : Boolean;

      On_Subpool      : Boolean);

   --  Compiler interface. This version of Allocate handles all possible cases,

   --  either on a pool or a pool_with_subpools, regardless of the controlled

   --  status of the allocated object. Parameter usage:

   --

   --    * Pool - The pool associated with the access type. Pool can be any

   --    derivation from Root_Storage_Pool, including a pool_with_subpools.

   --

   --    * Context_Subpool - The subpool handle name of an allocator. If no

   --    subpool handle is present at the point of allocation, the actual

   --    would be null.

   --

   --    * Context_Master - The finalization master associated with the access

   --    type. If the access type's designated type is not controlled, the

   --    actual would be null.

   --

   --    * Fin_Address - TSS routine Finalize_Address of the designated type.

   --    If the designated type is not controlled, the actual would be null.

   --

   --    * Addr - The address of the allocated object.

   --

   --    * Storage_Size - The size of the allocated object.

   --

   --    * Alignment - The alignment of the allocated object.

   --

   --    * Is_Controlled - A flag which determines whether the allocated object

   --    is controlled. When set to True, the machinery generates additional

   --    data.

   --

   --    * On_Subpool - A flag which determines whether the a subpool handle

   --    name is present at the point of allocation. This is used for error

   --    diagnostics.

   procedure Deallocate_Any_Controlled

     (Pool          : in out Root_Storage_Pool'Class;

      Addr          : System.Address;

      Storage_Size  : System.Storage_Elements.Storage_Count;

      Alignment     : System.Storage_Elements.Storage_Count;

      Is_Controlled : Boolean);

   --  Compiler interface. This version of Deallocate handles all possible

   --  cases, either from a pool or a pool_with_subpools, regardless of the

   --  controlled status of the deallocated object. Parameter usage:

   --

   --    * Pool - The pool associated with the access type. Pool can be any

   --    derivation from Root_Storage_Pool, including a pool_with_subpools.

   --

   --    * Addr - The address of the allocated object.

   --

   --    * Storage_Size - The size of the allocated object.

   --

   --    * Alignment - The alignment of the allocated object.

   --

   --    * Is_Controlled - A flag which determines whether the allocated object

   --    is controlled. When set to True, the machinery generates additional

   --    data.

   overriding procedure Finalize (Controller : in out Pool_Controller);

   --  Buffer routine, calls Finalize_Pool

   procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);

   --  Iterate over all subpools of Pool, detach them one by one and finalize

   --  their masters. This action first detaches a controlled object from a

   --  particular master, then invokes its Finalize_Address primitive.

   procedure Finalize_Subpool (Subpool : not null Subpool_Handle);

   --  Finalize all controlled objects chained on Subpool's master. Remove the

   --  subpool from its owner's list. Deallocate the associated doubly linked

   --  list node.

   function Header_Size_With_Padding

     (Alignment : System.Storage_Elements.Storage_Count)

      return System.Storage_Elements.Storage_Count;

   --  Given an arbitrary alignment, calculate the size of the header which

   --  precedes a controlled object as the nearest multiple rounded up of the

   --  alignment.

   overriding procedure Initialize (Controller : in out Pool_Controller);

   --  Buffer routine, calls Initialize_Pool

   procedure Initialize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);

   --  Setup the doubly linked list of subpools

   procedure Print_Pool (Pool : Root_Storage_Pool_With_Subpools);

   --  Debug routine, output the contents of a pool_with_subpools

   procedure Print_Subpool (Subpool : Subpool_Handle);

   --  Debug routine, output the contents of a subpool

end System.Storage_Pools.Subpools;