exp_ch13.adb: Add with and use clause for Targparm;

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.

From-SVN: r177276

1 files changed, 90 insertions, 13 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 95b23d8..fb7f3b0 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -840,6 +840,22 @@ package body Exp_Ch4 is
                Complete_Controlled_Allocation (Temp_Decl);
                Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
 
+               --  Attach the object to the associated finalization collection.
+               --  This is done manually on .NET/JVM since those compilers do
+               --  no support pools and can't benefit from internally generated
+               --  Allocate / Deallocate procedures.
+
+               if VM_Target /= No_VM
+                 and then Is_Controlled (DesigT)
+                 and then Present (Associated_Collection (PtrT))
+               then
+                  Insert_Action (N,
+                    Make_Attach_Call (
+                      Obj_Ref =>
+                        New_Reference_To (Temp, Loc),
+                      Ptr_Typ => PtrT));
+               end if;
+
             else
                Node := Relocate_Node (N);
                Set_Analyzed (Node);
@@ -853,6 +869,22 @@ package body Exp_Ch4 is
 
                Insert_Action (N, Temp_Decl);
                Complete_Controlled_Allocation (Temp_Decl);
+
+               --  Attach the object to the associated finalization collection.
+               --  This is done manually on .NET/JVM since those compilers do
+               --  no support pools and can't benefit from internally generated
+               --  Allocate / Deallocate procedures.
+
+               if VM_Target /= No_VM
+                 and then Is_Controlled (DesigT)
+                 and then Present (Associated_Collection (PtrT))
+               then
+                  Insert_Action (N,
+                    Make_Attach_Call (
+                      Obj_Ref =>
+                        New_Reference_To (Temp, Loc),
+                      Ptr_Typ => PtrT));
+               end if;
             end if;
 
          --  Ada 2005 (AI-251): Handle allocators whose designated type is an
@@ -1040,7 +1072,12 @@ package body Exp_Ch4 is
             --    Set_Finalize_Address_Ptr
             --      (Collection, <Finalize_Address>'Unrestricted_Access)
 
-            if Present (Associated_Collection (PtrT)) then
+            --  Since .NET/JVM compilers do not support address arithmetic,
+            --  this call is skipped.
+
+            if VM_Target = No_VM
+              and then Present (Associated_Collection (PtrT))
+            then
                Insert_Action (N,
                  Make_Set_Finalize_Address_Ptr_Call (
                    Loc     => Loc,
@@ -1085,6 +1122,22 @@ package body Exp_Ch4 is
          Complete_Controlled_Allocation (Temp_Decl);
          Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
 
+         --  Attach the object to the associated finalization collection. This
+         --  is done manually on .NET/JVM since those compilers do no support
+         --  pools and cannot benefit from internally generated Allocate and
+         --  Deallocate procedures.
+
+         if VM_Target /= No_VM
+           and then Is_Controlled (DesigT)
+           and then Present (Associated_Collection (PtrT))
+         then
+            Insert_Action (N,
+              Make_Attach_Call (
+                Obj_Ref =>
+                  New_Reference_To (Temp, Loc),
+                Ptr_Typ => PtrT));
+         end if;
+
          Rewrite (N, New_Reference_To (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
@@ -3477,9 +3530,12 @@ package body Exp_Ch4 is
          if No_Initialization (N) then
 
             --  Even though this might be a simple allocation, create a custom
-            --  Allocate if the context requires it.
+            --  Allocate if the context requires it. Since .NET/JVM compilers
+            --  do not support pools, this step is skipped.
 
-            if Present (Associated_Collection (PtrT)) then
+            if VM_Target = No_VM
+              and then Present (Associated_Collection (PtrT))
+            then
                Build_Allocate_Deallocate_Proc
                  (N           => Parent (N),
                   Is_Allocate => True);
@@ -3759,7 +3815,8 @@ package body Exp_Ch4 is
                else
                   Insert_Action (N,
                     Make_Procedure_Call_Statement (Loc,
-                      Name                   => New_Reference_To (Init, Loc),
+                      Name =>
+                        New_Reference_To (Init, Loc),
                       Parameter_Associations => Args));
                end if;
 
@@ -3773,16 +3830,36 @@ package body Exp_Ch4 is
                       Obj_Ref => New_Copy_Tree (Init_Arg1),
                       Typ     => T));
 
-                  --  Generate:
-                  --    Set_Finalize_Address_Ptr
-                  --      (Pool, <Finalize_Address>'Unrestricted_Access)
-
                   if Present (Associated_Collection (PtrT)) then
-                     Insert_Action (N,
-                       Make_Set_Finalize_Address_Ptr_Call (
-                         Loc     => Loc,
-                         Typ     => T,
-                         Ptr_Typ => PtrT));
+
+                     --  Special processing for .NET/JVM, the allocated object
+                     --  is attached to the finalization collection. Generate:
+
+                     --    Attach (<PtrT>FC, Root_Controlled_Ptr (Init_Arg1));
+
+                     --  Types derived from [Limited_]Controlled are the only
+                     --  ones considered since they have fields Prev and Next.
+
+                     if VM_Target /= No_VM then
+                        if Is_Controlled (T) then
+                           Insert_Action (N,
+                             Make_Attach_Call (
+                               Obj_Ref => New_Copy_Tree (Init_Arg1),
+                               Ptr_Typ => PtrT));
+                        end if;
+
+                     --  Default case, generate:
+
+                     --    Set_Finalize_Address_Ptr
+                     --      (Pool, <Finalize_Address>'Unrestricted_Access)
+
+                     else
+                        Insert_Action (N,
+                          Make_Set_Finalize_Address_Ptr_Call (
+                            Loc     => Loc,
+                            Typ     => T,
+                            Ptr_Typ => PtrT));
+                     end if;
                   end if;
                end if;