+2011-10-13 Thomas Quinot <quinot@adacore.com>
+
+ * par-ch2.adb, par.adb, par-util.adb, par-ch3.adb
+ (Check_Future_Identifier): New subprogram,
+ factors duplicated code from Par.Ch2.P_Identifier and
+ Par.Ch3.P_Defining_Identifier.
+
+2011-10-13 Thomas Quinot <quinot@adacore.com>
+
+ * s-taprop-posix.adb (Initialize): Always raise Storage_Error
+ if we fail to initialize CV attributes or CV.
+
+2011-10-13 Thomas Quinot <quinot@adacore.com>
+
+ * s-tasren.adb (Timed_Selective_Wait, case
+ Accept_Alternative_Selected): Use Defer_Abort_Nestable, since
+ we know abortion is already deferred.
+
+2011-10-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch3.adb (Build_Class_Wide_Master): Moved to exp_ch9.
+ (Build_Master_Renaming (function)): Removed.
+ (Build_Master_Renaming (procedure)): Moved to exp_ch9.
+ (Expand_Full_Type_Declaration): Alphabetize
+ variables. Reformatting of code and comments. Rewrite the
+ section on processing of anonymous access-to-task types in
+ record components.
+ * exp_ch3.ads (Build_Class_Wide_Master): Moved to exp_ch9.
+ (Build_Master_Renaming): Moved to exp_ch9.
+ * exp_ch9.adb (Build_Class_Wide_Master): Moved from exp_ch3.
+ (Build_Master_Entity): Add formal parameter
+ Use_Current. Reformatting of code and comments.
+ (Build_Master_Renaming): Moved from exp_ch3.
+ * exp_ch9.ads (Build_Class_Wide_Master): Moved from
+ exp_ch3. Update comment on usage.
+ (Build_Master_Entity):
+ Add formal parameter Use_Current. Update comment on usage.
+ (Build_Master_Renaming): Moved from exp_ch3.
+ * sem_ch3.adb (Access_Definition): Remove redundant code to
+ create a _master and a renaming.
+
+2011-10-13 Ed Schonberg <schonberg@adacore.com>
+
+ * lib-xref.adb: Do no emit reference to overridden operation,
+ if it is internally generated.
+
+2011-10-13 Vincent Celier <celier@adacore.com>
+
+ * bindgen.adb: Remove any processing related to g-trasym
+ * Makefile.rtl: Add g-trasym.o to GNATRTL_NONTASKING_OBJS
+ * mlib-prj.adb: Remove any processing related to g-trasym.
+
2011-10-12 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.adb (Denotes_Same_Prefix): Fix fatal warning.
g-tasloc$(objext) \
g-timsta$(objext) \
g-traceb$(objext) \
+ g-trasym$(objext) \
g-u3spch$(objext) \
g-utf_32$(objext) \
g-wispch$(objext) \
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
end if;
-
- -- Don't link with the shared library on VMS if an internal
- -- filename object is seen. Multiply defined symbols will
- -- result.
-
- if OpenVMS_On_Target
- and then Is_Internal_File_Name
- (ALIs.Table
- (Units.Table (Elab_Order.Table (E)).My_ALI).Sfile)
- then
- -- Special case for g-trasym.obj (not included in libgnat)
-
- Get_Name_String (ALIs.Table
- (Units.Table (Elab_Order.Table (E)).My_ALI).Sfile);
-
- if Name_Buffer (1 .. 8) /= "g-trasym" then
- Opt.Shared_Libgnat := False;
- end if;
- end if;
end if;
end if;
end loop;
-- removing the implicit call that would otherwise constitute elaboration
-- code.
- function Build_Master_Renaming
- (N : Node_Id;
- T : Entity_Id) return Entity_Id;
- -- If the designated type of an access type is a task type or contains
- -- tasks, we make sure that a _Master variable is declared in the current
- -- scope, and then declare a renaming for it:
- --
- -- atypeM : Master_Id renames _Master;
- --
- -- where atyp is the name of the access type. This declaration is used when
- -- an allocator for the access type is expanded. The node is the full
- -- declaration of the designated type that contains tasks. The renaming
- -- declaration is inserted before N, and after the Master declaration.
-
procedure Build_Record_Init_Proc (N : Node_Id; Rec_Ent : Entity_Id);
-- Build record initialization procedure. N is the type declaration
-- node, and Rec_Ent is the corresponding entity for the record type.
end if;
end Build_Array_Init_Proc;
- -----------------------------
- -- Build_Class_Wide_Master --
- -----------------------------
-
- procedure Build_Class_Wide_Master (T : Entity_Id) is
- Loc : constant Source_Ptr := Sloc (T);
- Master_Id : Entity_Id;
- Master_Scope : Entity_Id;
- Name_Id : Node_Id;
- Related_Node : Node_Id;
- Ren_Decl : Node_Id;
-
- begin
- -- Nothing to do if there is no task hierarchy
-
- if Restriction_Active (No_Task_Hierarchy) then
- return;
- end if;
-
- -- Find the declaration that created the access type. It is either a
- -- type declaration, or an object declaration with an access definition,
- -- in which case the type is anonymous.
-
- if Is_Itype (T) then
- Related_Node := Associated_Node_For_Itype (T);
- else
- Related_Node := Parent (T);
- end if;
-
- Master_Scope := Find_Master_Scope (T);
-
- -- Nothing to do if the master scope already contains a _master entity.
- -- The only exception to this is the following scenario:
-
- -- Source_Scope
- -- Transient_Scope_1
- -- _master
-
- -- Transient_Scope_2
- -- use of master
-
- -- In this case the source scope is marked as having the master entity
- -- even though the actual declaration appears inside an inner scope. If
- -- the second transient scope requires a _master, it cannot use the one
- -- already declared because the entity is not visible.
-
- Name_Id := Make_Identifier (Loc, Name_uMaster);
-
- if not Has_Master_Entity (Master_Scope)
- or else No (Current_Entity_In_Scope (Name_Id))
- then
- declare
- Master_Decl : Node_Id;
-
- begin
- Set_Has_Master_Entity (Master_Scope);
-
- -- Generate:
- -- _master : constant Integer := Current_Master.all;
-
- Master_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc, Name_uMaster),
- Constant_Present => True,
- Object_Definition =>
- New_Reference_To (Standard_Integer, Loc),
- Expression =>
- Make_Explicit_Dereference (Loc,
- New_Reference_To (RTE (RE_Current_Master), Loc)));
-
- Insert_Action (Related_Node, Master_Decl);
- Analyze (Master_Decl);
-
- -- Mark the containing scope as a task master. Masters associated
- -- with return statements are already marked at this stage (see
- -- Analyze_Subprogram_Body).
-
- if Ekind (Current_Scope) /= E_Return_Statement then
- declare
- Par : Node_Id := Related_Node;
-
- begin
- while Nkind (Par) /= N_Compilation_Unit loop
- Par := Parent (Par);
-
- -- If we fall off the top, we are at the outer level, and
- -- the environment task is our effective master, so
- -- nothing to mark.
-
- if Nkind_In (Par, N_Block_Statement,
- N_Subprogram_Body,
- N_Task_Body)
- then
- Set_Is_Task_Master (Par);
- exit;
- end if;
- end loop;
- end;
- end if;
- end;
- end if;
-
- Master_Id :=
- Make_Defining_Identifier (Loc,
- New_External_Name (Chars (T), 'M'));
-
- -- Generate:
- -- Mnn renames _master;
-
- Ren_Decl :=
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Master_Id,
- Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
- Name => Name_Id);
-
- Insert_Before (Related_Node, Ren_Decl);
- Analyze (Ren_Decl);
-
- Set_Master_Id (T, Master_Id);
-
- exception
- when RE_Not_Available =>
- return;
- end Build_Class_Wide_Master;
-
--------------------------------
-- Build_Discr_Checking_Funcs --
--------------------------------
return Empty_List;
end Build_Initialization_Call;
- ---------------------------
- -- Build_Master_Renaming --
- ---------------------------
-
- function Build_Master_Renaming
- (N : Node_Id;
- T : Entity_Id) return Entity_Id
- is
- Loc : constant Source_Ptr := Sloc (N);
- M_Id : Entity_Id;
- Decl : Node_Id;
-
- begin
- -- Nothing to do if there is no task hierarchy
-
- if Restriction_Active (No_Task_Hierarchy) then
- return Empty;
- end if;
-
- M_Id :=
- Make_Defining_Identifier (Loc,
- New_External_Name (Chars (T), 'M'));
-
- Decl :=
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => M_Id,
- Subtype_Mark => New_Reference_To (RTE (RE_Master_Id), Loc),
- Name => Make_Identifier (Loc, Name_uMaster));
- Insert_Before (N, Decl);
- Analyze (Decl);
- return M_Id;
-
- exception
- when RE_Not_Available =>
- return Empty;
- end Build_Master_Renaming;
-
- ---------------------------
- -- Build_Master_Renaming --
- ---------------------------
-
- procedure Build_Master_Renaming (N : Node_Id; T : Entity_Id) is
- M_Id : Entity_Id;
-
- begin
- -- Nothing to do if there is no task hierarchy
-
- if Restriction_Active (No_Task_Hierarchy) then
- return;
- end if;
-
- M_Id := Build_Master_Renaming (N, T);
- Set_Master_Id (T, M_Id);
-
- exception
- when RE_Not_Available =>
- return;
- end Build_Master_Renaming;
-
----------------------------
-- Build_Record_Init_Proc --
----------------------------
procedure Expand_N_Full_Type_Declaration (N : Node_Id) is
Def_Id : constant Entity_Id := Defining_Identifier (N);
B_Id : constant Entity_Id := Base_Type (Def_Id);
- Par_Id : Entity_Id;
FN : Node_Id;
+ Par_Id : Entity_Id;
procedure Build_Master (Def_Id : Entity_Id);
-- Create the master associated with Def_Id
Expand_Access_Protected_Subprogram_Type (N);
end if;
+ -- Array of anonymous access-to-task pointers
+
elsif Ada_Version >= Ada_2005
and then Is_Array_Type (Def_Id)
and then Is_Access_Type (Component_Type (Def_Id))
elsif Has_Task (Def_Id) then
Expand_Previous_Access_Type (Def_Id);
+ -- Check the components of a record type or array of records for
+ -- anonymous access-to-task pointers.
+
elsif Ada_Version >= Ada_2005
and then
- (Is_Record_Type (Def_Id)
- or else (Is_Array_Type (Def_Id)
- and then Is_Record_Type (Component_Type (Def_Id))))
+ (Is_Record_Type (Def_Id)
+ or else
+ (Is_Array_Type (Def_Id)
+ and then Is_Record_Type (Component_Type (Def_Id))))
then
declare
- Comp : Entity_Id;
- Typ : Entity_Id;
- M_Id : Entity_Id;
+ Comp : Entity_Id;
+ First : Boolean;
+ M_Id : Entity_Id;
+ Typ : Entity_Id;
begin
- -- Look for the first anonymous access type component
-
if Is_Array_Type (Def_Id) then
Comp := First_Entity (Component_Type (Def_Id));
else
Comp := First_Entity (Def_Id);
end if;
+ -- Examine all components looking for anonymous access-to-task
+ -- types.
+
+ First := True;
while Present (Comp) loop
Typ := Etype (Comp);
- exit when Is_Access_Type (Typ)
- and then Ekind (Typ) = E_Anonymous_Access_Type;
-
- Next_Entity (Comp);
- end loop;
-
- -- If found we add a renaming declaration of master_id and we
- -- associate it to each anonymous access type component. Do
- -- nothing if the access type already has a master. This will be
- -- the case if the array type is the packed array created for a
- -- user-defined array type T, where the master_id is created when
- -- expanding the declaration for T.
-
- if Present (Comp)
- and then Ekind (Typ) = E_Anonymous_Access_Type
- and then not Restriction_Active (No_Task_Hierarchy)
- and then No (Master_Id (Typ))
+ if Ekind (Typ) = E_Anonymous_Access_Type
+ and then Has_Task (Available_View (Designated_Type (Typ)))
+ and then No (Master_Id (Typ))
+ then
+ -- Ensure that the record or array type have a _master
- -- Do not consider run-times with no tasking support
+ if First then
+ Build_Master_Entity (Def_Id);
+ Build_Master_Renaming (N, Typ);
+ M_Id := Master_Id (Typ);
- and then RTE_Available (RE_Current_Master)
- and then Has_Task (Non_Limited_Designated_Type (Typ))
- then
- Build_Master_Entity (Def_Id);
- M_Id := Build_Master_Renaming (N, Def_Id);
-
- if Is_Array_Type (Def_Id) then
- Comp := First_Entity (Component_Type (Def_Id));
- else
- Comp := First_Entity (Def_Id);
- end if;
+ First := False;
- while Present (Comp) loop
- Typ := Etype (Comp);
+ -- Reuse the same master to service any additional types
- if Is_Access_Type (Typ)
- and then Ekind (Typ) = E_Anonymous_Access_Type
- then
+ else
Set_Master_Id (Typ, M_Id);
end if;
+ end if;
- Next_Entity (Comp);
- end loop;
- end if;
+ Next_Entity (Comp);
+ end loop;
end;
end if;
end if;
if Nkind (Type_Definition (Original_Node (N))) =
- N_Derived_Type_Definition
+ N_Derived_Type_Definition
and then not Is_Tagged_Type (Def_Id)
and then Present (Freeze_Node (Par_Id))
and then Present (TSS_Elist (Freeze_Node (Par_Id)))
procedure Expand_Record_Extension (T : Entity_Id; Def : Node_Id);
-- Add a field _parent in the extension part of the record
- procedure Build_Class_Wide_Master (T : Entity_Id);
- -- For access to class-wide limited types we must build a task master
- -- because some subsequent extension may add a task component. To avoid
- -- bringing in the tasking run-time whenever an access-to-class-wide
- -- limited type is used, we use the soft-link mechanism and add a level of
- -- indirection to calls to routines that manipulate Master_Ids. This must
- -- also be used for anonymous access types whose designated type is a task
- -- or synchronized interface.
-
procedure Build_Discr_Checking_Funcs (N : Node_Id);
-- Builds function which checks whether the component name is consistent
-- with the current discriminants. N is the full type declaration node,
-- Constructor_Ref is a call to a constructor subprogram. It is currently
-- used only to support C++ constructors.
- procedure Build_Master_Renaming (N : Node_Id; T : Entity_Id);
- -- If the designated type of an access type is a task type or contains
- -- tasks, we make sure that a _Master variable is declared in the current
- -- scope, and then declare a renaming for it:
- --
- -- atypeM : Master_Id renames _Master;
- --
- -- where atyp is the name of the access type. This declaration is
- -- used when an allocator for the access type is expanded. The node N
- -- is the full declaration of the designated type that contains tasks.
- -- The renaming declaration is inserted before N, and after the Master
- -- declaration.
-
function Freeze_Type (N : Node_Id) return Boolean;
-- This function executes the freezing actions associated with the given
-- freeze type node N and returns True if the node is to be deleted. We
Parameter_Associations => New_List (Concurrent_Ref (N)));
end Build_Call_With_Task;
+ -----------------------------
+ -- Build_Class_Wide_Master --
+ -----------------------------
+
+ procedure Build_Class_Wide_Master (Typ : Entity_Id) is
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Master_Id : Entity_Id;
+ Master_Scope : Entity_Id;
+ Name_Id : Node_Id;
+ Related_Node : Node_Id;
+ Ren_Decl : Node_Id;
+
+ begin
+ -- Nothing to do if there is no task hierarchy
+
+ if Restriction_Active (No_Task_Hierarchy) then
+ return;
+ end if;
+
+ -- Find the declaration that created the access type. It is either a
+ -- type declaration, or an object declaration with an access definition,
+ -- in which case the type is anonymous.
+
+ if Is_Itype (Typ) then
+ Related_Node := Associated_Node_For_Itype (Typ);
+ else
+ Related_Node := Parent (Typ);
+ end if;
+
+ Master_Scope := Find_Master_Scope (Typ);
+
+ -- Nothing to do if the master scope already contains a _master entity.
+ -- The only exception to this is the following scenario:
+
+ -- Source_Scope
+ -- Transient_Scope_1
+ -- _master
+
+ -- Transient_Scope_2
+ -- use of master
+
+ -- In this case the source scope is marked as having the master entity
+ -- even though the actual declaration appears inside an inner scope. If
+ -- the second transient scope requires a _master, it cannot use the one
+ -- already declared because the entity is not visible.
+
+ Name_Id := Make_Identifier (Loc, Name_uMaster);
+
+ if not Has_Master_Entity (Master_Scope)
+ or else No (Current_Entity_In_Scope (Name_Id))
+ then
+ declare
+ Master_Decl : Node_Id;
+
+ begin
+ Set_Has_Master_Entity (Master_Scope);
+
+ -- Generate:
+ -- _master : constant Integer := Current_Master.all;
+
+ Master_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uMaster),
+ Constant_Present => True,
+ Object_Definition =>
+ New_Reference_To (Standard_Integer, Loc),
+ Expression =>
+ Make_Explicit_Dereference (Loc,
+ New_Reference_To (RTE (RE_Current_Master), Loc)));
+
+ Insert_Action (Related_Node, Master_Decl);
+ Analyze (Master_Decl);
+
+ -- Mark the containing scope as a task master. Masters associated
+ -- with return statements are already marked at this stage (see
+ -- Analyze_Subprogram_Body).
+
+ if Ekind (Current_Scope) /= E_Return_Statement then
+ declare
+ Par : Node_Id := Related_Node;
+
+ begin
+ while Nkind (Par) /= N_Compilation_Unit loop
+ Par := Parent (Par);
+
+ -- If we fall off the top, we are at the outer level, and
+ -- the environment task is our effective master, so
+ -- nothing to mark.
+
+ if Nkind_In (Par, N_Block_Statement,
+ N_Subprogram_Body,
+ N_Task_Body)
+ then
+ Set_Is_Task_Master (Par);
+ exit;
+ end if;
+ end loop;
+ end;
+ end if;
+ end;
+ end if;
+
+ Master_Id :=
+ Make_Defining_Identifier (Loc,
+ New_External_Name (Chars (Typ), 'M'));
+
+ -- Generate:
+ -- Mnn renames _master;
+
+ Ren_Decl :=
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Master_Id,
+ Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
+ Name => Name_Id);
+
+ Insert_Before (Related_Node, Ren_Decl);
+ Analyze (Ren_Decl);
+
+ Set_Master_Id (Typ, Master_Id);
+ end Build_Class_Wide_Master;
+
--------------------------------
-- Build_Corresponding_Record --
--------------------------------
-- Build_Master_Entity --
-------------------------
- procedure Build_Master_Entity (E : Entity_Id) is
- Loc : constant Source_Ptr := Sloc (E);
- P : Node_Id;
- Decl : Node_Id;
- S : Entity_Id;
+ procedure Build_Master_Entity
+ (Id : Entity_Id;
+ Use_Current : Boolean := False)
+ is
+ Loc : constant Source_Ptr := Sloc (Id);
+ Context : Node_Id;
+ Master_Decl : Node_Id;
+ Master_Scop : Entity_Id;
begin
- S := Find_Master_Scope (E);
+ if Use_Current then
+ Master_Scop := Current_Scope;
+ else
+ Master_Scop := Find_Master_Scope (Id);
+ end if;
- -- Nothing to do if we already built a master entity for this scope
- -- or if there is no task hierarchy.
+ -- Do not create a master if the enclosing scope already has one or if
+ -- there is no task hierarchy.
- if Has_Master_Entity (S)
+ if Has_Master_Entity (Master_Scop)
or else Restriction_Active (No_Task_Hierarchy)
then
return;
end if;
- -- Otherwise first build the master entity
+ -- Determine the proper context to insert the master
+
+ if Is_Access_Type (Id) and then Is_Itype (Id) then
+ Context := Associated_Node_For_Itype (Id);
+ else
+ Context := Parent (Id);
+ end if;
+
+ -- Create a master, generate:
-- _Master : constant Master_Id := Current_Master.all;
- -- and insert it just before the current declaration
- Decl :=
+ Master_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uMaster),
- Constant_Present => True,
- Object_Definition => New_Reference_To (RTE (RE_Master_Id), Loc),
- Expression =>
+ Constant_Present => True,
+ Object_Definition => New_Reference_To (RTE (RE_Master_Id), Loc),
+ Expression =>
Make_Explicit_Dereference (Loc,
New_Reference_To (RTE (RE_Current_Master), Loc)));
- P := Parent (E);
- Insert_Before (P, Decl);
- Analyze (Decl);
+ Insert_Before (Context, Master_Decl);
+ Analyze (Master_Decl);
- Set_Has_Master_Entity (S);
+ -- Mark the enclosing scope and its associated construct as being task
+ -- masters.
- -- Now mark the containing scope as a task master
+ Set_Has_Master_Entity (Master_Scop);
- while Nkind (P) /= N_Compilation_Unit loop
- P := Parent (P);
+ while Nkind (Context) /= N_Compilation_Unit loop
+ Context := Parent (Context);
-- If we fall off the top, we are at the outer level, and the
-- environment task is our effective master, so nothing to mark.
- if Nkind_In
- (P, N_Task_Body, N_Block_Statement, N_Subprogram_Body)
+ if Nkind_In (Context, N_Block_Statement,
+ N_Subprogram_Body,
+ N_Task_Body)
then
- Set_Is_Task_Master (P, True);
+ Set_Is_Task_Master (Context, True);
return;
- elsif Nkind (Parent (P)) = N_Subunit then
- P := Corresponding_Stub (Parent (P));
+ elsif Nkind (Parent (Context)) = N_Subunit then
+ Context := Corresponding_Stub (Parent (Context));
end if;
end loop;
end Build_Master_Entity;
+ ---------------------------
+ -- Build_Master_Renaming --
+ ---------------------------
+
+ procedure Build_Master_Renaming (N : Node_Id; Typ : Entity_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Master_Decl : Node_Id;
+ Master_Id : Entity_Id;
+
+ begin
+ -- Nothing to do if there is no task hierarchy
+
+ if Restriction_Active (No_Task_Hierarchy) then
+ return;
+ end if;
+
+ Master_Id :=
+ Make_Defining_Identifier (Loc,
+ New_External_Name (Chars (Typ), 'M'));
+
+ Master_Decl :=
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Master_Id,
+ Subtype_Mark => New_Reference_To (RTE (RE_Master_Id), Loc),
+ Name => Make_Identifier (Loc, Name_uMaster));
+
+ Insert_Before (N, Master_Decl);
+ Analyze (Master_Decl);
+
+ Set_Master_Id (Typ, Master_Id);
+ end Build_Master_Renaming;
+
-----------------------------------------
-- Build_Private_Protected_Declaration --
-----------------------------------------
-- Task_Id of the associated task as the parameter. The caller is
-- responsible for analyzing and resolving the resulting tree.
+ procedure Build_Class_Wide_Master (Typ : Entity_Id);
+ -- Given an access-to-limited class-wide type or an access-to-limited
+ -- interface, ensure that the designated type has a _master and generate
+ -- a renaming of the said master to service the access type.
+
function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id;
-- Create the statements which populate the entry names array of a task or
-- protected type. The statements are wrapped inside a block due to a local
-- declaration.
- procedure Build_Master_Entity (E : Entity_Id);
- -- Given an entity E for the declaration of an object containing tasks
- -- or of a type declaration for an allocator whose designated type is a
- -- task or contains tasks, this routine marks the appropriate enclosing
- -- context as a master, and also declares a variable called _Master in
- -- the current declarative part which captures the value of Current_Master
- -- (if not already built by a prior call). We build this object (instead
- -- of just calling Current_Master) for two reasons. First it is clearly
- -- more efficient to call Current_Master only once for a bunch of tasks
- -- in the same declarative part, and second it makes things easier in
- -- generating the initialization routines, since they can just reference
- -- the object _Master by name, and they will get the proper Current_Master
- -- value at the outer level, and copy in the parameter value for the outer
- -- initialization call if the call is for a nested component). Note that
- -- in the case of nested packages, we only really need to make one such
- -- object at the outer level, but it is much easier to generate one per
- -- declarative part.
+ procedure Build_Master_Entity
+ (Id : Entity_Id;
+ Use_Current : Boolean := False);
+ -- Given the name of an object or a type which is either a task, contains
+ -- tasks or designates tasks, create a _master in the appropriate scope
+ -- which captures the value of Current_Master. Mark the enclosing body as
+ -- being a task master. A _master is built to avoid multiple expensive
+ -- calls to Current_Master and to facilitate object initialization. Flag
+ -- Use_Current ensures that the master scope is the current scope.
+
+ procedure Build_Master_Renaming (N : Node_Id; Typ : Entity_Id);
+ -- Given an access type Typ and a declaration N of a designated type that
+ -- is either a task or contains tasks, create a renaming of the form:
+ --
+ -- TypM : Master_Id renames _Master;
+ --
+ -- where _master denotes the task master of the enclosing context. The
+ -- renaming declaration is inserted before N.
function Build_Private_Protected_Declaration (N : Node_Id) return Entity_Id;
-- A subprogram body without a previous spec that appears in a protected
Op := Ultimate_Alias (Old_E);
-- Normal case of no alias present
+ -- we omit generated primitives like tagged equality,
+ -- that have no source representation.
else
Op := Old_E;
if Present (Op)
and then Sloc (Op) /= Standard_Location
+ and then Comes_From_Source (Op)
then
declare
Loc : constant Source_Ptr := Sloc (Op);
S_Dec_Ads : File_Name_Type := No_File;
-- Name_Id for "dec.ads"
- G_Trasym_Ads : File_Name_Type := No_File;
- -- Name_Id for "g-trasym.ads"
-
Arguments : String_List_Access := No_Argument;
-- Used to accumulate arguments for the invocation of gnatbind and of the
-- compiler. Also used to collect the interface ALI when copying the ALI
Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set True if library needs to be linked with libdecgnat
- Gtrasymobj_Needed : Boolean := False;
- -- On OpenVMS, set rue if library needs to be linked with g-trasym.obj
-
Object_Directory_Path : constant String :=
Get_Name_String
(For_Project.Object_Directory.Display_Name);
-- to link with -lgnarl (this is the case when there is a dependency
-- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
-- indicates that there is a need to link with -ldecgnat (this is the
- -- case when there is a dependency on dec.ads). Set Gtrasymobj_Needed
- -- if there is a dependency on g-trasym.ads.
+ -- case when there is a dependency on dec.ads).
procedure Process (The_ALI : File_Name_Type);
-- Check if the closure of a library unit which is or should be in the
if Libgnarl_Needed /= Yes
or else
(Main_Project
- and then OpenVMS_On_Target
- and then ((not Libdecgnat_Needed) or (not Gtrasymobj_Needed)))
+ and then OpenVMS_On_Target)
then
-- Scan the ALI file
elsif OpenVMS_On_Target then
if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
Libdecgnat_Needed := True;
-
- elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then
- Gtrasymobj_Needed := True;
end if;
end if;
end loop;
S_Dec_Ads := Name_Find;
end if;
- if G_Trasym_Ads = No_File then
- Name_Len := 0;
- Add_Str_To_Name_Buffer ("g-trasym.ads");
- G_Trasym_Ads := Name_Find;
- end if;
-
-- We work in the object directory
Change_Dir (Object_Directory_Path);
ALIs.Append (new String'(ALI_Path));
-- Find out if for this ALI file,
- -- libgnarl or libdecgnat or
- -- g-trasym.obj (on OpenVMS) is
+ -- libgnarl or libdecgnat is
-- necessary.
Check_Libs (ALI_Path, True);
end if;
end if;
- if Gtrasymobj_Needed then
- Opts.Increment_Last;
- Opts.Table (Opts.Last) :=
- new String'(Lib_Directory & "/g-trasym.obj");
- end if;
-
if Libdecgnat_Needed then
Opts.Increment_Last;
-- Code duplication, see Par_Ch3.P_Defining_Identifier???
if Token = Tok_Identifier then
-
- -- Shouldn't the warnings below be emitted when in Ada 83 mode???
-
- -- Ada 2005 (AI-284): If compiling in Ada 95 mode, we warn that
- -- INTERFACE, OVERRIDING, and SYNCHRONIZED are new reserved words.
-
- if Ada_Version = Ada_95
- and then Warn_On_Ada_2005_Compatibility
- then
- if Token_Name = Name_Overriding
- or else Token_Name = Name_Synchronized
- or else (Token_Name = Name_Interface
- and then Prev_Token /= Tok_Pragma)
- then
- Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
- end if;
- end if;
-
- -- Similarly, warn about Ada 2012 reserved words
-
- if Ada_Version in Ada_95 .. Ada_2005
- and then Warn_On_Ada_2012_Compatibility
- then
- if Token_Name = Name_Some then
- Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
- end if;
- end if;
-
+ Check_Future_Keyword;
Ident_Node := Token_Node;
Scan; -- past Identifier
return Ident_Node;
-- Duplication should be removed, common code should be factored???
if Token = Tok_Identifier then
-
- -- Shouldn't the warnings below be emitted when in Ada 83 mode???
-
- -- Ada 2005 (AI-284): If compiling in Ada 95 mode, we warn that
- -- INTERFACE, OVERRIDING, and SYNCHRONIZED are new reserved words.
- -- Note that in the case where these keywords are misused in Ada 95
- -- mode, this routine will generally not be called at all.
-
- -- What sort of misuse is this comment talking about??? These are
- -- perfectly legitimate defining identifiers in Ada 95???
-
- if Ada_Version = Ada_95
- and then Warn_On_Ada_2005_Compatibility
- then
- if Token_Name = Name_Overriding
- or else Token_Name = Name_Synchronized
- or else (Token_Name = Name_Interface
- and then Prev_Token /= Tok_Pragma)
- then
- Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
- end if;
- end if;
-
- -- Similarly, warn about Ada 2012 reserved words
-
- if Ada_Version in Ada_95 .. Ada_2005
- and then Warn_On_Ada_2012_Compatibility
- then
- if Token_Name = Name_Some then
- Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
- end if;
- end if;
+ Check_Future_Keyword;
-- If we have a reserved identifier, manufacture an identifier with
-- a corresponding name after posting an appropriate error message
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end Check_Bad_Layout;
--------------------------
+ -- Check_Future_Keyword --
+ --------------------------
+
+ procedure Check_Future_Keyword is
+ begin
+ -- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
+ -- OVERRIDING, and SYNCHRONIZED are new reserved words.
+
+ if Ada_Version = Ada_95
+ and then Warn_On_Ada_2005_Compatibility
+ then
+ if Token_Name = Name_Overriding
+ or else Token_Name = Name_Synchronized
+ or else (Token_Name = Name_Interface
+ and then Prev_Token /= Tok_Pragma)
+ then
+ Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
+ end if;
+ end if;
+
+ -- Similarly, warn about Ada 2012 reserved words
+
+ if Ada_Version in Ada_95 .. Ada_2005
+ and then Warn_On_Ada_2012_Compatibility
+ then
+ if Token_Name = Name_Some then
+ Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
+ end if;
+ end if;
+
+ -- Note: we deliberately do not emit these warnings when operating in
+ -- Ada 83 mode because in that case we assume the user is building
+ -- legacy code anyway.
+
+ end Check_Future_Keyword;
+
+ --------------------------
-- Check_Misspelling_Of --
--------------------------
-- mode. The caller has typically checked that the current token,
-- an identifier, matches one of the 95 keywords.
+ procedure Check_Future_Keyword;
+ -- Emit a warning if the current token is a valid identifier in the
+ -- language version in use, but is a reserved word in a later language
+ -- version (unless the language version in use is Ada 83).
+
procedure Check_Simple_Expression (E : Node_Id);
-- Given an expression E, that has just been scanned, so that Expr_Form
-- is still set, outputs an error if E is a non-simple expression. E is
Result := pthread_mutex_destroy (S.L'Access);
pragma Assert (Result = 0);
- if Result = ENOMEM then
- raise Storage_Error;
- end if;
+ raise Storage_Error;
end if;
Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
Result := pthread_mutex_destroy (S.L'Access);
pragma Assert (Result = 0);
- if Result = ENOMEM then
- Result := pthread_condattr_destroy (Cond_Attr'Access);
- pragma Assert (Result = 0);
- raise Storage_Error;
- end if;
+ Result := pthread_condattr_destroy (Cond_Attr'Access);
+ pragma Assert (Result = 0);
+
+ raise Storage_Error;
end if;
Result := pthread_condattr_destroy (Cond_Attr'Access);
-- Null_Body. Defer abort until it gets into the accept body.
Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
- Initialization.Defer_Abort (Self_Id);
+ Initialization.Defer_Abort_Nestable (Self_Id);
STPO.Unlock (Self_Id);
when Accept_Alternative_Completed =>
(Related_Nod : Node_Id;
N : Node_Id) return Entity_Id
is
- Loc : constant Source_Ptr := Sloc (Related_Nod);
Anon_Type : Entity_Id;
Anon_Scope : Entity_Id;
Desig_Type : Entity_Id;
- Decl : Entity_Id;
Enclosing_Prot_Type : Entity_Id := Empty;
begin
and then Comes_From_Source (Related_Nod)
and then not Restriction_Active (No_Task_Hierarchy)
then
- if not Has_Master_Entity (Current_Scope) then
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc, Name_uMaster),
- Constant_Present => True,
- Object_Definition =>
- New_Reference_To (RTE (RE_Master_Id), Loc),
- Expression =>
- Make_Explicit_Dereference (Loc,
- New_Reference_To (RTE (RE_Current_Master), Loc)));
-
- Insert_Before (Related_Nod, Decl);
- Analyze (Decl);
-
- Set_Master_Id (Anon_Type, Defining_Identifier (Decl));
- Set_Has_Master_Entity (Current_Scope);
- else
- Build_Master_Renaming (Related_Nod, Anon_Type);
- end if;
+ Build_Master_Entity (Defining_Identifier (Related_Nod), True);
+ Build_Master_Renaming (Related_Nod, Anon_Type);
end if;
end if;
OSDN Git Service
