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

	* exp_ch13.adb: Add with and use clause for Targparm;
	(Expand_N_Free_Statement): Prevent the generation of a custom
	Deallocate on .NET/JVM targets since this requires pools and address
	arithmetic.
	* exp_ch4.adb (Expand_Allocator_Expression): When compiling for
	.NET/JVM targets, attach the newly allocated object to the access
	type's finalization collection. Do not generate a call to
	Set_Finalize_Address_Ptr on .NET/JVM because this routine does not
	exist in the runtime.
	(Expand_N_Allocator): When compiling for .NET/JVM targets, do not
	create a custom Allocate for object that do not require initialization.
	Attach a newly allocated object to the access type's finalization
	collection on .NET/JVM.
	* exp_ch5.adb (Make_Tag_Ctrl_Assignment): Add special processing for
	assignment of controlled types on .NET/JVM. The two hidden pointers
	Prev and Next and stored and later restored after the assignment takes
	place.
	* exp_ch6.adb (Expand_Call): Add local constant Curr_S. Add specialized
	kludge for .NET/JVM to recognize a particular piece of code coming from
	Heap_Management and change the call to Finalize into Deep_Finalize.
	* exp_ch7.adb (Build_Finalization_Collection): Allow the creation of
	finalization collections on .NET/JVM only for types derived from
	Controlled. Separate the association of storage pools with a collection
	and only allow it on non-.NET/JVM targets.
	(Make_Attach_Call): New routine.
	(Make_Detach_Call): New routine.
	(Process_Object_Declarations): Suppress the generation of
	build-in-place return object clean up code on .NET/JVM since it uses
	pools.
	* exp_ch7.ads (Make_Attach_Call): New routine.
	(Make_Detach_Call): New routine.
	* exp_intr.adb Add with and use clause for Targparm.
	(Expand_Unc_Deallocation): Detach a controlled object from a collection
	on .NET/JVM targets.
	* rtsfind.ads: Add entries RE_Attach, RE_Detach and
	RE_Root_Controlled_Ptr to tables RE_Id and RE_Unit_Table.
	* snames.ads-tmpl: Add name Name_Prev. Move Name_Prev to the special
	names used in finalization.

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

	* a-fihema.adb: Add with and use clauses for System.Soft_Links.
	(Attach, Detach): Lock the current task when chaining an object onto a
	collection.



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

1 files changed, 92 insertions, 10 deletions

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 4f175f177f7..cba68fbf4d4 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3496,7 +3496,9 @@ package body Exp_Ch5 is
       --  Tags are not saved and restored when VM_Target because VM tags are
       --  represented implicitly in objects.
 
-      Tag_Tmp : Entity_Id;
+      Next_Id : Entity_Id;
+      Prev_Id : Entity_Id;
+      Tag_Id  : Entity_Id;
 
    begin
       --  Finalize the target of the assignment when controlled
@@ -3535,14 +3537,14 @@ package body Exp_Ch5 is
              Typ     => Etype (L)));
       end if;
 
-      --  Save the Tag in a local variable Tag_Tmp
+      --  Save the Tag in a local variable Tag_Id
 
       if Save_Tag then
-         Tag_Tmp := Make_Temporary (Loc, 'A');
+         Tag_Id := Make_Temporary (Loc, 'A');
 
          Append_To (Res,
            Make_Object_Declaration (Loc,
-             Defining_Identifier => Tag_Tmp,
+             Defining_Identifier => Tag_Id,
              Object_Definition =>
                New_Reference_To (RTE (RE_Tag), Loc),
              Expression =>
@@ -3552,10 +3554,52 @@ package body Exp_Ch5 is
                  Selector_Name =>
                    New_Reference_To (First_Tag_Component (T), Loc))));
 
-      --  Otherwise Tag_Tmp not used
+      --  Otherwise Tag_Id is not used
 
       else
-         Tag_Tmp := Empty;
+         Tag_Id := Empty;
+      end if;
+
+      --  Save the Prev and Next fields on .NET/JVM. This is not needed on non
+      --  VM targets since the fields are not part of the object.
+
+      if VM_Target /= No_VM
+        and then Is_Controlled (T)
+      then
+         Prev_Id := Make_Temporary (Loc, 'P');
+         Next_Id := Make_Temporary (Loc, 'N');
+
+         --  Generate:
+         --    Pnn : Root_Controlled_Ptr := Root_Controlled (L).Prev;
+
+         Append_To (Res,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Prev_Id,
+             Object_Definition =>
+               New_Reference_To (RTE (RE_Root_Controlled_Ptr), Loc),
+             Expression =>
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Unchecked_Convert_To
+                     (RTE (RE_Root_Controlled), New_Copy_Tree (L)),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Name_Prev))));
+
+         --  Generate:
+         --    Nnn : Root_Controlled_Ptr := Root_Controlled (L).Next;
+
+         Append_To (Res,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Next_Id,
+             Object_Definition =>
+               New_Reference_To (RTE (RE_Root_Controlled_Ptr), Loc),
+             Expression =>
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Unchecked_Convert_To
+                     (RTE (RE_Root_Controlled), New_Copy_Tree (L)),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Name_Next))));
       end if;
 
       --  If the tagged type has a full rep clause, expand the assignment into
@@ -3577,10 +3621,48 @@ package body Exp_Ch5 is
            Make_Assignment_Statement (Loc,
              Name =>
                Make_Selected_Component (Loc,
-                 Prefix        => Duplicate_Subexpr_No_Checks (L),
-                 Selector_Name => New_Reference_To (First_Tag_Component (T),
-                                                    Loc)),
-             Expression => New_Reference_To (Tag_Tmp, Loc)));
+                 Prefix =>
+                   Duplicate_Subexpr_No_Checks (L),
+                 Selector_Name =>
+                   New_Reference_To (First_Tag_Component (T), Loc)),
+             Expression =>
+               New_Reference_To (Tag_Id, Loc)));
+      end if;
+
+      --  Restore the Prev and Next fields on .NET/JVM
+
+      if VM_Target /= No_VM
+        and then Is_Controlled (T)
+      then
+         --  Generate:
+         --    Root_Controlled (L).Prev := Prev_Id;
+
+         Append_To (Res,
+           Make_Assignment_Statement (Loc,
+             Name =>
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Unchecked_Convert_To
+                     (RTE (RE_Root_Controlled), New_Copy_Tree (L)),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Name_Prev)),
+             Expression =>
+               New_Reference_To (Prev_Id, Loc)));
+
+         --  Generate:
+         --    Root_Controlled (L).Next := Next_Id;
+
+         Append_To (Res,
+           Make_Assignment_Statement (Loc,
+             Name =>
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Unchecked_Convert_To
+                     (RTE (RE_Root_Controlled), New_Copy_Tree (L)),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Name_Next)),
+             Expression =>
+               New_Reference_To (Next_Id, Loc)));
       end if;
 
       --  Adjust the target after the assignment when controlled (not in the