Commit fecbd779 by Arnaud Charlet

[multiple changes]

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* s-taskin.ads, s-tassta.adb, sem_ch13.adb: Minor reformatting.

2011-09-01  Thomas Quinot  <quinot@adacore.com>

	* Makefile.rtl: Move s-oscons.o from GNATRTL_TASKING_OBJS to
	GNATRTL_NONTASKING_OBJS.

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* einfo.ads (Is_Aliased): Fix existing documentation and add note on
	possibility of this flag being set for formals in Ada 2012 mode.
	* par-ch6.adb (P_Formal_Part): Handle aliased for parameters for Ada
	2012.
	* sem_ch6.adb (Process_Formals): Handle aliased parameters in Ada 2012
	mode.
	* sinfo.adb (Aliased_Present): Allowed in N_Parameter_Specification for
	Ada 2012.
	* sinfo.ads (Aliased_Present): Allowed in N_Parameter_Specification for
	Ada 2012.

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

	* exp_ch4.adb (Find_Insertion_Node): New routine. Determines the proper
	insertion node in a tree of nested Expression_With_Actions nodes.
	(Process_Transient_Object): In the case where a complex if statement
	has been converted into nested Expression_With_Actions nodes, the
	"hook" object and the associated access type must be inserted before
	the top most Expression_With_Actions.

