[Ada] Support for controlled objects allocated on the heap for .NET/JVM
Arnaud Charlet
charlet@adacore.com
Wed Aug 3 14:43:00 GMT 2011
The following patch adds partial support for controlled objects allocated on
the heap for .NET/JVM compilation environments.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
-------------- next part --------------
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 177275)
+++ exp_ch5.adb (working copy)
@@ -3496,7 +3496,9 @@
-- 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 @@
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,12 +3554,54 @@
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
-- component-wise assignments. Mark the node as unanalyzed in order to
-- generate the proper code and propagate this scenario by setting a
@@ -3577,12 +3621,50 @@
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
-- init proc since it is an initialization more than an assignment).
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 177275)
+++ exp_ch7.adb (working copy)
@@ -896,9 +896,13 @@
then
return;
- -- Do not process access-to-controlled types on .NET/JVM targets
+ -- For .NET/JVM targets, allow the processing of access-to-controlled
+ -- types where the designated type is explicitly derived from [Limited_]
+ -- Controlled.
- elsif VM_Target /= No_VM then
+ elsif VM_Target /= No_VM
+ and then not Is_Controlled (Desig_Typ)
+ then
return;
end if;
@@ -933,48 +937,55 @@
Object_Definition =>
New_Reference_To (RTE (RE_Finalization_Collection), Loc)));
- -- If the access type has a user-defined pool, use it as the base
- -- storage medium for the finalization pool.
+ -- Storage pool selection and attribute decoration of the generated
+ -- collection. Since .NET/JVM compilers do not support pools, this
+ -- step is skipped.
- if Present (Associated_Storage_Pool (Typ)) then
- Pool_Id := Associated_Storage_Pool (Typ);
+ if VM_Target = No_VM then
- -- Access subtypes must use the storage pool of their base type
+ -- If the access type has a user-defined pool, use it as the base
+ -- storage medium for the finalization pool.
- elsif Ekind (Typ) = E_Access_Subtype then
- declare
- Base_Typ : constant Entity_Id := Base_Type (Typ);
+ if Present (Associated_Storage_Pool (Typ)) then
+ Pool_Id := Associated_Storage_Pool (Typ);
- begin
- if No (Associated_Storage_Pool (Base_Typ)) then
- Pool_Id := RTE (RE_Global_Pool_Object);
- Set_Associated_Storage_Pool (Base_Typ, Pool_Id);
- else
- Pool_Id := Associated_Storage_Pool (Base_Typ);
- end if;
- end;
+ -- Access subtypes must use the storage pool of their base type
- -- The default choice is the global pool
+ elsif Ekind (Typ) = E_Access_Subtype then
+ declare
+ Base_Typ : constant Entity_Id := Base_Type (Typ);
- else
- Pool_Id := RTE (RE_Global_Pool_Object);
- Set_Associated_Storage_Pool (Typ, Pool_Id);
- end if;
+ begin
+ if No (Associated_Storage_Pool (Base_Typ)) then
+ Pool_Id := RTE (RE_Global_Pool_Object);
+ Set_Associated_Storage_Pool (Base_Typ, Pool_Id);
+ else
+ Pool_Id := Associated_Storage_Pool (Base_Typ);
+ end if;
+ end;
- -- Generate:
- -- Set_Storage_Pool_Ptr (Fnn, Pool_Id'Unchecked_Access);
+ -- The default choice is the global pool
- Append_To (Actions,
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Reference_To (RTE (RE_Set_Storage_Pool_Ptr), Loc),
- Parameter_Associations => New_List (
- New_Reference_To (Coll_Id, Loc),
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Reference_To (Pool_Id, Loc),
- Attribute_Name => Name_Unrestricted_Access))));
+ else
+ Pool_Id := RTE (RE_Global_Pool_Object);
+ Set_Associated_Storage_Pool (Typ, Pool_Id);
+ end if;
+ -- Generate:
+ -- Set_Storage_Pool_Ptr (Fnn, Pool_Id'Unchecked_Access);
+
+ Append_To (Actions,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (RTE (RE_Set_Storage_Pool_Ptr), Loc),
+ Parameter_Associations => New_List (
+ New_Reference_To (Coll_Id, Loc),
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Reference_To (Pool_Id, Loc),
+ Attribute_Name => Name_Unrestricted_Access))));
+ end if;
+
Set_Associated_Collection (Typ, Coll_Id);
-- A finalization collection created for an anonymous access type
@@ -2586,6 +2597,8 @@
-- caller finalization chain and deallocates the object. This is
-- disabled on .NET/JVM because pools are not supported.
+ -- H505-021 This needs to be revisited on .NET/JVM
+
if VM_Target = No_VM
and then Is_Return_Object (Obj_Id)
then
@@ -4429,6 +4442,42 @@
end if;
end Make_Adjust_Call;
+ ----------------------
+ -- Make_Attach_Call --
+ ----------------------
+
+ function Make_Attach_Call
+ (Obj_Ref : Node_Id;
+ Ptr_Typ : Entity_Id) return Node_Id
+ is
+ Loc : constant Source_Ptr := Sloc (Obj_Ref);
+
+ begin
+ return
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (RTE (RE_Attach), Loc),
+ Parameter_Associations => New_List (
+ New_Reference_To (Associated_Collection (Ptr_Typ), Loc),
+ Unchecked_Convert_To (RTE (RE_Root_Controlled_Ptr), Obj_Ref)));
+ end Make_Attach_Call;
+
+ ----------------------
+ -- Make_Detach_Call --
+ ----------------------
+
+ function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id is
+ Loc : constant Source_Ptr := Sloc (Obj_Ref);
+
+ begin
+ return
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (RTE (RE_Detach), Loc),
+ Parameter_Associations => New_List (
+ Unchecked_Convert_To (RTE (RE_Root_Controlled_Ptr), Obj_Ref)));
+ end Make_Detach_Call;
+
---------------
-- Make_Call --
---------------
Index: exp_ch7.ads
===================================================================
--- exp_ch7.ads (revision 177275)
+++ exp_ch7.ads (working copy)
@@ -93,6 +93,24 @@
-- adjusted. Typ is the expected type of Obj_Ref. Flag For_Parent must be
-- set when an adjustment call is being created for field _parent.
+ function Make_Attach_Call
+ (Obj_Ref : Node_Id;
+ Ptr_Typ : Entity_Id) return Node_Id;
+ -- Create a call to prepend an object to a finalization collection. Obj_Ref
+ -- is the object, Ptr_Typ is the access type that owns the collection.
+ -- Generate the following:
+
+ -- Ada.Finalization.Heap_Managment.Attach
+ -- (<Ptr_Typ>FC,
+ -- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
+
+ function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id;
+ -- Create a call to unhook an object from an arbitrary list. Obj_Ref is the
+ -- object. Generate the following:
+
+ -- Ada.Finalization.Heap_Management.Detach
+ -- (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
+
function Make_Final_Call
(Obj_Ref : Node_Id;
Typ : Entity_Id;
Index: rtsfind.ads
===================================================================
--- rtsfind.ads (revision 177275)
+++ rtsfind.ads (working copy)
@@ -517,8 +517,10 @@
RE_Add_Offset_To_Address, -- Ada.Finalization.Heap_Management
RE_Allocate, -- Ada.Finalization.Heap_Management
+ RE_Attach, -- Ada.Finalization.Heap_Management
RE_Base_Pool, -- Ada.Finalization.Heap_Management
RE_Deallocate, -- Ada.Finalization.Heap_Management
+ RE_Detach, -- Ada.Finalization.Heap_Management
RE_Finalization_Collection, -- Ada.Finalization.Heap_Management
RE_Finalization_Collection_Ptr, -- Ada.Finalization.Heap_Management
RE_Set_Finalize_Address_Ptr, -- Ada.Finalization.Heap_Management
@@ -796,8 +798,7 @@
RE_Fat_VAX_G, -- System.Fat_VAX_G_Float
RE_Root_Controlled, -- System.Finalization_Root
- RE_Finalizable, -- System.Finalization_Root
- RE_Finalizable_Ptr, -- System.Finalization_Root
+ RE_Root_Controlled_Ptr, -- System.Finalization_Root
RE_Fore, -- System.Fore
@@ -1694,8 +1695,10 @@
RE_Add_Offset_To_Address => Ada_Finalization_Heap_Management,
RE_Allocate => Ada_Finalization_Heap_Management,
+ RE_Attach => Ada_Finalization_Heap_Management,
RE_Base_Pool => Ada_Finalization_Heap_Management,
RE_Deallocate => Ada_Finalization_Heap_Management,
+ RE_Detach => Ada_Finalization_Heap_Management,
RE_Finalization_Collection => Ada_Finalization_Heap_Management,
RE_Finalization_Collection_Ptr => Ada_Finalization_Heap_Management,
RE_Set_Finalize_Address_Ptr => Ada_Finalization_Heap_Management,
@@ -1973,8 +1976,7 @@
RE_Fat_VAX_G => System_Fat_VAX_G_Float,
RE_Root_Controlled => System_Finalization_Root,
- RE_Finalizable => System_Finalization_Root,
- RE_Finalizable_Ptr => System_Finalization_Root,
+ RE_Root_Controlled_Ptr => System_Finalization_Root,
RE_Fore => System_Fore,
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 177275)
+++ exp_ch4.adb (working copy)
@@ -840,6 +840,22 @@
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 @@
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 @@
-- 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 @@
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 @@
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 @@
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 @@
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
- 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;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 177275)
+++ exp_ch6.adb (working copy)
@@ -2015,7 +2015,8 @@
-- Local variables
- Remote : constant Boolean := Is_Remote_Call (Call_Node);
+ Curr_S : constant Entity_Id := Current_Scope;
+ Remote : constant Boolean := Is_Remote_Call (Call_Node);
Actual : Node_Id;
Formal : Entity_Id;
Orig_Subp : Entity_Id := Empty;
@@ -2105,6 +2106,52 @@
end if;
end if;
+ -- Detect the following code in Ada.Finalization.Heap_Management only
+ -- on .NET/JVM targets:
+ --
+ -- procedure Finalize (Collection : in out Finalization_Collection) is
+ -- begin
+ -- . . .
+ -- begin
+ -- Finalize (Curr_Ptr.all);
+ --
+ -- Since .NET/JVM compilers lack address arithmetic and Deep_Finalize
+ -- cannot be named in library or user code, the compiler has to install
+ -- a kludge and transform the call to Finalize into Deep_Finalize.
+
+ if VM_Target /= No_VM
+ and then Chars (Subp) = Name_Finalize
+ and then Ekind (Curr_S) = E_Block
+ and then Ekind (Scope (Curr_S)) = E_Procedure
+ and then Chars (Scope (Curr_S)) = Name_Finalize
+ and then Etype (First_Formal (Scope (Curr_S))) =
+ RTE (RE_Finalization_Collection)
+ then
+ declare
+ Deep_Fin : constant Entity_Id :=
+ Find_Prim_Op (RTE (RE_Root_Controlled),
+ TSS_Deep_Finalize);
+ begin
+ -- Since Root_Controlled is a tagged type, the compiler should
+ -- always generate Deep_Finalize for it.
+
+ pragma Assert (Present (Deep_Fin));
+
+ -- Generate:
+ -- Deep_Finalize (Curr_Ptr.all);
+
+ Rewrite (N,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (Deep_Fin, Loc),
+ Parameter_Associations =>
+ New_Copy_List_Tree (Parameter_Associations (N))));
+
+ Analyze (N);
+ return;
+ end;
+ end if;
+
-- Ada 2005 (AI-345): We have a procedure call as a triggering
-- alternative in an asynchronous select or as an entry call in
-- a conditional or timed select. Check whether the procedure call
Index: exp_ch13.adb
===================================================================
--- exp_ch13.adb (revision 177275)
+++ exp_ch13.adb (working copy)
@@ -43,6 +43,7 @@
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
+with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Validsw; use Validsw;
@@ -214,6 +215,13 @@
Typ : Entity_Id := Etype (Expr);
begin
+ -- Do not create a specialized Deallocate since .NET/JVM compilers do
+ -- not support pools and address arithmetic.
+
+ if VM_Target /= No_VM then
+ return;
+ end if;
+
-- Use the base type to perform the collection check
if Ekind (Typ) = E_Access_Subtype then
Index: exp_intr.adb
===================================================================
--- exp_intr.adb (revision 177275)
+++ exp_intr.adb (working copy)
@@ -53,6 +53,7 @@
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Urealp; use Urealp;
@@ -1009,6 +1010,16 @@
(RTE (RE_Get_Current_Excep),
Loc))))))))))));
+ -- For .NET/JVM, detach the object from the containing finalization
+ -- collection before finalizing it.
+
+ if VM_Target /= No_VM
+ and then Is_Controlled (Desig_T)
+ then
+ Prepend_To (Final_Code,
+ Make_Detach_Call (New_Copy_Tree (Arg)));
+ end if;
+
-- If aborts are allowed, then the finalization code must be
-- protected by an abort defer/undefer pair.
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 177275)
+++ snames.ads-tmpl (working copy)
@@ -195,6 +195,8 @@
Name_Adjust : constant Name_Id := N + $;
Name_Finalize : constant Name_Id := N + $;
Name_Finalize_Address : constant Name_Id := N + $;
+ Name_Next : constant Name_Id := N + $;
+ Name_Prev : constant Name_Id := N + $;
-- Names of allocation routines, also needed by expander
@@ -1202,7 +1204,6 @@
Name_Cursor : constant Name_Id := N + $;
Name_Element : constant Name_Id := N + $;
Name_Element_Type : constant Name_Id := N + $;
- Name_Next : constant Name_Id := N + $;
Name_No_Element : constant Name_Id := N + $;
Name_Previous : constant Name_Id := N + $;
More information about the Gcc-patches
mailing list