2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>

	* a-fihema.ads, a-fihema.adb: Unit removed.
	* a-undesu.ads, a-undesu.adb: New unit implementing
	Ada.Unchecked_Deallocate_Subpool.
	* einfo.adb: Remove Associated_Collection from the node usage.
	Add Finalization_Master to the node usage.
	(Associated_Collection): Removed.
	(Finalization_Master): New routine.
	(Set_Associated_Collection): Removed.
	(Set_Finalization_Master): New routine.
	(Write_Field23_Name): Remove Associated_Collection from the output. Add
	Finalization_Master to the output.
	* einfo.ads: Remove attribute Associated_Collection and its uses in
	entities.
	Add new attribute Finalization_Master along with its uses in entitites.
	(Associated_Collection): Removed along with its pragma import.
	(Finalization_Master): New routine along with a pragma import.
	(Set_Associated_Collection): Removed along with its pragma import.
	(Set_Finalization_Master): New routine along with a pragma import.
	* exp_ch3.adb (Expand_Freeze_Array_Type): Replace call to
	Build_Finalization_Collection with Build_Finalization_Master.
	(Expand_Freeze_Record_Type): Move the generation of Finalize_Address
	before the bodies of the predefined routines. Add comment explaining
	this. Replace call to Build_Finalization_Collection with
	Build_Finalization_Master.
	(Freeze_Type): Replace call to Build_Finalization_Collection with
	Build_Finalization_Master.
	(Make_Finalize_Address_Body): Comment reformatting.
	(Make_Predefined_Primitive_Specs): Code reformatting.
	(Stream_Operation_OK): Update comment mentioning finalization
	collections. Replace RE_Finalization_Collection with
	RE_Finalization_Master.
	* exp_ch4.adb (Complete_Controlled_Allocation): Replace call to
	Associated_Collection with Finalization_Master. Replace call to
	Build_Finalization_Collection with Build_Finalization_Master.
	(Expand_Allocator_Expression): Replace call to Associated_Collection
	with Finalization_Master. Replace call to Set_Associated_Collection with
	Set_Finalization_Master. Remove the generation of
	Set_Finalize_Address_Ptr.
	(Expand_N_Allocator): Replace call to Associated_Collection with
	Finalization_Master. Remove the generation of Set_Finalize_Address_Ptr.
	* exp_ch6.adb (Add_Collection_Actual_To_Build_In_Place_Call): Renamed to
	Add_Finalization_Master_Actual_To_Build_In_Place_Call. Update the
	comment on usage. Replace call to Needs_BIP_Collection with
	Needs_BIP_Finalization_Master Remplace BIP_Collection with
	BIP_Finalization_Master. Update all comments which mention finalization
	collections. Replace Associated_Collection with
	Finalization_Master. Replace Build_Finalization_Collection with
	Build_Finalization_Master.
	(BIP_Formal_Suffix): Update BIP_Collection's case.
	(Build_Heap_Allocator): Update the related comment. Rename local
	variable Collect to Fin_Mas_Id and update its occurrences. Update
	comments which mention finalization collections. Replace
	Set_Associated_Collection with Set_Finalization_Master.
	(Expand_Call): Update the code which detects a special piece of library
	code for .NET/JVM.
	(Make_Build_In_Place_Call_In_Allocator): Replace the call to
	Add_Collection_Actual_To_Build_In_Place_Call with
	Add_Finalization_Master_Actual_To_Build_In_Place_Call. Remove the code
	which generates a call to Make_Set_Finalize_Address_Ptr_Call.
	(Make_Build_In_Place_Call_In_Anonymous_Context): Replace call to
	Add_Collection_Actual_To_Build_In_Place_Call with
	Add_Finalization_Master_Actual_To_Build_In_Place_Call.
	(Make_Build_In_Place_Call_In_Assignment): Replace call to
	Add_Collection_Actual_To_Build_In_Place_Call with
	Add_Finalization_Master_Actual_To_Build_In_Place_Call.
	(Needs_BIP_Collection): Renamed to Needs_BIP_Finalization_Master.
	* exp_ch6.ads: Rename BIP_Collection to BIP_Finalization_Master.
	(Needs_BIP_Collection): Renamed to Needs_BIP_Finalization_Master.
	* exp_ch7.adb (Build_BIP_Cleanup_Stmts): Update comment on usage.
	Rename local variable Collect to Fin_Mas_Id and update its occurrences.
	Replace call to Set_Associated_Collection with Set_Finalization_Master.
	(Build_Finalization_Collection): Renamed to Build_Finalization_Master.
	Replace the call to Associated_Collection with Finalization_Master.
	Rename local variable Coll_Id to Fin_Mas_Id and update its occurrences.
	Update the way finalization master names are generated. Update the
	retrieval of the correct access type which will carry the pool and
	master attributes.
	(Make_Final_Call): Reimplement the way [Deep_]Finalize is retrieved.
	(Make_Finalize_Address_Body): Abstract types do not need
	Finalize_Address. Code reformatting.
	(Make_Finalize_Address_Stmts): Update comment on usage.
	(Make_Set_Finalize_Address_Ptr_Call): Removed.
	(Process_Declarations): Update comments.
	* exp_ch7.ads (Build_Finalization_Collection): Renamed to
	Build_Finalization_Master. Update associated comment.
	(Make_Set_Finalize_Address_Ptr_Call): Removed.
	* exp_ch13.adb: Update comments which mention finalization collections.
	(Expand_N_Free_Statement): Replace the call to Associated_Collection
	with Finalization_Master.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Reimplemented to
	create calls to routines Allocate_Any_Controlled and
	Deallocate_Any_Controlled.
	(Find_Finalize_Address): New routine.
	(Is_Allocate_Deallocate_Proc): Update the RTE entities used in the
	comparison.
	(Requires_Cleanup_Actions): Update the comment on freeze node
	inspection.
	* exp_util.ads: Remove comment on generated code for
	Build_Allocate_Deallocate_Proc. The code is now quite complex and it
	is better to simply look in the body.
	* freeze.adb (Freeze_All): Update the comment of finalization
	collections. Replace the call to Associated_Collection with
	Finalization_Master. Replace the call to Build_Finalization_Collection
	with Build_Finalization_Master.
	* impunit.adb: Add a-undesu and s-stposu to the list of units.
	* Makefile.rtl: Add files a-undesu, s-finmas and s-stposu. Remove file
	a-fihema.
	* rtsfind.adb (Get_Unit_Name): Remove the processing for children of
	Ada.Finalization. Add processing for children of System.Storage_Pools.
	* rtsfind.ads: Remove the naming of second level children of
	Ada.Finalization.
	Remove Ada_Finalization_Heap_Management from the list of units.
	Remove subtype Ada_Finalization_Child.
	Remove the following subprogram entities:
	
	   RE_Allocate
	   RE_Deallocate
	   RE_Finalization_Collection
	   RE_Finalization_Collection_Ptr
	   RE_Set_Finalize_Address_Ptr
	
	Add the naming of second level children of System.Storage_Pools.
	Add System_Finalization_Masters and System_Storage_Pools_Subpools to
	the list of units.
	Add subtype System_Storage_Pools_Child.
	Add the following subprogram entities to System.Finalization_Masters:
	
	   RE_Finalization_Master
	   RE_Finalization_Master_Ptr
	
	Add the following subprogram entities to System.Storage_Pools.Subpools:
	
	   RE_Allocate_Any_Controlled
	   RE_Deallocate_Any_Controlled
	   RE_Root_Storage_Pool_With_Subpools
	   RE_Root_Subpool
	   RE_Subpool_Handle
	
	Move the following subprogram entities from
	Ada.Finalization.Heap_Management to System.Finalization_Masters:
	
	   RE_Add_Offset_To_Address
	   RE_Attach
	   RE_Base_Pool
	   RE_Detach
	
	* sem_ch3.adb (Access_Type_Declaration): Replace the call to
	Set_Associated_Collection with Set_Finalization_Master.
	* sem_ch6.adb (Create_Extra_Formals): Update the way extra formal
	BIP_Finalization_Master is created.
	* s-finmas.adb: New unit System.Finalization_Masters.
	* s-finmas.ads: New unit System.Finalization_Masters.
	* s-stopoo.ads, s-stopoo.adb: Minor code reformatting.
	* s-stposu.ads, s-stposu.adb: New unit implementing
	System.Storage_Pools.Subpools.

