Commit 61bcf5ca by Arnaud Charlet

[multiple changes]

2010-09-09  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.ads (Find_Master_Scope): New function, extracted from
	Build_Master_Entity, to find the proper scope for the master entity of
	a type that may contain tasks, in the presence of transient scopes.
	* exp_ch9.adb (Build_Master_Entity) Use new function.
	* exp_ch3.adb (Build_Class_Wide_Master): ditto.

2010-09-09  Vincent Celier  <celier@adacore.com>

	* prj-attr.adb: Add new attributes Leading_Library_Options and
	Linker'Leading_Switches.
	* snames.ads-tmpl: Add new standard names Leading_Library_Options and
	Leading_Switches.

From-SVN: r164060
parent 0052da20
2010-09-09 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.ads (Find_Master_Scope): New function, extracted from
Build_Master_Entity, to find the proper scope for the master entity of
a type that may contain tasks, in the presence of transient scopes.
* exp_ch9.adb (Build_Master_Entity) Use new function.
* exp_ch3.adb (Build_Class_Wide_Master): ditto.
2010-09-09 Vincent Celier <celier@adacore.com>
* prj-attr.adb: Add new attributes Leading_Library_Options and
Linker'Leading_Switches.
* snames.ads-tmpl: Add new standard names Leading_Library_Options and
Leading_Switches.
2010-09-09 Javier Miranda <miranda@adacore.com> 2010-09-09 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Derive_Subprogram): The code that checks if a * sem_ch3.adb (Derive_Subprogram): The code that checks if a
......
...@@ -41,8 +41,8 @@ with Exp_Strm; use Exp_Strm; ...@@ -41,8 +41,8 @@ with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
with Freeze; use Freeze; with Freeze; use Freeze;
with Nlists; use Nlists;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
with Restrict; use Restrict; with Restrict; use Restrict;
...@@ -792,6 +792,7 @@ package body Exp_Ch3 is ...@@ -792,6 +792,7 @@ package body Exp_Ch3 is
Decl : Node_Id; Decl : Node_Id;
P : Node_Id; P : Node_Id;
Par : Node_Id; Par : Node_Id;
Scop : Entity_Id;
begin begin
-- Nothing to do if there is no task hierarchy -- Nothing to do if there is no task hierarchy
...@@ -810,9 +811,11 @@ package body Exp_Ch3 is ...@@ -810,9 +811,11 @@ package body Exp_Ch3 is
P := Parent (T); P := Parent (T);
end if; end if;
Scop := Find_Master_Scope (T);
-- Nothing to do if we already built a master entity for this scope -- Nothing to do if we already built a master entity for this scope
if not Has_Master_Entity (Scope (T)) then if not Has_Master_Entity (Scop) then
-- First build the master entity -- First build the master entity
-- _Master : constant Master_Id := Current_Master.all; -- _Master : constant Master_Id := Current_Master.all;
...@@ -828,9 +831,9 @@ package body Exp_Ch3 is ...@@ -828,9 +831,9 @@ package body Exp_Ch3 is
Make_Explicit_Dereference (Loc, Make_Explicit_Dereference (Loc,
New_Reference_To (RTE (RE_Current_Master), Loc))); New_Reference_To (RTE (RE_Current_Master), Loc)));
Set_Has_Master_Entity (Scop);
Insert_Action (P, Decl); Insert_Action (P, Decl);
Analyze (Decl); Analyze (Decl);
Set_Has_Master_Entity (Scope (T));
-- Now mark the containing scope as a task master. Masters -- Now mark the containing scope as a task master. Masters
-- associated with return statements are already marked at -- associated with return statements are already marked at
......
...@@ -2481,31 +2481,7 @@ package body Exp_Ch9 is ...@@ -2481,31 +2481,7 @@ package body Exp_Ch9 is
S : Entity_Id; S : Entity_Id;
begin begin
S := Scope (E); S := Find_Master_Scope (E);
-- Ada 2005 (AI-287): Do not set/get the has_master_entity reminder
-- in internal scopes, unless present already.. Required for nested
-- limited aggregates, where the expansion of task components may
-- generate inner blocks. If the block is the rewriting of a call
-- or the scope is an extended return statement this is valid master.
-- The master in an extended return is only used within the return,
-- and is subsequently overwritten in Move_Activation_Chain, but it
-- must exist now.
if Ada_Version >= Ada_05 then
while Is_Internal (S) loop
if Nkind (Parent (S)) = N_Block_Statement
and then
Nkind (Original_Node (Parent (S))) = N_Procedure_Call_Statement
then
exit;
elsif Ekind (S) = E_Return_Statement then
exit;
else
S := Scope (S);
end if;
end loop;
end if;
-- Nothing to do if we already built a master entity for this scope -- Nothing to do if we already built a master entity for this scope
-- or if there is no task hierarchy. -- or if there is no task hierarchy.
...@@ -2534,14 +2510,7 @@ package body Exp_Ch9 is ...@@ -2534,14 +2510,7 @@ package body Exp_Ch9 is
Insert_Before (P, Decl); Insert_Before (P, Decl);
Analyze (Decl); Analyze (Decl);
-- Ada 2005 (AI-287): Set the has_master_entity reminder in the Set_Has_Master_Entity (S);
-- non-internal scope selected above.
if Ada_Version >= Ada_05 then
Set_Has_Master_Entity (S);
else
Set_Has_Master_Entity (Scope (E));
end if;
-- Now mark the containing scope as a task master -- Now mark the containing scope as a task master
...@@ -11136,6 +11105,43 @@ package body Exp_Ch9 is ...@@ -11136,6 +11105,43 @@ package body Exp_Ch9 is
Make_Integer_Literal (Loc, 0))); Make_Integer_Literal (Loc, 0)));
end Family_Size; end Family_Size;
-----------------------
-- Find_Master_Scope --
-----------------------
function Find_Master_Scope (E : Entity_Id) return Entity_Id is
S : Entity_Id;
begin
-- In Ada2005, the master is the innermost enclosing scope that is not
-- transient. If the enclosing block is the rewriting of a call or the
-- scope is an extended return statement this is valid master. The
-- master in an extended return is only used within the return, and is
-- subsequently overwritten in Move_Activation_Chain, but it must exist
-- now before that overwriting occurs.
S := Scope (E);
if Ada_Version >= Ada_05 then
while Is_Internal (S) loop
if Nkind (Parent (S)) = N_Block_Statement
and then
Nkind (Original_Node (Parent (S))) = N_Procedure_Call_Statement
then
exit;
elsif Ekind (S) = E_Return_Statement then
exit;
else
S := Scope (S);
end if;
end loop;
end if;
return S;
end Find_Master_Scope;
----------------------------------- -----------------------------------
-- Find_Task_Or_Protected_Pragma -- -- Find_Task_Or_Protected_Pragma --
----------------------------------- -----------------------------------
......
...@@ -263,6 +263,15 @@ package Exp_Ch9 is ...@@ -263,6 +263,15 @@ package Exp_Ch9 is
-- return the external version of a protected operation, which locks -- return the external version of a protected operation, which locks
-- the object before invoking the internal protected subprogram body. -- the object before invoking the internal protected subprogram body.
function Find_Master_Scope (E : Entity_Id) return Entity_Id;
-- When a type includes tasks, a master entity is created in the scope, to
-- be used by the runtime during activation. In general the master is the
-- immediate scope in which the type is declared, but in Ada2005, in the
-- presence of synchronized classwide interfaces, the immediate scope of
-- an anonymous access type may be a transient scope, which has no run-time
-- presence. In this case, the scope of the master is the innermost scope
-- that comes from source.
function First_Protected_Operation (D : List_Id) return Node_Id; function First_Protected_Operation (D : List_Id) return Node_Id;
-- Given the declarations list for a protected body, find the -- Given the declarations list for a protected body, find the
-- first protected operation body. -- first protected operation body.
......
...@@ -99,6 +99,7 @@ package body Prj.Attr is ...@@ -99,6 +99,7 @@ package body Prj.Attr is
"SVlibrary_version#" & "SVlibrary_version#" &
"LVlibrary_interface#" & "LVlibrary_interface#" &
"SVlibrary_auto_init#" & "SVlibrary_auto_init#" &
"LVleading_library_options#" &
"LVlibrary_options#" & "LVlibrary_options#" &
"SVlibrary_src_dir#" & "SVlibrary_src_dir#" &
"SVlibrary_ali_dir#" & "SVlibrary_ali_dir#" &
...@@ -246,6 +247,7 @@ package body Prj.Attr is ...@@ -246,6 +247,7 @@ package body Prj.Attr is
"Plinker#" & "Plinker#" &
"LVrequired_switches#" & "LVrequired_switches#" &
"Ladefault_switches#" & "Ladefault_switches#" &
"LcOleading_switches#" &
"LcOswitches#" & "LcOswitches#" &
"LVlinker_options#" & "LVlinker_options#" &
"SVmap_file_option#" & "SVmap_file_option#" &
......
...@@ -1075,7 +1075,9 @@ package Snames is ...@@ -1075,7 +1075,9 @@ package Snames is
Name_Include_Path_File : constant Name_Id := N + $; Name_Include_Path_File : constant Name_Id := N + $;
Name_Inherit_Source_Path : constant Name_Id := N + $; Name_Inherit_Source_Path : constant Name_Id := N + $;
Name_Languages : constant Name_Id := N + $; Name_Languages : constant Name_Id := N + $;
Name_Leading_Library_Options : constant Name_Id := N + $;
Name_Leading_Required_Switches : constant Name_Id := N + $; Name_Leading_Required_Switches : constant Name_Id := N + $;
Name_Leading_Switches : constant Name_Id := N + $;
Name_Library : constant Name_Id := N + $; Name_Library : constant Name_Id := N + $;
Name_Library_Ali_Dir : constant Name_Id := N + $; Name_Library_Ali_Dir : constant Name_Id := N + $;
Name_Library_Auto_Init : constant Name_Id := N + $; Name_Library_Auto_Init : 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