[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:
parent
516f608f15
commit
fecbd77922
@ -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,
|
||||
|
@ -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) \
|
||||
|
@ -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)
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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 --
|
||||
|
@ -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 :=
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user