2011-08-29  Bob Duff  <duff@adacore.com>

	* tbuild.adb: Add assertion.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178183 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 255 insertions, 0 deletions

diff --git a/gcc/ada/s-stposu.ads b/gcc/ada/s-stposu.ads
new file mode 100644
index 00000000000..d8e58fb0797
--- /dev/null
+++ b/gcc/ada/s-stposu.ads
@@ -0,0 +1,255 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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 System.Finalization_Masters;
+with System.Storage_Elements;
+
+package System.Storage_Pools.Subpools is
+   pragma Preelaborate (System.Storage_Pools.Subpools);
+
+   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.
+
+   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;
+      Storage_Size : Storage_Elements.Storage_Count :=
+                     Storage_Elements.Storage_Count'Last)
+   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
+   is abstract;
+   --  This routine requires implementation. Returns a common subpool used for
+   --  allocations without Subpool_Handle_name in the allocator.
+
+   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;
+      Pool    : 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.
+
+private
+   --  Model
+   --                           Pool_With_Subpools
+   --                 +----> +---------------------+ <----+
+   --                 |  +---------- Subpools      |      |
+   --                 |  |   +---------------------+      |
+   --                 |  |   :      User data      :      |
+   --                 |  |   '.....................'      |
+   --                 |  |                                |
+   --                 |  |    SP_Node       SP_Node       |
+   --                 |  +-> +-------+     +-------+      |
+   --                 |      | Prev  <-----> Prev  |      |
+   --                 |      +-------+     +-------+      |
+   --                 |      | Next  <---->| Next  |      |
+   --                 |      +-------+     +-------+      |
+   --                 |  +----Subpool|     |Subpool----+  |
+   --                 |  |   +-------+     +-------+   |  |
+   --                 |  |                             |  |
+   --                 |  |    Subpool       Subpool    |  |
+   --                 |  +-> +-------+     +-------+ <-+  |
+   --                 +------- Owner |     | Owner -------+
+   --                        +-------+     +-------+
+   --     +------------------- Master|     | Master---------------+
+   --     |                  +-------+     +-------+              |
+   --     |                  : User  :     : User  :              |
+   --     |                  : Data  :     : Data  :              |
+   --     |                  '.......'     '.......'              |
+   --     |                                                       |
+   --     |                           Heap                        |
+   --  .. | ..................................................... | ..
+   --  :  |                                                       |  :
+   --  :  |    Object    Object    Object               Object    |  :
+   --  :  +-> +------+  +------+  +------+             +------+ <-+  :
+   --  :      | Prev <--> Prev <--> Prev |             | Prev |      :
+   --  :      +------+  +------+  +------+             +------+      :
+   --  :      | Next <--> Next <--> Next |             | Next |      :
+   --  :      +------+  +------+  +------+             +------+      :
+   --  :      |  FA  |  |  FA  |  |  FA  |             |  FA  |      :
+   --  :      +------+  +------+  +------+             +------+      :
+   --  :      :      :  :      :  :      :             :      :      :
+   --  :      :      :  :      :  :      :             :      :      :
+   --  :      '......'  '......'  '......'             '......'      :
+   --  :                                                             :
+   --  '.............................................................'
+
+   --  Subpool list types. Each pool_with_subpools contains a list of subpools.
+
+   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
+
+   type Root_Storage_Pool_With_Subpools is abstract
+     new Root_Storage_Pool with
+   record
+      Initialized : Boolean := False;
+      pragma Atomic (Initialized);
+      --  Even though this type is derived from Limited_Controlled, overriding
+      --  Initialize would have no effect since the type is abstract. Routine
+      --  Set_Pool_Of_Subpool is tasked with the initialization of a pool with
+      --  subpools because it has to be called at some point. This flag is used
+      --  to prevent the resetting of the subpool chain.
+
+      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.
+   end record;
+
+   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 subpool is an abstraction layer which sits on top of a pool. It
+   --  contains links to all controlled objects allocated on a particular
+   --  subpool.
+
+   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 collection of controlled objects
+   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 := null;
+      Context_Master  : Finalization_Masters.Finalization_Master_Ptr := null;
+      Fin_Address     : Finalization_Masters.Finalize_Address_Ptr := null;
+      Addr            : out System.Address;
+      Storage_Size    : System.Storage_Elements.Storage_Count;
+      Alignment       : System.Storage_Elements.Storage_Count;
+      Is_Controlled   : Boolean := True);
+   --  Compiler interface. This version of Allocate handles all possible cases,
+   --  either on a pool or a pool_with_subpools.
+
+   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 := True);
+   --  Compiler interface. This version of Deallocate handles all possible
+   --  cases, either from a pool or a pool_with_subpools.
+
+   overriding procedure Finalize
+     (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 the master of a subpool
+
+end System.Storage_Pools.Subpools;