[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
This commit is contained in:
Arnaud Charlet 2011-09-01 12:44:14 +02:00
parent 516f608f15
commit fecbd77922
11 changed files with 141 additions and 51 deletions

View File

@ -1,3 +1,34 @@
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,

View File

@ -49,7 +49,6 @@ GNATRTL_TASKING_OBJS= \
s-interr$(objext) \
s-intman$(objext) \
s-mudido$(objext) \
s-oscons$(objext) \
s-osinte$(objext) \
s-proinf$(objext) \
s-solita$(objext) \
@ -542,6 +541,7 @@ GNATRTL_NONTASKING_OBJS= \
s-memory$(objext) \
s-multip$(objext) \
s-os_lib$(objext) \
s-oscons$(objext) \
s-osprim$(objext) \
s-pack03$(objext) \
s-pack05$(objext) \

View File

@ -1997,8 +1997,9 @@ package Einfo is
-- of pragma Ada_12 or Ada_2012.
-- Is_Aliased (Flag15)
-- Present in objects whose declarations carry the keyword aliased,
-- and on record components that have the keyword.
-- Present in all entities. Set for objects and types whose declarations
-- carry the keyword aliased, and on record components that have the
-- keyword. For Ada 2012, also applies to formal parameters.
-- Is_AST_Entry (Flag132)
-- Present in entry entities. Set if a valid pragma AST_Entry applies
@ -4773,6 +4774,7 @@ package Einfo is
-- Is_Ada_2005_Only (Flag185)
-- Is_Ada_2012_Only (Flag199)
-- Is_Bit_Packed_Array (Flag122) (base type only)
-- Is_Aliased (Flag15)
-- Is_Character_Type (Flag63)
-- Is_Child_Unit (Flag73)
-- Is_Compilation_Unit (Flag149)
@ -4994,7 +4996,6 @@ package Einfo is
-- Component_Alignment (special) (base type only)
-- Has_Component_Size_Clause (Flag68) (base type only)
-- Has_Pragma_Pack (Flag121) (impl base type only)
-- Is_Aliased (Flag15)
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)

View File

@ -4415,10 +4415,32 @@ package body Exp_Ch4 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);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Entity_Id := Etype (Obj_Id);

View File

@ -1186,8 +1186,8 @@ package body Ch6 is
-- FORMAL_PART ::= (PARAMETER_SPECIFICATION {; PARAMETER_SPECIFICATION})
-- PARAMETER_SPECIFICATION ::=
-- DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK
-- [:= DEFAULT_EXPRESSION]
-- DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION]
-- SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
-- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
-- [:= DEFAULT_EXPRESSION]
@ -1195,6 +1195,8 @@ package body Ch6 is
-- 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.
-- Note: The ALIASED keyword is allowed only in Ada 2012 mode (AI 142)
-- Error recovery: cannot raise Error_Resync
function P_Formal_Part return List_Id is
@ -1235,9 +1237,11 @@ package body Ch6 is
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
@ -1303,6 +1307,18 @@ package body Ch6 is
New_Node (N_Parameter_Specification, Ident_Sloc);
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)
Not_Null_Sloc := Token_Ptr;

View File

@ -415,22 +415,24 @@ package System.Tasking is
-- We need to store whether there are tasks allocated to concrete
-- processors in the default system dispatching domain because we need to
-- check it before creating a new dispatching domain. Two comments about
-- the reason why we use a pointer here and not in package
-- Dispatching_Domains.
-- 1) We use an array created dynamically in procedure Initialize which is
-- called at the beginning of the initialization of the run-time library.
-- Declaring a static array here in the spec would not work across
-- different installations because it would get the value of Number_Of_CPUs
-- from the machine where the run-time library is built, and not from the
-- machine where the application is executed. That is the reason why we
-- create the array (CPU'First .. Number_Of_CPUs) at execution time in the
-- procedure body, ensuring that the function Number_Of_CPUs is executed at
-- execution time (the same trick as we use for System_Domain).
-- 2) We have moved this declaration from package Dispatching_Domains
-- 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
-- number of tasks associated to the processor, but we do not want to force
-- a dependency from this package on Dispatching_Domains.
-- why we use a pointer here and not in package Dispatching_Domains:
--
-- 1) We use an array created dynamically in procedure Initialize which
-- is called at the beginning of the initialization of the run-time
-- library. Declaring a static array here in the spec would not work
-- across different installations because it would get the value of
-- Number_Of_CPUs from the machine where the run-time library is built,
-- and not from the machine where the application is executed. That is
-- the reason why we create the array (CPU'First .. Number_Of_CPUs) at
-- execution time in the procedure body, ensuring that the function
-- Number_Of_CPUs is executed at execution time (the same trick as we
-- use for System_Domain).
--
-- 2) We have moved this declaration from package Dispatching_Domains
-- 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
-- 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 --

View File

