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, 214 insertions, 0 deletions

diff --git a/gcc/ada/s-finmas.adb b/gcc/ada/s-finmas.adb
new file mode 100644
index 00000000000..7a5be2cd3c1
--- /dev/null
+++ b/gcc/ada/s-finmas.adb
@@ -0,0 +1,214 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--           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          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2011, Free Software Foundation, Inc.           --
+--                                                                          --
+-- 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.Exceptions;          use Ada.Exceptions;
+
+with System.Soft_Links;       use System.Soft_Links;
+with System.Storage_Elements; use System.Storage_Elements;
+
+package body System.Finalization_Masters is
+
+   ---------------------------
+   -- Add_Offset_To_Address --
+   ---------------------------
+
+   function Add_Offset_To_Address
+     (Addr   : System.Address;
+      Offset : System.Storage_Elements.Storage_Offset) return System.Address
+   is
+   begin
+      return System.Storage_Elements."+" (Addr, Offset);
+   end Add_Offset_To_Address;
+
+   ------------
+   -- Attach --
+   ------------
+
+   procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr) is
+   begin
+      Lock_Task.all;
+
+      L.Next.Prev := N;
+      N.Next := L.Next;
+      L.Next := N;
+      N.Prev := L;
+
+      Unlock_Task.all;
+
+      --  Note: No need to unlock in case of an exception because the above
+      --  code can never raise one.
+   end Attach;
+
+   ---------------
+   -- Base_Pool --
+   ---------------
+
+   function Base_Pool
+     (Master : Finalization_Master) return Any_Storage_Pool_Ptr
+   is
+   begin
+      return Master.Base_Pool;
+   end Base_Pool;
+
+   ------------
+   -- Detach --
+   ------------
+
+   procedure Detach (N : not null FM_Node_Ptr) is
+   begin
+      --  N must be attached to some list
+
+      pragma Assert (N.Next /= null and then N.Prev /= null);
+
+      Lock_Task.all;
+
+      N.Prev.Next := N.Next;
+      N.Next.Prev := N.Prev;
+
+      Unlock_Task.all;
+
+      --  Note: No need to unlock in case of an exception because the above
+      --  code can never raise one.
+   end Detach;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   overriding procedure Finalize (Master : in out Finalization_Master) is
+      Curr_Ptr : FM_Node_Ptr;
+      Ex_Occur : Exception_Occurrence;
+      Obj_Addr : Address;
+      Raised   : Boolean := False;
+
+   begin
+      --  It is possible for multiple tasks to cause the finalization of the
+      --  same master. Let only one task finalize the objects.
+
+      if Master.Finalization_Started then
+         return;
+      end if;
+
+      --  Lock the master to prevent any allocations while the objects are
+      --  being finalized. The master remains locked because either the master
+      --  is explicitly deallocated or the associated access type is about to
+      --  go out of scope.
+
+      Master.Finalization_Started := True;
+
+      --  Skip the dummy head
+
+      Curr_Ptr := Master.Objects.Next;
+      while Curr_Ptr /= Master.Objects'Unchecked_Access loop
+         begin
+            --  If primitive Finalize_Address is not set, then the expansion of
+            --  the designated type or that of the allocator failed. This is a
+            --  serious error.
+
+            --  Note: The Program_Error must be raised from the same block as
+            --  the finalization call. If Finalize_Address is not present for
+            --  a particular object, this should not stop the finalization of
+            --  the remaining objects.
+
+            if Curr_Ptr.Finalize_Address = null then
+               raise Program_Error
+                 with "primitive Finalize_Address not available";
+
+            --  Skip the list header in order to offer proper object layout for
+            --  finalization and call Finalize_Address.
+
+            else
+               Obj_Addr := Curr_Ptr.all'Address + Header_Offset;
+               Curr_Ptr.Finalize_Address (Obj_Addr);
+            end if;
+
+         exception
+            when Fin_Occur : others =>
+               if not Raised then
+                  Raised := True;
+                  Save_Occurrence (Ex_Occur, Fin_Occur);
+               end if;
+         end;
+
+         Curr_Ptr := Curr_Ptr.Next;
+      end loop;
+
+      --  If the finalization of a particular object failed or Finalize_Address
+      --  was not set, reraise the exception now.
+
+      if Raised then
+         Reraise_Occurrence (Ex_Occur);
+      end if;
+   end Finalize;
+
+   -----------------
+   -- Header_Size --
+   -----------------
+
+   function Header_Size return System.Storage_Elements.Storage_Count is
+   begin
+      return FM_Node'Size / Storage_Unit;
+   end Header_Size;
+
+   -------------------
+   -- Header_Offset --
+   -------------------
+
+   function Header_Offset return System.Storage_Elements.Storage_Offset is
+   begin
+      return FM_Node'Size / Storage_Unit;
+   end Header_Offset;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   overriding procedure Initialize (Master : in out Finalization_Master) is
+   begin
+      --  The dummy head must point to itself in both directions
+
+      Master.Objects.Next := Master.Objects'Unchecked_Access;
+      Master.Objects.Prev := Master.Objects'Unchecked_Access;
+   end Initialize;
+
+   -------------------
+   -- Set_Base_Pool --
+   -------------------
+
+   procedure Set_Base_Pool
+     (Master   : in out Finalization_Master;
+      Pool_Ptr : Any_Storage_Pool_Ptr)
+   is
+   begin
+      Master.Base_Pool := Pool_Ptr;
+   end Set_Base_Pool;
+
+end System.Finalization_Masters;