2011-08-29 Johannes Kanig <kanig@adacore.com>

	* debug.adb: Add comments.

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

	* impunit.adb, s-stposu.adb, s-stposu.ads, exp_ch4.adb,
	s-finmas.adb, s-finmas.ads: Redo previous change.



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

1 files changed, 91 insertions, 45 deletions

diff --git a/gcc/ada/s-finmas.ads b/gcc/ada/s-finmas.ads
index 87a607678bc..0ffc78af2d0 100644
--- a/gcc/ada/s-finmas.ads
+++ b/gcc/ada/s-finmas.ads
@@ -30,15 +30,13 @@
 ------------------------------------------------------------------------------
 
 with Ada.Finalization;
-with Ada.Unchecked_Conversion;
-
 with System.Storage_Elements;
 with System.Storage_Pools;
 
 pragma Compiler_Unit;
 
 package System.Finalization_Masters is
-   pragma Preelaborate (System.Finalization_Masters);
+   pragma Preelaborate;
 
    --  A reference to primitive Finalize_Address. The expander generates an
    --  implementation of this procedure for each controlled and class-wide
@@ -48,17 +46,11 @@ package System.Finalization_Masters is
 
    type Finalize_Address_Ptr is access procedure (Obj : System.Address);
 
-   --  Heterogeneous collection type structure. The implementation allows for
-   --  finalizable objects of different base types to be serviced by the same
-   --  master.
+   --  Heterogeneous collection type structure
 
-   type FM_Node;
+   type FM_Node is private;
    type FM_Node_Ptr is access all FM_Node;
-
-   type FM_Node is record
-      Prev : FM_Node_Ptr := null;
-      Next : FM_Node_Ptr := null;
-   end record;
+   pragma No_Strict_Aliasing (FM_Node_Ptr);
 
    --  A reference to any derivation from Root_Storage_Pool. Since this type
    --  may not be used to allocate objects, its storage size is zero.
@@ -69,11 +61,95 @@ package System.Finalization_Masters is
 
    --  Finalization master type structure. A unique master is associated with
    --  each access-to-controlled or access-to-class-wide type. Masters also act
-   --  as components of subpools.
+   --  as components of subpools. By default, a master contains objects of the
+   --  same designated type but it may also accomodate heterogeneous objects.
+
+   type Finalization_Master is
+     new Ada.Finalization.Limited_Controlled with private;
+
+   --  A reference to a finalization master. Since this type may not be used
+   --  to allocate objects, its storage size is zero.
+
+   type Finalization_Master_Ptr is access all Finalization_Master;
+   for Finalization_Master_Ptr'Storage_Size use 0;
+
+   procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
+   --  Prepend a node to a specific finalization master
+
+   procedure Delete_Finalize_Address (Obj : System.Address);
+   --  Destroy the relation pair object - Finalize_Address from the internal
+   --  hash table.
+
+   procedure Detach (N : not null FM_Node_Ptr);
+   --  Remove a node from an arbitrary finalization master
+
+   overriding procedure Finalize (Master : in out Finalization_Master);
+   --  Lock the master to prevent allocations during finalization. Iterate over
+   --  the list of allocated controlled objects, finalizing each one by calling
+   --  its specific Finalize_Address. In the end, deallocate the dummy head.
+
+   function Finalize_Address
+     (Master : Finalization_Master) return Finalize_Address_Ptr;
+   --  Return a reference to the TSS primitive Finalize_Address associated with
+   --  a master.
+
+   function Finalize_Address
+     (Obj : System.Address) return Finalize_Address_Ptr;
+   --  Retrieve the Finalize_Address primitive associated with a particular
+   --  object.
+
+   function Finalization_Started (Master : Finalization_Master) return Boolean;
+   --  Return the finalization status of a master
+
+   function Header_Offset return System.Storage_Elements.Storage_Offset;
+   --  Return the size of type FM_Node as Storage_Offset
+
+   function Header_Size return System.Storage_Elements.Storage_Count;
+   --  Return the size of type FM_Node as Storage_Count
+
+   function Is_Homogeneous (Master : Finalization_Master) return Boolean;
+   --  Return the behavior flag of a master
+
+   function Objects (Master : Finalization_Master) return FM_Node_Ptr;
+   --  Return the header of the doubly-linked list of controlled objects
+
+   procedure Print_Master (Master : Finalization_Master);
+   --  Debug routine, outputs the contents of a master
+
+   procedure Set_Finalize_Address
+     (Master       : in out Finalization_Master;
+      Fin_Addr_Ptr : Finalize_Address_Ptr);
+   --  Set the clean up routine of a finalization master. Note: this routine
+   --  must precede the one below since RTSfind needs to match this one.
+
+   procedure Set_Finalize_Address
+     (Obj          : System.Address;
+      Fin_Addr_Ptr : Finalize_Address_Ptr);
+   --  Add a relation pair object - Finalize_Address to the internal hash table
+
+   procedure Set_Is_Heterogeneous (Master : in out Finalization_Master);
+   --  Mark the master as being a heterogeneous collection of objects
+
+private
+   --  Heterogeneous collection type structure
+
+   type FM_Node is record
+      Prev : FM_Node_Ptr := null;
+      Next : FM_Node_Ptr := null;
+   end record;
+
+   --  Finalization master type structure. A unique master is associated with
+   --  each access-to-controlled or access-to-class-wide type. Masters also act
+   --  as components of subpools. By default, a master contains objects of the
+   --  same designated type but it may also accomodate heterogeneous objects.
 
    type Finalization_Master is
      new Ada.Finalization.Limited_Controlled with
    record