@ -659,21 +659,21 @@ package body System.Tasking.Stages is
-- The CPU associated to the task (if any) must belong to the
-- dispatching domain.
if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
(Base_CPU not in T.Common.Domain'Range
or else not T.Common.Domain (Base_CPU))
if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
and then
(Base_CPU not in T.Common.Domain'Range
or else not T.Common.Domain (Base_CPU))
then
Initialization.Undefer_Abort_Nestable (Self_ID);
raise Tasking_Error with "CPU not in dispatching domain";
end if;
-- In order to handle the interaction between pragma CPU and
-- dispatching domains we need to signal that this task is being
-- allocated to a processor. This is needed only for tasks belonging to
-- the system domain (the creation of new dispatching domains can only
-- take processors from the system domain) and only before the
-- environment task calls the main procedure (dispatching domains cannot
-- be created after this).
-- To handle the interaction between pragma CPU and dispatching domains
-- we need to signal that this task is being allocated to a processor.
-- This is needed only for tasks belonging to the system domain (the
-- creation of new dispatching domains can only take processors from the
-- system domain) and only before the environment task calls the main
-- procedure (dispatching domains cannot be created after this).
if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
and then T.Common.Domain = System.Tasking.System_Domain
@ -686,9 +686,8 @@ package body System.Tasking.Stages is
Dispatching_Domain_Tasks (Base_CPU) + 1;
end if;
-- Note: we should not call 'new' while holding locks since new
-- may use locks (e.g. RTS_Lock under Windows) itself and cause a
-- deadlock.
-- Note: we should not call 'new' while holding locks since new may use
-- locks (e.g. RTS_Lock under Windows) itself and cause a deadlock.
if Build_Entry_Names then
T.Entry_Names :=

View File

@ -1152,9 +1152,10 @@ package body Sem_Ch13 is
when Aspect_Priority |
Aspect_Interrupt_Priority |
Aspect_Dispatching_Domain |
Aspect_CPU =>
Aspect_CPU =>
declare
Pname : Name_Id;
begin
if A_Id = Aspect_Priority then
Pname := Name_Priority;
@ -1505,7 +1506,7 @@ package body Sem_Ch13 is
when Aspect_Priority |
Aspect_Interrupt_Priority |
Aspect_Dispatching_Domain |
Aspect_CPU =>
Aspect_CPU =>
declare
T : Node_Id; -- the type declaration
L : List_Id; -- list of decls of task/protected
@ -1513,7 +1514,6 @@ package body Sem_Ch13 is
begin
if Nkind (N) = N_Object_Declaration then
T := Parent (Etype (Defining_Identifier (N)));
else
T := N;
end if;

View File

@ -8900,7 +8900,6 @@ package body Sem_Ch6 is
elsif not Nkind_In (Parent (T), N_Access_Function_Definition,
N_Access_Procedure_Definition)
then
-- AI05-0151: Tagged incomplete types are allowed in all
-- formal parts. Untagged incomplete types are not allowed
-- in bodies.
@ -8935,6 +8934,14 @@ package body Sem_Ch6 is
Parameter_Type (Param_Spec), Formal_Type);
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
-- declaration corresponding to the null-excluding type of the
-- formal in the enclosing scope. Finally, replace the parameter
@ -9005,6 +9012,8 @@ package body Sem_Ch6 is
Set_Etype (Formal, Formal_Type);
-- Deal with default expression if present
Default := Expression (Param_Spec);
if Present (Default) then
@ -9118,6 +9127,12 @@ package body Sem_Ch6 is
Num_Out_Params := Num_Out_Params + 1;
end if;
-- Force call by reference if aliased
if Is_Aliased (Formal) then
Set_Mechanism (Formal, By_Reference);
end if;
Next (Param_Spec);
end loop;
@ -9579,8 +9594,7 @@ package body Sem_Ch6 is
if Ekind (Designator) /= E_Procedure then
declare
Rent : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => Name_uResult);
Make_Defining_Identifier (Loc, Name_uResult);
Ftyp : constant Entity_Id := Etype (Designator);
begin

View File

@ -206,7 +206,8 @@ package body Sinfo is
begin
pragma Assert (False
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);
end Aliased_Present;
@ -3265,7 +3266,8 @@ package body Sinfo is
begin
pragma Assert (False
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);
end Set_Aliased_Present;

View File

@ -2322,7 +2322,7 @@ package Sinfo is
-- N_Object_Declaration
-- Sloc points to first identifier
-- Defining_Identifier (Node1)
-- Aliased_Present (Flag4) set if ALIASED appears
-- Aliased_Present (Flag4)
-- Constant_Present (Flag17) set if CONSTANT appears
-- Null_Exclusion_Present (Flag11)
-- Object_Definition (Node4) subtype indic./array type def./access def.
@ -4514,8 +4514,8 @@ package Sinfo is
----------------------------------
-- PARAMETER_SPECIFICATION ::=
-- DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK
-- [:= DEFAULT_EXPRESSION]
-- DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION]
-- SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
-- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
-- [:= DEFAULT_EXPRESSION]
@ -4527,9 +4527,12 @@ package Sinfo is
-- Prev_Ids flags to preserve the original source form as described
-- in the section on "Handling of Defining Identifier Lists".
-- ALIASED can only be present in Ada 2012 mode
-- N_Parameter_Specification
-- Sloc points to first identifier
-- Defining_Identifier (Node1)
-- Aliased_Present (Flag4)
-- In_Present (Flag15)
-- Out_Present (Flag17)
-- Null_Exclusion_Present (Flag11)