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-cbsyqu.adb, a-cbsyqu.ads: Minor reformatting.
s-interr$(objext) \
s-intman$(objext) \
s-mudido$(objext) \
- s-oscons$(objext) \
s-osinte$(objext) \
s-proinf$(objext) \
s-solita$(objext) \
s-memory$(objext) \
s-multip$(objext) \
s-os_lib$(objext) \
+ s-oscons$(objext) \
s-osprim$(objext) \
s-pack03$(objext) \
s-pack05$(objext) \
-- 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
-- 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)
-- 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)
------------------------------
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);
-- 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]
-- 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
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
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;
-- 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 --
-- 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
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 :=
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;
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
begin
if Nkind (N) = N_Object_Declaration then
T := Parent (Etype (Defining_Identifier (N)));
-
else
T := N;
end if;
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.
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
Set_Etype (Formal, Formal_Type);
+ -- Deal with default expression if present
+
Default := Expression (Param_Spec);
if Present (Default) then
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;
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
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;
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;
-- 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.
----------------------------------
-- 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]
-- 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)
projects / platform / upstream / gcc.git / commitdiff