+      Is_Homogeneous : Boolean := True;
+      --  A flag which controls the behavior of the master. A value of False
+      --  denotes a heterogeneous collection.
+
       Base_Pool : Any_Storage_Pool_Ptr := null;
       --  A reference to the pool which this finalization master services. This
       --  field is used in conjunction with the build-in-place machinery.
@@ -83,7 +159,8 @@ package System.Finalization_Masters is
       --  objects allocated in a [sub]pool.
 
       Finalize_Address : Finalize_Address_Ptr := null;
-      --  A reference to the routine reponsible for object finalization
+      --  A reference to the routine reponsible for object finalization. This
+      --  is used only when the master is in homogeneous mode.
 
       Finalization_Started : Boolean := False;
       pragma Atomic (Finalization_Started);
@@ -93,9 +170,6 @@ package System.Finalization_Masters is
       --  is accessed without Lock_Task / Unlock_Task.
    end record;
 
-   type Finalization_Master_Ptr is access all Finalization_Master;
-   for Finalization_Master_Ptr'Storage_Size use 0;
-
    --  Since RTSfind cannot contain names of the form RE_"+", the following
    --  routine serves as a wrapper around System.Storage_Elements."+".
 
@@ -103,45 +177,17 @@ package System.Finalization_Masters is
      (Addr   : System.Address;
       Offset : System.Storage_Elements.Storage_Offset) return System.Address;
 
-   function Address_To_FM_Node_Ptr is
-     new Ada.Unchecked_Conversion (Address, FM_Node_Ptr);
-
-   procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
-   --  Prepend a node to a specific finalization master
-
    function Base_Pool
      (Master : Finalization_Master) return Any_Storage_Pool_Ptr;
    --  Return a reference to the underlying storage pool on which the master
    --  operates.
 
-   procedure Detach (N : not null FM_Node_Ptr);
-   --  Remove a node from an arbitrary finalization master
-
-   overriding procedure Finalize (Master : in out Finalization_Master);
-   --  Lock the master to prevent allocations during finalization. Iterate over
-   --  the list of allocated controlled objects, finalizing each one by calling
-   --  its specific Finalize_Address. In the end, deallocate the dummy head.
-
-   function Header_Offset return System.Storage_Elements.Storage_Offset;
-   --  Return the size of type FM_Node as Storage_Offset
-
-   function Header_Size return System.Storage_Elements.Storage_Count;
-   --  Return the size of type FM_Node as Storage_Count
-
    overriding procedure Initialize (Master : in out Finalization_Master);
    --  Initialize the dummy head of a finalization master
 
-   procedure pm (Master : Finalization_Master);
-   --  Debug routine, outputs the contents of a master
-
    procedure Set_Base_Pool
      (Master   : in out Finalization_Master;
       Pool_Ptr : Any_Storage_Pool_Ptr);
    --  Set the underlying pool of a finalization master
 
-   procedure Set_Finalize_Address
-     (Master       : in out Finalization_Master;
-      Fin_Addr_Ptr : Finalize_Address_Ptr);
-   --  Set the clean up routine of a finalization master
-
 end System.Finalization_Masters;