From-SVN: r178401
parent 516f608f
2011-09-01 Robert Dewar <dewar@adacore.com> 2011-09-01 Robert Dewar <dewar@adacore.com>
* s-taskin.ads, s-tassta.adb, sem_ch13.adb: Minor reformatting.
2011-09-01 Thomas Quinot <quinot@adacore.com>
* Makefile.rtl: Move s-oscons.o from GNATRTL_TASKING_OBJS to
GNATRTL_NONTASKING_OBJS.
2011-09-01 Robert Dewar <dewar@adacore.com>
* einfo.ads (Is_Aliased): Fix existing documentation and add note on
possibility of this flag being set for formals in Ada 2012 mode.
* par-ch6.adb (P_Formal_Part): Handle aliased for parameters for Ada
2012.
* sem_ch6.adb (Process_Formals): Handle aliased parameters in Ada 2012
mode.
* sinfo.adb (Aliased_Present): Allowed in N_Parameter_Specification for
Ada 2012.
* sinfo.ads (Aliased_Present): Allowed in N_Parameter_Specification for
Ada 2012.
2011-09-01 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Find_Insertion_Node): New routine. Determines the proper
insertion node in a tree of nested Expression_With_Actions nodes.
(Process_Transient_Object): In the case where a complex if statement
has been converted into nested Expression_With_Actions nodes, the
"hook" object and the associated access type must be inserted before
the top most Expression_With_Actions.
2011-09-01 Robert Dewar <dewar@adacore.com>
* a-cbprqu.adb, a-cbprqu.ads, a-cuprqu.adb, a-cuprqu.ads, * a-cbprqu.adb, a-cbprqu.ads, a-cuprqu.adb, a-cuprqu.ads,
a-cbsyqu.adb, a-cbsyqu.ads: Minor reformatting. a-cbsyqu.adb, a-cbsyqu.ads: Minor reformatting.
......
...@@ -49,7 +49,6 @@ GNATRTL_TASKING_OBJS= \ ...@@ -49,7 +49,6 @@ GNATRTL_TASKING_OBJS= \
s-interr$(objext) \ s-interr$(objext) \
s-intman$(objext) \ s-intman$(objext) \
s-mudido$(objext) \ s-mudido$(objext) \
s-oscons$(objext) \
s-osinte$(objext) \ s-osinte$(objext) \
s-proinf$(objext) \ s-proinf$(objext) \
s-solita$(objext) \ s-solita$(objext) \
...@@ -542,6 +541,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -542,6 +541,7 @@ GNATRTL_NONTASKING_OBJS= \
s-memory$(objext) \ s-memory$(objext) \
s-multip$(objext) \ s-multip$(objext) \
s-os_lib$(objext) \ s-os_lib$(objext) \
s-oscons$(objext) \
s-osprim$(objext) \ s-osprim$(objext) \
s-pack03$(objext) \ s-pack03$(objext) \
s-pack05$(objext) \ s-pack05$(objext) \
......
...@@ -1997,8 +1997,9 @@ package Einfo is ...@@ -1997,8 +1997,9 @@ package Einfo is
-- of pragma Ada_12 or Ada_2012. -- of pragma Ada_12 or Ada_2012.
-- Is_Aliased (Flag15) -- Is_Aliased (Flag15)
-- Present in objects whose declarations carry the keyword aliased, -- Present in all entities. Set for objects and types whose declarations
-- and on record components that have the keyword. -- carry the keyword aliased, and on record components that have the
-- keyword. For Ada 2012, also applies to formal parameters.
-- Is_AST_Entry (Flag132) -- Is_AST_Entry (Flag132)
-- Present in entry entities. Set if a valid pragma AST_Entry applies -- Present in entry entities. Set if a valid pragma AST_Entry applies
...@@ -4773,6 +4774,7 @@ package Einfo is ...@@ -4773,6 +4774,7 @@ package Einfo is
-- Is_Ada_2005_Only (Flag185) -- Is_Ada_2005_Only (Flag185)
-- Is_Ada_2012_Only (Flag199) -- Is_Ada_2012_Only (Flag199)
-- Is_Bit_Packed_Array (Flag122) (base type only) -- Is_Bit_Packed_Array (Flag122) (base type only)
-- Is_Aliased (Flag15)
-- Is_Character_Type (Flag63) -- Is_Character_Type (Flag63)
-- Is_Child_Unit (Flag73) -- Is_Child_Unit (Flag73)
-- Is_Compilation_Unit (Flag149) -- Is_Compilation_Unit (Flag149)
...@@ -4994,7 +4996,6 @@ package Einfo is ...@@ -4994,7 +4996,6 @@ package Einfo is
-- Component_Alignment (special) (base type only) -- Component_Alignment (special) (base type only)
-- Has_Component_Size_Clause (Flag68) (base type only) -- Has_Component_Size_Clause (Flag68) (base type only)
-- Has_Pragma_Pack (Flag121) (impl base type only) -- Has_Pragma_Pack (Flag121) (impl base type only)
-- Is_Aliased (Flag15)
-- Is_Constrained (Flag12) -- Is_Constrained (Flag12)
-- Next_Index (synth) -- Next_Index (synth)
-- Number_Dimensions (synth) -- Number_Dimensions (synth)
......
...@@ -4415,10 +4415,32 @@ package body Exp_Ch4 is ...@@ -4415,10 +4415,32 @@ package body Exp_Ch4 is
------------------------------ ------------------------------
procedure Process_Transient_Object (Decl : Node_Id) is procedure Process_Transient_Object (Decl : Node_Id) is
Ins_Nod : constant Node_Id := Parent (N);
-- To avoid the insertion of generated code in the list of Actions,
-- Insert_Action must look at the parent field of the EWA.
function Find_Insertion_Node return Node_Id;
-- Complex if statements may be converted into nested EWAs. In this
-- case, any generated code must be inserted before the if statement
-- to ensure proper visibility of the "hook" objects. This routine
-- returns the top most short circuit operator or the parent of the
-- EWA if no nesting was detected.
-------------------------
-- Find_Insertion_Node --
-------------------------
function Find_Insertion_Node return Node_Id is
Par : Node_Id := N;
begin
-- Climb up the branches of a complex if statement
while Nkind_In (Parent (Par), N_And_Then, N_Op_Not, N_Or_Else) loop
Par := Parent (Par);
end loop;
return Par;
end Find_Insertion_Node;
Ins_Nod : constant Node_Id := Find_Insertion_Node;
Loc : constant Source_Ptr := Sloc (Decl); Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl); Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Entity_Id := Etype (Obj_Id); Obj_Typ : constant Entity_Id := Etype (Obj_Id);
......
...@@ -1186,8 +1186,8 @@ package body Ch6 is ...@@ -1186,8 +1186,8 @@ package body Ch6 is
-- FORMAL_PART ::= (PARAMETER_SPECIFICATION {; PARAMETER_SPECIFICATION}) -- FORMAL_PART ::= (PARAMETER_SPECIFICATION {; PARAMETER_SPECIFICATION})
-- PARAMETER_SPECIFICATION ::= -- PARAMETER_SPECIFICATION ::=
-- DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK -- DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION]
-- [:= DEFAULT_EXPRESSION] -- SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
-- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION -- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
-- [:= DEFAULT_EXPRESSION] -- [:= DEFAULT_EXPRESSION]
...@@ -1195,6 +1195,8 @@ package body Ch6 is ...@@ -1195,6 +1195,8 @@ package body Ch6 is
-- that the initial token is a left parenthesis, and skipped past it, so -- that the initial token is a left parenthesis, and skipped past it, so
-- that on entry Token is the first token following the left parenthesis. -- that on entry Token is the first token following the left parenthesis.
-- Note: The ALIASED keyword is allowed only in Ada 2012 mode (AI 142)
-- Error recovery: cannot raise Error_Resync -- Error recovery: cannot raise Error_Resync
function P_Formal_Part return List_Id is function P_Formal_Part return List_Id is
...@@ -1235,9 +1237,11 @@ package body Ch6 is ...@@ -1235,9 +1237,11 @@ package body Ch6 is
if Token /= Tok_Comma then if Token /= Tok_Comma then
-- Assume colon if IN or OUT keyword found -- Assume colon if ALIASED, IN or OUT keyword found
exit Ident_Loop when Token = Tok_In or else Token = Tok_Out; exit Ident_Loop when Token = Tok_Aliased or else
Token = Tok_In or else
Token = Tok_Out;
-- Otherwise scan ahead -- Otherwise scan ahead
...@@ -1303,6 +1307,18 @@ package body Ch6 is ...@@ -1303,6 +1307,18 @@ package body Ch6 is
New_Node (N_Parameter_Specification, Ident_Sloc); New_Node (N_Parameter_Specification, Ident_Sloc);
Set_Defining_Identifier (Specification_Node, Idents (Ident)); Set_Defining_Identifier (Specification_Node, Idents (Ident));
-- Scan possible ALIASED for Ada 2012 (AI-142)
if Token = Tok_Aliased then
if Ada_Version < Ada_2012 then
Error_Msg_SC ("ALIASED parameter is an Ada2012 feature");
else
Set_Aliased_Present (Specification_Node);
end if;
Scan; -- past ALIASED
end if;
-- Scan possible NOT NULL for Ada 2005 (AI-231, AI-447) -- Scan possible NOT NULL for Ada 2005 (AI-231, AI-447)
Not_Null_Sloc := Token_Ptr; Not_Null_Sloc := Token_Ptr;
......
...@@ -415,22 +415,24 @@ package System.Tasking is ...@@ -415,22 +415,24 @@ package System.Tasking is
-- We need to store whether there are tasks allocated to concrete -- We need to store whether there are tasks allocated to concrete
-- processors in the default system dispatching domain because we need to -- processors in the default system dispatching domain because we need to
-- check it before creating a new dispatching domain. Two comments about -- check it before creating a new dispatching domain. Two comments about
-- the reason why we use a pointer here and not in package -- why we use a pointer here and not in package Dispatching_Domains:
-- Dispatching_Domains. --
-- 1) We use an array created dynamically in procedure Initialize which is -- 1) We use an array created dynamically in procedure Initialize which
-- called at the beginning of the initialization of the run-time library. -- is called at the beginning of the initialization of the run-time
-- Declaring a static array here in the spec would not work across -- library. Declaring a static array here in the spec would not work
-- different installations because it would get the value of Number_Of_CPUs -- across different installations because it would get the value of
-- from the machine where the run-time library is built, and not from the -- Number_Of_CPUs from the machine where the run-time library is built,
-- machine where the application is executed. That is the reason why we -- and not from the machine where the application is executed. That is
-- create the array (CPU'First .. Number_Of_CPUs) at execution time in the -- the reason why we create the array (CPU'First .. Number_Of_CPUs) at
-- procedure body, ensuring that the function Number_Of_CPUs is executed at -- execution time in the procedure body, ensuring that the function
-- execution time (the same trick as we use for System_Domain). -- Number_Of_CPUs is executed at execution time (the same trick as we
-- 2) We have moved this declaration from package Dispatching_Domains -- use for System_Domain).
-- because when we use a pragma CPU, the affinity is passed through the --
-- call to Create_Task. Hence, at this point, we may need to update the -- 2) We have moved this declaration from package Dispatching_Domains
-- number of tasks associated to the processor, but we do not want to force -- because when we use a pragma CPU, the affinity is passed through the
-- a dependency from this package on Dispatching_Domains. -- call to Create_Task. Hence, at this point, we may need to update the
-- number of tasks associated to the processor, but we do not want to
-- force a dependency from this package on Dispatching_Domains.
------------------------------------ ------------------------------------
-- Task related other definitions -- -- Task related other definitions --
......
...@@ -659,21 +659,21 @@ package body System.Tasking.Stages is ...@@ -659,21 +659,21 @@ package body System.Tasking.Stages is
-- The CPU associated to the task (if any) must belong to the -- The CPU associated to the task (if any) must belong to the
-- dispatching domain. -- dispatching domain.
if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
(Base_CPU not in T.Common.Domain'Range and then
or else not T.Common.Domain (Base_CPU)) (Base_CPU not in T.Common.Domain'Range
or else not T.Common.Domain (Base_CPU))
then then
Initialization.Undefer_Abort_Nestable (Self_ID); Initialization.Undefer_Abort_Nestable (Self_ID);
raise Tasking_Error with "CPU not in dispatching domain"; raise Tasking_Error with "CPU not in dispatching domain";
end if; end if;
-- In order to handle the interaction between pragma CPU and -- To handle the interaction between pragma CPU and dispatching domains
-- dispatching domains we need to signal that this task is being -- we need to signal that this task is being allocated to a processor.
-- allocated to a processor. This is needed only for tasks belonging to -- This is needed only for tasks belonging to the system domain (the
-- the system domain (the creation of new dispatching domains can only -- creation of new dispatching domains can only take processors from the
-- take processors from the system domain) and only before the -- system domain) and only before the environment task calls the main
-- environment task calls the main procedure (dispatching domains cannot -- procedure (dispatching domains cannot be created after this).
-- be created after this).
if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
and then T.Common.Domain = System.Tasking.System_Domain and then T.Common.Domain = System.Tasking.System_Domain
...@@ -686,9 +686,8 @@ package body System.Tasking.Stages is ...@@ -686,9 +686,8 @@ package body System.Tasking.Stages is
Dispatching_Domain_Tasks (Base_CPU) + 1; Dispatching_Domain_Tasks (Base_CPU) + 1;
end if; end if;
-- Note: we should not call 'new' while holding locks since new -- Note: we should not call 'new' while holding locks since new may use
-- may use locks (e.g. RTS_Lock under Windows) itself and cause a -- locks (e.g. RTS_Lock under Windows) itself and cause a deadlock.
-- deadlock.
if Build_Entry_Names then if Build_Entry_Names then
T.Entry_Names := T.Entry_Names :=
......
...@@ -1152,9 +1152,10 @@ package body Sem_Ch13 is ...@@ -1152,9 +1152,10 @@ package body Sem_Ch13 is
when Aspect_Priority | when Aspect_Priority |
Aspect_Interrupt_Priority | Aspect_Interrupt_Priority |
Aspect_Dispatching_Domain | Aspect_Dispatching_Domain |
Aspect_CPU => Aspect_CPU =>
declare declare
Pname : Name_Id; Pname : Name_Id;
begin begin
if A_Id = Aspect_Priority then if A_Id = Aspect_Priority then
Pname := Name_Priority; Pname := Name_Priority;
...@@ -1505,7 +1506,7 @@ package body Sem_Ch13 is ...@@ -1505,7 +1506,7 @@ package body Sem_Ch13 is
when Aspect_Priority | when Aspect_Priority |
Aspect_Interrupt_Priority | Aspect_Interrupt_Priority |
Aspect_Dispatching_Domain | Aspect_Dispatching_Domain |
Aspect_CPU => Aspect_CPU =>
declare declare
T : Node_Id; -- the type declaration T : Node_Id; -- the type declaration
L : List_Id; -- list of decls of task/protected L : List_Id; -- list of decls of task/protected
...@@ -1513,7 +1514,6 @@ package body Sem_Ch13 is ...@@ -1513,7 +1514,6 @@ package body Sem_Ch13 is
begin begin
if Nkind (N) = N_Object_Declaration then if Nkind (N) = N_Object_Declaration then
T := Parent (Etype (Defining_Identifier (N))); T := Parent (Etype (Defining_Identifier (N)));
else else
T := N; T := N;
end if; end if;
......
...@@ -8900,7 +8900,6 @@ package body Sem_Ch6 is ...@@ -8900,7 +8900,6 @@ package body Sem_Ch6 is
elsif not Nkind_In (Parent (T), N_Access_Function_Definition, elsif not Nkind_In (Parent (T), N_Access_Function_Definition,
N_Access_Procedure_Definition) N_Access_Procedure_Definition)
then then
-- AI05-0151: Tagged incomplete types are allowed in all -- AI05-0151: Tagged incomplete types are allowed in all
-- formal parts. Untagged incomplete types are not allowed -- formal parts. Untagged incomplete types are not allowed
-- in bodies. -- in bodies.
...@@ -8935,6 +8934,14 @@ package body Sem_Ch6 is ...@@ -8935,6 +8934,14 @@ package body Sem_Ch6 is
Parameter_Type (Param_Spec), Formal_Type); Parameter_Type (Param_Spec), Formal_Type);
end if; end if;
-- Ada 2012 (AI-142): Handle aliased parameters
if Ada_Version >= Ada_2012
and then Aliased_Present (Param_Spec)
then
Set_Is_Aliased (Formal);
end if;
-- Ada 2005 (AI-231): Create and decorate an internal subtype -- Ada 2005 (AI-231): Create and decorate an internal subtype
-- declaration corresponding to the null-excluding type of the -- declaration corresponding to the null-excluding type of the
-- formal in the enclosing scope. Finally, replace the parameter -- formal in the enclosing scope. Finally, replace the parameter
...@@ -9005,6 +9012,8 @@ package body Sem_Ch6 is ...@@ -9005,6 +9012,8 @@ package body Sem_Ch6 is
Set_Etype (Formal, Formal_Type); Set_Etype (Formal, Formal_Type);
-- Deal with default expression if present
Default := Expression (Param_Spec); Default := Expression (Param_Spec);
if Present (Default) then if Present (Default) then
...@@ -9118,6 +9127,12 @@ package body Sem_Ch6 is ...@@ -9118,6 +9127,12 @@ package body Sem_Ch6 is
Num_Out_Params := Num_Out_Params + 1; Num_Out_Params := Num_Out_Params + 1;
end if; end if;
-- Force call by reference if aliased
if Is_Aliased (Formal) then
Set_Mechanism (Formal, By_Reference);
end if;
Next (Param_Spec); Next (Param_Spec);
end loop; end loop;
...@@ -9579,8 +9594,7 @@ package body Sem_Ch6 is ...@@ -9579,8 +9594,7 @@ package body Sem_Ch6 is
if Ekind (Designator) /= E_Procedure then if Ekind (Designator) /= E_Procedure then
declare declare
Rent : constant Entity_Id := Rent : constant Entity_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc, Name_uResult);
Chars => Name_uResult);
Ftyp : constant Entity_Id := Etype (Designator); Ftyp : constant Entity_Id := Etype (Designator);
begin begin
......
...@@ -206,7 +206,8 @@ package body Sinfo is ...@@ -206,7 +206,8 @@ package body Sinfo is
begin begin
pragma Assert (False pragma Assert (False
or else NT (N).Nkind = N_Component_Definition or else NT (N).Nkind = N_Component_Definition
or else NT (N).Nkind = N_Object_Declaration); or else NT (N).Nkind = N_Object_Declaration
or else NT (N).Nkind = N_Parameter_Specification);
return Flag4 (N); return Flag4 (N);
end Aliased_Present; end Aliased_Present;
...@@ -3265,7 +3266,8 @@ package body Sinfo is ...@@ -3265,7 +3266,8 @@ package body Sinfo is
begin begin
pragma Assert (False pragma Assert (False
or else NT (N).Nkind = N_Component_Definition or else NT (N).Nkind = N_Component_Definition
or else NT (N).Nkind = N_Object_Declaration); or else NT (N).Nkind = N_Object_Declaration
or else NT (N).Nkind = N_Parameter_Specification);
Set_Flag4 (N, Val); Set_Flag4 (N, Val);
end Set_Aliased_Present; end Set_Aliased_Present;
......
...@@ -2322,7 +2322,7 @@ package Sinfo is ...@@ -2322,7 +2322,7 @@ package Sinfo is
-- N_Object_Declaration -- N_Object_Declaration
-- Sloc points to first identifier -- Sloc points to first identifier
-- Defining_Identifier (Node1) -- Defining_Identifier (Node1)
-- Aliased_Present (Flag4) set if ALIASED appears -- Aliased_Present (Flag4)
-- Constant_Present (Flag17) set if CONSTANT appears -- Constant_Present (Flag17) set if CONSTANT appears
-- Null_Exclusion_Present (Flag11) -- Null_Exclusion_Present (Flag11)
-- Object_Definition (Node4) subtype indic./array type def./access def. -- Object_Definition (Node4) subtype indic./array type def./access def.
...@@ -4514,8 +4514,8 @@ package Sinfo is ...@@ -4514,8 +4514,8 @@ package Sinfo is
---------------------------------- ----------------------------------
-- PARAMETER_SPECIFICATION ::= -- PARAMETER_SPECIFICATION ::=
-- DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK -- DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION]
-- [:= DEFAULT_EXPRESSION] -- SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
-- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION -- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
-- [:= DEFAULT_EXPRESSION] -- [:= DEFAULT_EXPRESSION]
...@@ -4527,9 +4527,12 @@ package Sinfo is ...@@ -4527,9 +4527,12 @@ package Sinfo is
-- Prev_Ids flags to preserve the original source form as described -- Prev_Ids flags to preserve the original source form as described
-- in the section on "Handling of Defining Identifier Lists". -- in the section on "Handling of Defining Identifier Lists".
-- ALIASED can only be present in Ada 2012 mode
-- N_Parameter_Specification -- N_Parameter_Specification
-- Sloc points to first identifier -- Sloc points to first identifier
-- Defining_Identifier (Node1) -- Defining_Identifier (Node1)
-- Aliased_Present (Flag4)
-- In_Present (Flag15) -- In_Present (Flag15)
-- Out_Present (Flag17) -- Out_Present (Flag17)
-- Null_Exclusion_Present (Flag11) -- Null_Exclusion_Present (Flag11)
......
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