Commit deb8dacc by Hristian Kirtchev Committed by Arnaud Charlet

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
parent df3e68b1
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.
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
* a-except.adb, a-except-2005.adb (Raise_From_Controlled_Operation):
Rewritten to create the message strings when the exception is not
raised by an abort during finalization.
......
......@@ -37,6 +37,7 @@ with GNAT.IO; use GNAT.IO;
with System; use System;
with System.Address_Image;
with System.Soft_Links; use System.Soft_Links;
with System.Storage_Elements; use System.Storage_Elements;
with System.Storage_Pools; use System.Storage_Pools;
......@@ -135,10 +136,18 @@ package body Ada.Finalization.Heap_Management is
procedure Attach (N : Node_Ptr; L : Node_Ptr) is
begin
Lock_Task.all;
L.Next.Prev := N;
N.Next := L.Next;
L.Next := N;
N.Prev := L;
Unlock_Task.all;
exception
when others =>
Unlock_Task.all;
raise;
end Attach;
---------------
......@@ -209,6 +218,8 @@ package body Ada.Finalization.Heap_Management is
procedure Detach (N : Node_Ptr) is
begin
Lock_Task.all;
if N.Prev /= null
and then N.Next /= null
then
......@@ -217,6 +228,12 @@ package body Ada.Finalization.Heap_Management is
N.Prev := null;
N.Next := null;
end if;
Unlock_Task.all;
exception
when others =>
Unlock_Task.all;
raise;
end Detach;
--------------
......
......@@ -43,6 +43,7 @@ with Sem_Eval; use Sem_Eval;
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 @@ package body Exp_Ch13 is
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
......
......@@ -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;
......
......@@ -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
......
......@@ -2015,7 +2015,8 @@ package body Exp_Ch6 is
-- 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 @@ package body Exp_Ch6 is
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
......
......@@ -896,9 +896,13 @@ package body Exp_Ch7 is
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,47 +937,54 @@ package body Exp_Ch7 is
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);
......@@ -2586,6 +2597,8 @@ package body Exp_Ch7 is
-- 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 @@ package body Exp_Ch7 is
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 --
---------------
......
......@@ -93,6 +93,24 @@ package Exp_Ch7 is
-- 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;
......
......@@ -53,6 +53,7 @@ with Sinput; use Sinput;
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 @@ package body Exp_Intr is
(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.
......
......@@ -517,8 +517,10 @@ package Rtsfind is
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 @@ package Rtsfind is
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 @@ package Rtsfind is
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 @@ package Rtsfind is
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,
......
......@@ -195,6 +195,8 @@ package Snames is
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 @@ package Snames is
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 + $;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment