Commit 2bfa5484 by Hristian Kirtchev Committed by Arnaud Charlet

exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Do not create TSS routine…

exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Do not create TSS routine Finalize_Address when compiling in Alfa mode.

2011-09-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Do not create
	TSS routine Finalize_Address when compiling in Alfa mode.
	(Expand_Freeze_Record_Type): Do not create TSS routine
	Finalize_Address when compiling in Alfa mode.
	* exp_ch4.adb (Expand_Allocator_Expression): Do not produce a
	call to Set_Finalize_Address in Alfa mode because Finalize_Address is
	not built.
	(Expand_N_Allocator): Do not produce a call to
	Set_Finalize_Address in Alfa mode because Finalize_Address is not built.
	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Do not
	produce a call to primitive Set_Finalize_Address in Alfa mode because
	Finalize_Address is not built.
	* exp_ch7.adb (Build_Finalization_Master): Do not create
	finalization masters in Afa mode since they are not needed.
	(Build_Finalizer): Do not create scope and library-level
	finalizers in Alfa mode since they are not needed.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Do not expand
	"new" and "free" when applied to controlled objects in Alfa mode since
	this is not needed.

From-SVN: r178456
parent 7a0ddd20
2011-09-02 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Expand_Freeze_Class_Wide_Type): Do not create
TSS routine Finalize_Address when compiling in Alfa mode.
(Expand_Freeze_Record_Type): Do not create TSS routine
Finalize_Address when compiling in Alfa mode.
* exp_ch4.adb (Expand_Allocator_Expression): Do not produce a
call to Set_Finalize_Address in Alfa mode because Finalize_Address is
not built.
(Expand_N_Allocator): Do not produce a call to
Set_Finalize_Address in Alfa mode because Finalize_Address is not built.
* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Do not
produce a call to primitive Set_Finalize_Address in Alfa mode because
Finalize_Address is not built.
* exp_ch7.adb (Build_Finalization_Master): Do not create
finalization masters in Afa mode since they are not needed.
(Build_Finalizer): Do not create scope and library-level
finalizers in Alfa mode since they are not needed.
* exp_util.adb (Build_Allocate_Deallocate_Proc): Do not expand
"new" and "free" when applied to controlled objects in Alfa mode since
this is not needed.
2011-09-02 Vincent Celier <celier@adacore.com> 2011-09-02 Vincent Celier <celier@adacore.com>
* prj-nmsc.db: (Check_Stand_Alone_Library): For SALs, allow * prj-nmsc.db: (Check_Stand_Alone_Library): For SALs, allow
......
...@@ -5634,6 +5634,12 @@ package body Exp_Ch3 is ...@@ -5634,6 +5634,12 @@ package body Exp_Ch3 is
elsif CodePeer_Mode then elsif CodePeer_Mode then
return; return;
-- Do not create TSS routine Finalize_Address when compiling in Alfa
-- mode because it is not necessary and results in useless expansion.
elsif Alfa_Mode then
return;
end if; end if;
-- Create the body of TSS primitive Finalize_Address. This automatically -- Create the body of TSS primitive Finalize_Address. This automatically
...@@ -6379,11 +6385,14 @@ package body Exp_Ch3 is ...@@ -6379,11 +6385,14 @@ package body Exp_Ch3 is
-- Create the body of TSS primitive Finalize_Address. This must -- Create the body of TSS primitive Finalize_Address. This must
-- be done before the bodies of all predefined primitives are -- be done before the bodies of all predefined primitives are
-- created. If Def_Id is limited, Stream_Input and Streap_Read -- created. If Def_Id is limited, Stream_Input and Stream_Read
-- may produce build-in-place allocations and for that the -- may produce build-in-place allocations and for those the
-- expander needs Finalize_Address. -- expander needs Finalize_Address. Do not create the body of
-- Finalize_Address in Alfa mode since it is not needed.
Make_Finalize_Address_Body (Def_Id); if not Alfa_Mode then
Make_Finalize_Address_Body (Def_Id);
end if;
Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq); Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq);
Append_Freeze_Actions (Def_Id, Predef_List); Append_Freeze_Actions (Def_Id, Predef_List);
......
...@@ -1149,12 +1149,19 @@ package body Exp_Ch4 is ...@@ -1149,12 +1149,19 @@ package body Exp_Ch4 is
-- Generate: -- Generate:
-- Set_Finalize_Address (<PtrT>FM, <T>FD'Unrestricted_Access); -- Set_Finalize_Address (<PtrT>FM, <T>FD'Unrestricted_Access);
-- Since .NET/JVM compilers do not support address arithmetic, -- Do not generate this call in the following cases:
-- this call is skipped. The same is done for CodePeer because --
-- primitive Finalize_Address is never generated. Do not create -- * .NET/JVM - these targets do not support address arithmetic
-- this call if there is no allocator available any more. -- and unchecked conversion, key elements of Finalize_Address.
--
-- * Alfa mode - the call is useless and results in unwanted
-- expansion.
--
-- * CodePeer mode - TSS primitive Finalize_Address is not
-- created in this mode.
if VM_Target = No_VM if VM_Target = No_VM
and then not Alfa_Mode
and then not CodePeer_Mode and then not CodePeer_Mode
and then Present (Finalization_Master (PtrT)) and then Present (Finalization_Master (PtrT))
and then Present (Temp_Decl) and then Present (Temp_Decl)
...@@ -3481,9 +3488,12 @@ package body Exp_Ch4 is ...@@ -3481,9 +3488,12 @@ package body Exp_Ch4 is
end if; end if;
-- The finalization master must be inserted and analyzed as part of -- The finalization master must be inserted and analyzed as part of
-- the current semantic unit. -- the current semantic unit. This form of expansion is not carried
-- out in Alfa mode because it is useless.
if No (Finalization_Master (PtrT)) then if No (Finalization_Master (PtrT))
and then not Alfa_Mode
then
Set_Finalization_Master (PtrT, Current_Anonymous_Master); Set_Finalization_Master (PtrT, Current_Anonymous_Master);
end if; end if;
end if; end if;
...@@ -3979,10 +3989,17 @@ package body Exp_Ch4 is ...@@ -3979,10 +3989,17 @@ package body Exp_Ch4 is
-- Set_Finalize_Address -- Set_Finalize_Address
-- (<PtrT>FM, <T>FD'Unrestricted_Access); -- (<PtrT>FM, <T>FD'Unrestricted_Access);
-- Do not generate the above for CodePeer compilations -- Do not generate this call in the following cases:
-- because primitive Finalize_Address is never built. --
-- * Alfa mode - the call is useless and results in
-- unwanted expansion.
--
-- * CodePeer mode - TSS primitive Finalize_Address is
-- not created in this mode.
elsif not CodePeer_Mode then elsif not Alfa_Mode
and then not CodePeer_Mode
then
Insert_Action (N, Insert_Action (N,
Make_Set_Finalize_Address_Call Make_Set_Finalize_Address_Call
(Loc => Loc, (Loc => Loc,
......
...@@ -6519,7 +6519,7 @@ package body Exp_Ch6 is ...@@ -6519,7 +6519,7 @@ package body Exp_Ch6 is
begin begin
-- Ada 2005 (AI-251): In class-wide interface objects we displace -- Ada 2005 (AI-251): In class-wide interface objects we displace
-- "this" to reference the base of the object --- required to get -- "this" to reference the base of the object required to get
-- access to the TSD of the object. -- access to the TSD of the object.
if Is_Class_Wide_Type (Etype (Exp)) if Is_Class_Wide_Type (Etype (Exp))
...@@ -7245,10 +7245,14 @@ package body Exp_Ch6 is ...@@ -7245,10 +7245,14 @@ package body Exp_Ch6 is
then then
null; null;
-- Do not generate the call to Make_Set_Finalize_Address for -- Do not generate the call to Set_Finalize_Address in Alfa mode
-- CodePeer compilations because Finalize_Address is never built. -- because it is not necessary and results in unwanted expansion.
-- This expansion is also not carried out in CodePeer mode because
-- Finalize_Address is never built.
elsif not CodePeer_Mode then elsif not Alfa_Mode
and then not CodePeer_Mode
then
Insert_Action (Allocator, Insert_Action (Allocator,
Make_Set_Finalize_Address_Call (Loc, Make_Set_Finalize_Address_Call (Loc,
Typ => Etype (Function_Id), Typ => Etype (Function_Id),
......
...@@ -888,6 +888,12 @@ package body Exp_Ch7 is ...@@ -888,6 +888,12 @@ package body Exp_Ch7 is
and then not Is_Controlled (Desig_Typ) and then not Is_Controlled (Desig_Typ)
then then
return; return;
-- Do not create finalization masters in Alfa mode because they result
-- in unwanted expansion.
elsif Alfa_Mode then
return;
end if; end if;
declare declare
...@@ -2689,6 +2695,13 @@ package body Exp_Ch7 is ...@@ -2689,6 +2695,13 @@ package body Exp_Ch7 is
begin begin
Fin_Id := Empty; Fin_Id := Empty;
-- Do not perform this expansion in Alfa mode because it is not
-- necessary.
if Alfa_Mode then
return;
end if;
-- Step 1: Extract all lists which may contain controlled objects or -- Step 1: Extract all lists which may contain controlled objects or
-- library-level tagged types. -- library-level tagged types.
...@@ -2844,6 +2857,13 @@ package body Exp_Ch7 is ...@@ -2844,6 +2857,13 @@ package body Exp_Ch7 is
-- which belongs to a protected type. -- which belongs to a protected type.
begin begin
-- Do not perform this expansion in Alfa mode because we do not create
-- finalizers in the first place.
if Alfa_Mode then
return;
end if;
-- The At_End handler should have been assimilated by the finalizer -- The At_End handler should have been assimilated by the finalizer
pragma Assert (No (At_End_Proc (HSS))); pragma Assert (No (At_End_Proc (HSS)));
......
...@@ -480,6 +480,13 @@ package body Exp_Util is ...@@ -480,6 +480,13 @@ package body Exp_Util is
-- Start of processing for Build_Allocate_Deallocate_Proc -- Start of processing for Build_Allocate_Deallocate_Proc
begin begin
-- Do not perform this expansion in Alfa mode because it is not
-- necessary.
if Alfa_Mode then
return;
end if;
-- Obtain the attributes of the allocation / deallocation -- Obtain the attributes of the allocation / deallocation
if Nkind (N) = N_Free_Statement then if Nkind (N) = N_Free_Statement then
......
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