Commit c42e6724 by Hristian Kirtchev Committed by Arnaud Charlet

exp_ch3.adb (Build_Init_Statements): Alphabetize local variables.

2008-05-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Init_Statements): Alphabetize local variables.
	Create the statements which map a string name to protected or task
	entry indix.

	* exp_ch9.adb: Add with and use clause for Stringt.
	Minor code reformatting.
	(Build_Entry_Names): New routine.
	(Make_Initialize_Protection, Make_Task_Create_Call): Generate a value
	for flag Build_Entry_Names which controls the allocation of the data
	structure for the string names of entries.

	* exp_ch9.ads (Build_Entry_Names): New subprogram.

	* exp_util.adb (Entry_Names_OK): New function.

	* exp_util.ads (Entry_Names_OK): New function.

	* rtsfind.ads: Add RO_PE_Set_Entry_Name and RO_TS_Set_Entry_Name to
	enumerations RE_Id and RE_Unit_Table.

	* s-taskin.adb Add with and use clause for Ada.Unchecked_Deallocation.
	(Free_Entry_Names_Array): New routine.

	* s-taskin.ads: Comment reformatting.
	Add types String_Access, Entry_Names_Array, Entry_Names_Array_Access.
	Add component Entry_Names to record Ada_Task_Control_Block.
	(Free_Entry_Names_Array): New routine.

	* s-tassta.adb (Create_Task): If flag Build_Entry_Names is set,
	dynamically allocate an array
	of string pointers. This structure holds string entry names.
	(Free_Entry_Names): New routine.
	(Free_Task, Vulnerable_Free_Task): Deallocate the entry names array.
	(Set_Entry_Names): New routine.

	* s-tassta.ads:
	(Create_Task): Add formal Build_Entry_Names. The flag is used to
	control the allocation of the data structure which stores entry names.
	(Set_Entry_Name): New routine.

	* s-tpoben.adb:
	Add with and use clause for Ada.Unchecked_Conversion.
	(Finalize): Deallocate the entry names array.
	(Free_Entry_Names): New routine.
	(Initialize_Protection_Entries): When flag Build_Entry_Names is set,
	create an array of string pointers to hold the entry names.
	(Set_Entry_Name): New routine.

	* s-tpoben.ads:
	Add field Entry_Names to record Protection_Entries.
	(Initialize_Protection_Entries): Add formal Build_Entry_Names.
	(Set_Entry_Name): New routine.

From-SVN: r135896
parent a28e8f45
...@@ -2477,17 +2477,16 @@ package body Exp_Ch3 is ...@@ -2477,17 +2477,16 @@ package body Exp_Ch3 is
function Build_Init_Statements (Comp_List : Node_Id) return List_Id is function Build_Init_Statements (Comp_List : Node_Id) return List_Id is
Check_List : constant List_Id := New_List; Check_List : constant List_Id := New_List;
Alt_List : List_Id; Alt_List : List_Id;
Decl : Node_Id;
Id : Entity_Id;
Names : Node_Id;
Statement_List : List_Id; Statement_List : List_Id;
Stmts : List_Id; Stmts : List_Id;
Typ : Entity_Id;
Variant : Node_Id;
Per_Object_Constraint_Components : Boolean; Per_Object_Constraint_Components : Boolean;
Decl : Node_Id;
Variant : Node_Id;
Id : Entity_Id;
Typ : Entity_Id;
function Has_Access_Constraint (E : Entity_Id) return Boolean; function Has_Access_Constraint (E : Entity_Id) return Boolean;
-- Components with access discriminants that depend on the current -- Components with access discriminants that depend on the current
-- instance must be initialized after all other components. -- instance must be initialized after all other components.
...@@ -2711,6 +2710,17 @@ package body Exp_Ch3 is ...@@ -2711,6 +2710,17 @@ package body Exp_Ch3 is
Append_To (Statement_List, Make_Task_Create_Call (Rec_Type)); Append_To (Statement_List, Make_Task_Create_Call (Rec_Type));
-- Generate the statements which map a string entry name to a
-- task entry index. Note that the task may not have entries.
if Entry_Names_OK then
Names := Build_Entry_Names (Rec_Type);
if Present (Names) then
Append_To (Statement_List, Names);
end if;
end if;
declare declare
Task_Type : constant Entity_Id := Task_Type : constant Entity_Id :=
Corresponding_Concurrent_Type (Rec_Type); Corresponding_Concurrent_Type (Rec_Type);
...@@ -2761,6 +2771,18 @@ package body Exp_Ch3 is ...@@ -2761,6 +2771,18 @@ package body Exp_Ch3 is
if Is_Protected_Record_Type (Rec_Type) then if Is_Protected_Record_Type (Rec_Type) then
Append_List_To (Statement_List, Append_List_To (Statement_List,
Make_Initialize_Protection (Rec_Type)); Make_Initialize_Protection (Rec_Type));
-- Generate the statements which map a string entry name to a
-- protected entry index. Note that the protected type may not
-- have entries.
if Entry_Names_OK then
Names := Build_Entry_Names (Rec_Type);
if Present (Names) then
Append_To (Statement_List, Names);
end if;
end if;
end if; end if;
-- If no initializations when generated for component declarations -- If no initializations when generated for component declarations
...@@ -4494,15 +4516,16 @@ package body Exp_Ch3 is ...@@ -4494,15 +4516,16 @@ package body Exp_Ch3 is
end; end;
end if; end if;
-- If the type is controlled and not limited then the target is -- If the type is controlled and not inherently limited, then
-- adjusted after the copy and attached to the finalization list. -- the target is adjusted after the copy and attached to the
-- However, no adjustment is done in the case where the object was -- finalization list. However, no adjustment is done in the case
-- initialized by a call to a function whose result is built in -- where the object was initialized by a call to a function whose
-- place, since no copy occurred. (We eventually plan to support -- result is built in place, since no copy occurred. (Eventually
-- in-place function results for some nonlimited types. ???) -- we plan to support in-place function results for some cases
-- of nonlimited types. ???)
if Controlled_Type (Typ) if Controlled_Type (Typ)
and then not Is_Limited_Type (Typ) and then not Is_Inherently_Limited_Type (Typ)
and then not BIP_Call and then not BIP_Call
then then
Insert_Actions_After (Init_After, Insert_Actions_After (Init_After,
......
...@@ -56,6 +56,7 @@ with Sem_Util; use Sem_Util; ...@@ -56,6 +56,7 @@ with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Snames; use Snames; with Snames; use Snames;
with Stand; use Stand; with Stand; use Stand;
with Stringt; use Stringt;
with Targparm; use Targparm; with Targparm; use Targparm;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -1106,6 +1107,334 @@ package body Exp_Ch9 is ...@@ -1106,6 +1107,334 @@ package body Exp_Ch9 is
return Ecount; return Ecount;
end Build_Entry_Count_Expression; end Build_Entry_Count_Expression;
-----------------------
-- Build_Entry_Names --
-----------------------
function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (Conc_Typ);
B_Decls : List_Id;
B_Stmts : List_Id;
Comp : Node_Id;
Index : Entity_Id;
Index_Typ : RE_Id;
Typ : Entity_Id := Conc_Typ;
procedure Build_Entry_Family_Name (Id : Entity_Id);
-- Generate:
-- for Lnn in Family_Low .. Family_High loop
-- Inn := Inn + 1;
-- Set_Entry_Name
-- (_init._object, Inn, new String ("<Entry name> " & Lnn'Img));
-- _init._task_id
-- end loop;
-- Note that the bounds of the range may reference discriminants. The
-- above construct is added directly to the statements of the block.
procedure Build_Entry_Name (Id : Entity_Id);
-- Generate:
-- Inn := Inn + 1;
-- Set_Entry_Name (_init._task_id, Inn, new String ("<Entry name>");
-- _init._object
-- The above construct is added directly to the statements of the block.
function Build_Set_Entry_Name_Call (Arg3 : Node_Id) return Node_Id;
-- Generate the call to the runtime routine Set_Entry_Name with actuals
-- _init._task_id or _init._object, Inn and Arg3.
function Find_Protection_Type (Conc_Typ : Entity_Id) return Entity_Id;
-- Given a protected type or its corresponding record, find the type of
-- field _object.
procedure Increment_Index (Stmts : List_Id);
-- Generate the following and add it to Stmts
-- Inn := Inn + 1;
-----------------------------
-- Build_Entry_Family_Name --
-----------------------------
procedure Build_Entry_Family_Name (Id : Entity_Id) is
Def : constant Node_Id :=
Discrete_Subtype_Definition (Parent (Id));
L_Id : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
L_Stmts : constant List_Id := New_List;
Val : Node_Id;
function Build_Range (Def : Node_Id) return Node_Id;
-- Given a discrete subtype definition of an entry family, generate a
-- range node which covers the range of Def's type.
-----------------
-- Build_Range --
-----------------
function Build_Range (Def : Node_Id) return Node_Id is
High : Node_Id := Type_High_Bound (Etype (Def));
Low : Node_Id := Type_Low_Bound (Etype (Def));
begin
-- If a bound references a discriminant, generate an identifier
-- with the same name. Resolution will map it to the formals of
-- the init proc.
if Is_Entity_Name (Low)
and then Ekind (Entity (Low)) = E_Discriminant
then
Low := Make_Identifier (Loc, Chars (Low));
else
Low := New_Copy_Tree (Low);
end if;
if Is_Entity_Name (High)
and then Ekind (Entity (High)) = E_Discriminant
then
High := Make_Identifier (Loc, Chars (High));
else
High := New_Copy_Tree (High);
end if;
return
Make_Range (Loc,
Low_Bound => Low,
High_Bound => High);
end Build_Range;
-- Start of processing for Build_Entry_Family_Name
begin
Get_Name_String (Chars (Id));
if Is_Enumeration_Type (Etype (Def)) then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ' ';
end if;
-- Generate:
-- new String'("<Entry name>" & Lnn'Img);
Val :=
Make_Allocator (Loc,
Make_Qualified_Expression (Loc,
Subtype_Mark =>
New_Reference_To (Standard_String, Loc),
Expression =>
Make_Op_Concat (Loc,
Left_Opnd =>
Make_String_Literal (Loc,
String_From_Name_Buffer),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Reference_To (L_Id, Loc),
Attribute_Name => Name_Img))));
Increment_Index (L_Stmts);
Append_To (L_Stmts, Build_Set_Entry_Name_Call (Val));
-- Generate:
-- for Lnn in Family_Low .. Family_High loop
-- Inn := Inn + 1;
-- Set_Entry_Name (_init._task_id, Inn, <Val>);
-- end loop;
Append_To (B_Stmts,
Make_Loop_Statement (Loc,
Iteration_Scheme =>
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Make_Loop_Parameter_Specification (Loc,
Defining_Identifier => L_Id,
Discrete_Subtype_Definition =>
Build_Range (Def))),
Statements => L_Stmts,
End_Label => Empty));
end Build_Entry_Family_Name;
----------------------
-- Build_Entry_Name --
----------------------
procedure Build_Entry_Name (Id : Entity_Id) is
Val : Node_Id;
begin
Get_Name_String (Chars (Id));
Val :=
Make_Allocator (Loc,
Make_Qualified_Expression (Loc,
Subtype_Mark =>
New_Reference_To (Standard_String, Loc),
Expression =>
Make_String_Literal (Loc,
String_From_Name_Buffer)));
Increment_Index (B_Stmts);
Append_To (B_Stmts, Build_Set_Entry_Name_Call (Val));
end Build_Entry_Name;
-------------------------------
-- Build_Set_Entry_Name_Call --
-------------------------------
function Build_Set_Entry_Name_Call (Arg3 : Node_Id) return Node_Id is
Arg1 : Name_Id;
Proc : RE_Id;
begin
-- Determine the proper name for the first argument and the RTS
-- routine to call.
if Is_Protected_Type (Typ) then
Arg1 := Name_uObject;
Proc := RO_PE_Set_Entry_Name;
else pragma Assert (Is_Task_Type (Typ));
Arg1 := Name_uTask_Id;
Proc := RO_TS_Set_Entry_Name;
end if;
-- Generate:
-- Set_Entry_Name (_init.Arg1, Inn, Arg3);
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (Proc), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc, -- _init._object
Prefix => -- _init._task_id
Make_Identifier (Loc, Name_uInit),
Selector_Name =>
Make_Identifier (Loc, Arg1)),
New_Reference_To (Index, Loc), -- Inn
Arg3)); -- Val
end Build_Set_Entry_Name_Call;
--------------------------
-- Find_Protection_Type --
--------------------------
function Find_Protection_Type (Conc_Typ : Entity_Id) return Entity_Id is
Comp : Entity_Id;
Typ : Entity_Id := Conc_Typ;
begin
if Is_Concurrent_Type (Typ) then
Typ := Corresponding_Record_Type (Typ);
end if;
Comp := First_Component (Typ);
while Present (Comp) loop
if Chars (Comp) = Name_uObject then
return Base_Type (Etype (Comp));
end if;
Next_Component (Comp);
end loop;
-- The corresponding record of a protected type should always have an
-- _object field.
raise Program_Error;
end Find_Protection_Type;
---------------------
-- Increment_Index --
---------------------
procedure Increment_Index (Stmts : List_Id) is
begin
-- Generate:
-- Inn := Inn + 1;
Append_To (Stmts,
Make_Assignment_Statement (Loc,
Name =>
New_Reference_To (Index, Loc),
Expression =>
Make_Op_Add (Loc,
Left_Opnd =>
New_Reference_To (Index, Loc),
Right_Opnd =>
Make_Integer_Literal (Loc, 1))));
end Increment_Index;
-- Start of processing for Build_Entry_Names
begin
-- Retrieve the original concurrent type
if Is_Concurrent_Record_Type (Typ) then
Typ := Corresponding_Concurrent_Type (Typ);
end if;
pragma Assert (Is_Protected_Type (Typ) or else Is_Task_Type (Typ));
-- Nothing to do if the type has no entries
if not Has_Entries (Typ) then
return Empty;
end if;
-- Avoid generating entry names for a protected type with only one entry
if Is_Protected_Type (Typ)
and then Find_Protection_Type (Typ) /= RTE (RE_Protection_Entries)
then
return Empty;
end if;
Index := Make_Defining_Identifier (Loc, New_Internal_Name ('I'));
-- Step 1: Generate the declaration of the index variable:
-- Inn : Protected_Entry_Index := 0;
-- or
-- Inn : Task_Entry_Index := 0;
if Is_Protected_Type (Typ) then
Index_Typ := RE_Protected_Entry_Index;
else
Index_Typ := RE_Task_Entry_Index;
end if;
B_Decls := New_List;
Append_To (B_Decls,
Make_Object_Declaration (Loc,
Defining_Identifier => Index,
Object_Definition =>
New_Reference_To (RTE (Index_Typ), Loc),
Expression =>
Make_Integer_Literal (Loc, 0)));
B_Stmts := New_List;
-- Step 2: Generate a call to Set_Entry_Name for each entry and entry
-- family member.
Comp := First_Entity (Typ);
while Present (Comp) loop
if Ekind (Comp) = E_Entry then
Build_Entry_Name (Comp);
elsif Ekind (Comp) = E_Entry_Family then
Build_Entry_Family_Name (Comp);
end if;
Next_Entity (Comp);
end loop;
-- Step 3: Wrap the statements in a block
return
Make_Block_Statement (Loc,
Declarations => B_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => B_Stmts));
end Build_Entry_Names;
--------------------------- ---------------------------
-- Build_Parameter_Block -- -- Build_Parameter_Block --
--------------------------- ---------------------------
...@@ -11250,8 +11579,8 @@ package body Exp_Ch9 is ...@@ -11250,8 +11579,8 @@ package body Exp_Ch9 is
or else Has_Abstract_Interfaces (Protect_Rec) or else Has_Abstract_Interfaces (Protect_Rec)
then then
declare declare
Pkg_Id : constant RTU_Id := Corresponding_Runtime_Package (Ptyp); Pkg_Id : constant RTU_Id :=
Corresponding_Runtime_Package (Ptyp);
Called_Subp : RE_Id; Called_Subp : RE_Id;
begin begin
...@@ -11302,6 +11631,20 @@ package body Exp_Ch9 is ...@@ -11302,6 +11631,20 @@ package body Exp_Ch9 is
Prefix => Prefix =>
New_Reference_To (P_Arr, Loc), New_Reference_To (P_Arr, Loc),
Attribute_Name => Name_Unrestricted_Access)); Attribute_Name => Name_Unrestricted_Access));
-- Build_Entry_Names generation flag. When set to true, the
-- runtime will allocate an array to hold the string names
-- of protected entries.
if not Restricted_Profile then
if Entry_Names_OK then
Append_To (Args,
New_Reference_To (Standard_True, Loc));
else
Append_To (Args,
New_Reference_To (Standard_False, Loc));
end if;
end if;
end if; end if;
elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry then elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry then
...@@ -11310,6 +11653,7 @@ package body Exp_Ch9 is ...@@ -11310,6 +11653,7 @@ package body Exp_Ch9 is
elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
Append_To (Args, Make_Null (Loc)); Append_To (Args, Make_Null (Loc));
Append_To (Args, Make_Null (Loc)); Append_To (Args, Make_Null (Loc));
Append_To (Args, New_Reference_To (Standard_False, Loc));
end if; end if;
Append_To (L, Append_To (L,
...@@ -11422,13 +11766,13 @@ package body Exp_Ch9 is ...@@ -11422,13 +11766,13 @@ package body Exp_Ch9 is
function Make_Task_Create_Call (Task_Rec : Entity_Id) return Node_Id is function Make_Task_Create_Call (Task_Rec : Entity_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (Task_Rec); Loc : constant Source_Ptr := Sloc (Task_Rec);
Args : List_Id;
Ecount : Node_Id;
Name : Node_Id; Name : Node_Id;
Tdef : Node_Id;
Tdec : Node_Id; Tdec : Node_Id;
Ttyp : Node_Id; Tdef : Node_Id;
Tnam : Name_Id; Tnam : Name_Id;
Args : List_Id; Ttyp : Node_Id;
Ecount : Node_Id;
begin begin
Ttyp := Corresponding_Concurrent_Type (Task_Rec); Ttyp := Corresponding_Concurrent_Type (Task_Rec);
...@@ -11682,14 +12026,29 @@ package body Exp_Ch9 is ...@@ -11682,14 +12026,29 @@ package body Exp_Ch9 is
Prefix => Make_Identifier (Loc, Name_uInit), Prefix => Make_Identifier (Loc, Name_uInit),
Selector_Name => Make_Identifier (Loc, Name_uTask_Id))); Selector_Name => Make_Identifier (Loc, Name_uTask_Id)));
-- Build_Entry_Names generation flag. When set to true, the runtime
-- will allocate an array to hold the string names of task entries.
if not Restricted_Profile then
if Has_Entries (Ttyp)
and then Entry_Names_OK
then
Append_To (Args, New_Reference_To (Standard_True, Loc));
else
Append_To (Args, New_Reference_To (Standard_False, Loc));
end if;
end if;
if Restricted_Profile then if Restricted_Profile then
Name := New_Reference_To (RTE (RE_Create_Restricted_Task), Loc); Name := New_Reference_To (RTE (RE_Create_Restricted_Task), Loc);
else else
Name := New_Reference_To (RTE (RE_Create_Task), Loc); Name := New_Reference_To (RTE (RE_Create_Task), Loc);
end if; end if;
return Make_Procedure_Call_Statement (Loc, return
Name => Name, Parameter_Associations => Args); Make_Procedure_Call_Statement (Loc,
Name => Name,
Parameter_Associations => Args);
end Make_Task_Create_Call; end Make_Task_Create_Call;
------------------------------ ------------------------------
......
...@@ -58,6 +58,11 @@ package Exp_Ch9 is ...@@ -58,6 +58,11 @@ package Exp_Ch9 is
-- build record declaration. N is the type declaration, Ctyp is the -- build record declaration. N is the type declaration, Ctyp is the
-- concurrent entity (task type or protected type). -- concurrent entity (task type or protected 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); procedure Build_Master_Entity (E : Entity_Id);
-- Given an entity E for the declaration of an object containing tasks -- 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 -- or of a type declaration for an allocator whose designated type is a
......
...@@ -1116,6 +1116,19 @@ package body Exp_Util is ...@@ -1116,6 +1116,19 @@ package body Exp_Util is
end if; end if;
end Ensure_Defined; end Ensure_Defined;
--------------------
-- Entry_Names_OK --
--------------------
function Entry_Names_OK return Boolean is
begin
return
not Restricted_Profile
and then not Global_Discard_Names
and then not Restriction_Active (No_Implicit_Heap_Allocations)
and then not Restriction_Active (No_Local_Allocators);
end Entry_Names_OK;
--------------------- ---------------------
-- Evolve_And_Then -- -- Evolve_And_Then --
--------------------- ---------------------
......
...@@ -314,6 +314,11 @@ package Exp_Util is ...@@ -314,6 +314,11 @@ package Exp_Util is
-- used to ensure that an Itype is properly defined outside a conditional -- used to ensure that an Itype is properly defined outside a conditional
-- construct when it is referenced in more than one branch. -- construct when it is referenced in more than one branch.
function Entry_Names_OK return Boolean;
-- Determine whether it is appropriate to dynamically allocate strings
-- which represent entry [family member] names. These strings are created
-- by the compiler and used by GDB.
procedure Evolve_And_Then (Cond : in out Node_Id; Cond1 : Node_Id); procedure Evolve_And_Then (Cond : in out Node_Id; Cond1 : Node_Id);
-- Rewrites Cond with the expression: Cond and then Cond1. If Cond is -- Rewrites Cond with the expression: Cond and then Cond1. If Cond is
-- Empty, then simply returns Cond1 (this allows the use of Empty to -- Empty, then simply returns Cond1 (this allows the use of Empty to
......
...@@ -1516,7 +1516,9 @@ package Rtsfind is ...@@ -1516,7 +1516,9 @@ package Rtsfind is
RE_Lock_Entries, -- Tasking.Protected_Objects.Entries RE_Lock_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Entry_Name, -- Tasking.Protected_Objects.Entries
RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries
RE_Communication_Block, -- Protected_Objects.Operations RE_Communication_Block, -- Protected_Objects.Operations
RE_Protected_Entry_Call, -- Protected_Objects.Operations RE_Protected_Entry_Call, -- Protected_Objects.Operations
RE_Service_Entries, -- Protected_Objects.Operations RE_Service_Entries, -- Protected_Objects.Operations
...@@ -1590,6 +1592,7 @@ package Rtsfind is ...@@ -1590,6 +1592,7 @@ package Rtsfind is
RE_Free_Task, -- System.Tasking.Stages RE_Free_Task, -- System.Tasking.Stages
RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages
RE_Move_Activation_Chain, -- System_Tasking_Stages RE_Move_Activation_Chain, -- System_Tasking_Stages
RO_TS_Set_Entry_Name, -- System.Tasking.Stages
RE_Terminated); -- System.Tasking.Stages RE_Terminated); -- System.Tasking.Stages
-- The following declarations build a table that is indexed by the -- The following declarations build a table that is indexed by the
...@@ -2652,8 +2655,11 @@ package Rtsfind is ...@@ -2652,8 +2655,11 @@ package Rtsfind is
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RO_PE_Set_Ceiling => RO_PE_Set_Ceiling =>
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RO_PE_Set_Entry_Name =>
System_Tasking_Protected_Objects_Entries,
RE_Unlock_Entries => RE_Unlock_Entries =>
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RE_Communication_Block => RE_Communication_Block =>
System_Tasking_Protected_Objects_Operations, System_Tasking_Protected_Objects_Operations,
RE_Protected_Entry_Call => RE_Protected_Entry_Call =>
...@@ -2754,6 +2760,7 @@ package Rtsfind is ...@@ -2754,6 +2760,7 @@ package Rtsfind is
RE_Free_Task => System_Tasking_Stages, RE_Free_Task => System_Tasking_Stages,
RE_Expunge_Unactivated_Tasks => System_Tasking_Stages, RE_Expunge_Unactivated_Tasks => System_Tasking_Stages,
RE_Move_Activation_Chain => System_Tasking_Stages, RE_Move_Activation_Chain => System_Tasking_Stages,
RO_TS_Set_Entry_Name => System_Tasking_Stages,
RE_Terminated => System_Tasking_Stages); RE_Terminated => System_Tasking_Stages);
-------------------------------- --------------------------------
......
...@@ -35,6 +35,8 @@ pragma Polling (Off); ...@@ -35,6 +35,8 @@ pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during tasking -- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems. -- operations. It causes infinite loops and other problems.
with Ada.Unchecked_Deallocation;
with System.Task_Primitives.Operations; with System.Task_Primitives.Operations;
with System.Storage_Elements; with System.Storage_Elements;
...@@ -42,6 +44,19 @@ package body System.Tasking is ...@@ -42,6 +44,19 @@ package body System.Tasking is
package STPO renames System.Task_Primitives.Operations; package STPO renames System.Task_Primitives.Operations;
----------------------------
-- Free_Entry_Names_Array --
----------------------------
procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array) is
procedure Free_String is new
Ada.Unchecked_Deallocation (String, String_Access);
begin
for Index in Obj'Range loop
Free_String (Obj (Index));
end loop;
end Free_Entry_Names_Array;
--------------------- ---------------------
-- Detect_Blocking -- -- Detect_Blocking --
--------------------- ---------------------
......
...@@ -237,6 +237,19 @@ package System.Tasking is ...@@ -237,6 +237,19 @@ package System.Tasking is
type Task_Entry_Queue_Array is type Task_Entry_Queue_Array is
array (Task_Entry_Index range <>) of Entry_Queue; array (Task_Entry_Index range <>) of Entry_Queue;
-- A data structure which contains the string names of entries and entry
-- family members.
type String_Access is access all String;
type Entry_Names_Array is
array (Entry_Index range <>) of String_Access;
type Entry_Names_Array_Access is access all Entry_Names_Array;
procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array);
-- Deallocate all string names contained in an entry names array
---------------------------------- ----------------------------------
-- Entry_Call_Record definition -- -- Entry_Call_Record definition --
---------------------------------- ----------------------------------
...@@ -441,19 +454,17 @@ package System.Tasking is ...@@ -441,19 +454,17 @@ package System.Tasking is
-- and rendezvous. -- and rendezvous.
-- --
-- Ada 95 notes: In Ada 95, this field will be transferred to the -- Ada 95 notes: In Ada 95, this field will be transferred to the
-- Priority field of an Entry_Calls component when an entry call -- Priority field of an Entry_Calls component when an entry call is
-- is initiated. The Priority of the Entry_Calls component will not -- initiated. The Priority of the Entry_Calls component will not change
-- change for the duration of the call. The accepting task can -- for the duration of the call. The accepting task can use it to boost
-- use it to boost its own priority without fear of its changing in -- its own priority without fear of its changing in the meantime.
-- the meantime.
-- --
-- This can safely be used in the priority ordering -- This can safely be used in the priority ordering of entry queues.
-- of entry queues. Once a call is queued, its priority does not -- Once a call is queued, its priority does not change.
-- change.
-- --
-- Since an entry call cannot be made while executing -- Since an entry call cannot be made while executing a protected
-- a protected action, the priority of a task will never reflect a -- action, the priority of a task will never reflect a priority ceiling
-- priority ceiling change at the point of an entry call. -- change at the point of an entry call.
-- --
-- Protection: Only written by Self, and only accessed when Acceptor -- Protection: Only written by Self, and only accessed when Acceptor
-- accepts an entry or when Created activates, at which points Self is -- accepts an entry or when Created activates, at which points Self is
...@@ -467,8 +478,8 @@ package System.Tasking is ...@@ -467,8 +478,8 @@ package System.Tasking is
-- can be read/written from protected interrupt handlers. -- can be read/written from protected interrupt handlers.
Task_Image : String (1 .. System.Parameters.Max_Task_Image_Length); Task_Image : String (1 .. System.Parameters.Max_Task_Image_Length);
-- Hold a string that provides a readable id for task, -- Hold a string that provides a readable id for task, built from the
-- built from the variable of which it is a value or component. -- variable of which it is a value or component.
Task_Image_Len : Natural; Task_Image_Len : Natural;
-- Actual length of Task_Image -- Actual length of Task_Image
...@@ -489,7 +500,7 @@ package System.Tasking is ...@@ -489,7 +500,7 @@ package System.Tasking is
Task_Arg : System.Address; Task_Arg : System.Address;
-- The argument to task procedure. Provide a handle for discriminant -- The argument to task procedure. Provide a handle for discriminant
-- information -- information.
-- --
-- Protection: Part of the synchronization between Self and Activator. -- Protection: Part of the synchronization between Self and Activator.
-- Activator writes it, once, before Self starts executing. Thereafter, -- Activator writes it, once, before Self starts executing. Thereafter,
...@@ -605,10 +616,9 @@ package System.Tasking is ...@@ -605,10 +616,9 @@ package System.Tasking is
-- Restricted_Ada_Task_Control_Block -- -- Restricted_Ada_Task_Control_Block --
--------------------------------------- ---------------------------------------
-- This type should only be used by the restricted GNARLI and by -- This type should only be used by the restricted GNARLI and by restricted
-- restricted GNULL implementations to allocate an ATCB (see -- GNULL implementations to allocate an ATCB (see System.Task_Primitives.
-- System.Task_Primitives.Operations.New_ATCB) that will take -- Operations.New_ATCB) that will take significantly less memory.
-- significantly less memory.
-- Note that the restricted GNARLI should only access fields that are -- Note that the restricted GNARLI should only access fields that are
-- present in the Restricted_Ada_Task_Control_Block structure. -- present in the Restricted_Ada_Task_Control_Block structure.
...@@ -855,6 +865,11 @@ package System.Tasking is ...@@ -855,6 +865,11 @@ package System.Tasking is
-- associated with protected objects or task entries, and are protected -- associated with protected objects or task entries, and are protected
-- by the protected object lock or Acceptor.L, respectively. -- by the protected object lock or Acceptor.L, respectively.
Entry_Names : Entry_Names_Array_Access := null;
-- An array of string names which denotes entry [family member] names.
-- The structure is indexed by task entry index and contains Entry_Num
-- components.
New_Base_Priority : System.Any_Priority; New_Base_Priority : System.Any_Priority;
-- New value for Base_Priority (for dynamic priorities package) -- New value for Base_Priority (for dynamic priorities package)
-- --
......
...@@ -88,6 +88,9 @@ package body System.Tasking.Stages is ...@@ -88,6 +88,9 @@ package body System.Tasking.Stages is
procedure Free is new procedure Free is new
Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
procedure Free_Entry_Names (T : Task_Id);
-- Deallocate all string names associated with task entries
procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id); procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id);
-- This procedure outputs the task specific message for exception -- This procedure outputs the task specific message for exception
-- tracing purposes. -- tracing purposes.
...@@ -465,7 +468,8 @@ package body System.Tasking.Stages is ...@@ -465,7 +468,8 @@ package body System.Tasking.Stages is
Elaborated : Access_Boolean; Elaborated : Access_Boolean;
Chain : in out Activation_Chain; Chain : in out Activation_Chain;
Task_Image : String; Task_Image : String;
Created_Task : out Task_Id) Created_Task : out Task_Id;
Build_Entry_Names : Boolean)
is is
T, P : Task_Id; T, P : Task_Id;
Self_ID : constant Task_Id := STPO.Self; Self_ID : constant Task_Id := STPO.Self;
...@@ -605,6 +609,11 @@ package body System.Tasking.Stages is ...@@ -605,6 +609,11 @@ package body System.Tasking.Stages is
T.Common.Task_Image_Len := Len; T.Common.Task_Image_Len := Len;
end if; end if;
if Build_Entry_Names then
T.Entry_Names :=
new Entry_Names_Array (1 .. Entry_Index (Num_Entries));
end if;
Unlock (Self_ID); Unlock (Self_ID);
Unlock_RTS; Unlock_RTS;
...@@ -816,6 +825,26 @@ package body System.Tasking.Stages is ...@@ -816,6 +825,26 @@ package body System.Tasking.Stages is
end Finalize_Global_Tasks; end Finalize_Global_Tasks;
----------------------
-- Free_Entry_Names --
----------------------
procedure Free_Entry_Names (T : Task_Id) is
Names : Entry_Names_Array_Access := T.Entry_Names;
procedure Free_Entry_Names_Array_Access is new
Ada.Unchecked_Deallocation
(Entry_Names_Array, Entry_Names_Array_Access);
begin
if Names = null then
return;
end if;
Free_Entry_Names_Array (Names.all);
Free_Entry_Names_Array_Access (Names);
end Free_Entry_Names;
--------------- ---------------
-- Free_Task -- -- Free_Task --
--------------- ---------------
...@@ -837,6 +866,7 @@ package body System.Tasking.Stages is ...@@ -837,6 +866,7 @@ package body System.Tasking.Stages is
Initialization.Task_Unlock (Self_Id); Initialization.Task_Unlock (Self_Id);
Free_Entry_Names (T);
System.Task_Primitives.Operations.Finalize_TCB (T); System.Task_Primitives.Operations.Finalize_TCB (T);
-- If the task is not terminated, then we simply ignore the call. This -- If the task is not terminated, then we simply ignore the call. This
...@@ -895,6 +925,23 @@ package body System.Tasking.Stages is ...@@ -895,6 +925,23 @@ package body System.Tasking.Stages is
Initialization.Undefer_Abort (Self_ID); Initialization.Undefer_Abort (Self_ID);
end Move_Activation_Chain; end Move_Activation_Chain;
-- Compiler interface only. Do not call from within the RTS.
--------------------
-- Set_Entry_Name --
--------------------
procedure Set_Entry_Name
(T : Task_Id;
Pos : Task_Entry_Index;
Val : String_Access)
is
begin
pragma Assert (T.Entry_Names /= null);
T.Entry_Names (Entry_Index (Pos)) := Val;
end Set_Entry_Name;
------------------ ------------------
-- Task_Wrapper -- -- Task_Wrapper --
------------------ ------------------
...@@ -1419,15 +1466,15 @@ package body System.Tasking.Stages is ...@@ -1419,15 +1466,15 @@ package body System.Tasking.Stages is
-------------------------------- --------------------------------
procedure Vulnerable_Complete_Master (Self_ID : Task_Id) is procedure Vulnerable_Complete_Master (Self_ID : Task_Id) is
C : Task_Id; C : Task_Id;
P : Task_Id; P : Task_Id;
CM : constant Master_Level := Self_ID.Master_Within; CM : constant Master_Level := Self_ID.Master_Within;
T : aliased Task_Id; T : aliased Task_Id;
To_Be_Freed : Task_Id; To_Be_Freed : Task_Id;
-- This is a list of ATCBs to be freed, after we have released -- This is a list of ATCBs to be freed, after we have released all RTS
-- all RTS locks. This is necessary because of the locking order -- locks. This is necessary because of the locking order rules, since
-- rules, since the storage manager uses Global_Task_Lock. -- the storage manager uses Global_Task_Lock.
pragma Warnings (Off); pragma Warnings (Off);
function Check_Unactivated_Tasks return Boolean; function Check_Unactivated_Tasks return Boolean;
...@@ -1877,6 +1924,7 @@ package body System.Tasking.Stages is ...@@ -1877,6 +1924,7 @@ package body System.Tasking.Stages is
Unlock_RTS; Unlock_RTS;
end if; end if;
Free_Entry_Names (T);
System.Task_Primitives.Operations.Finalize_TCB (T); System.Task_Primitives.Operations.Finalize_TCB (T);
end Vulnerable_Free_Task; end Vulnerable_Free_Task;
......
...@@ -180,7 +180,8 @@ package System.Tasking.Stages is ...@@ -180,7 +180,8 @@ package System.Tasking.Stages is
Elaborated : Access_Boolean; Elaborated : Access_Boolean;
Chain : in out Activation_Chain; Chain : in out Activation_Chain;
Task_Image : String; Task_Image : String;
Created_Task : out Task_Id); Created_Task : out Task_Id;
Build_Entry_Names : Boolean);
-- Compiler interface only. Do not call from within the RTS. -- Compiler interface only. Do not call from within the RTS.
-- This must be called to create a new task. -- This must be called to create a new task.
-- --
...@@ -190,7 +191,7 @@ package System.Tasking.Stages is ...@@ -190,7 +191,7 @@ package System.Tasking.Stages is
-- Task_Info is the task info associated with the created task, or -- Task_Info is the task info associated with the created task, or
-- Unspecified_Task_Info if none. -- Unspecified_Task_Info if none.
-- Relative_Deadline is the relative deadline associated with the created -- Relative_Deadline is the relative deadline associated with the created
-- task by means of a pragma Relative_Deadline, or 0.0 if none. -- task by means of a pragma Relative_Deadline, or 0.0 if none.
-- State is the compiler generated task's procedure body -- State is the compiler generated task's procedure body
-- Discriminants is a pointer to a limited record whose discriminants -- Discriminants is a pointer to a limited record whose discriminants
-- are those of the task to create. This parameter should be passed as -- are those of the task to create. This parameter should be passed as
...@@ -205,6 +206,8 @@ package System.Tasking.Stages is ...@@ -205,6 +206,8 @@ package System.Tasking.Stages is
-- run time can store to ease the debugging and the -- run time can store to ease the debugging and the
-- Ada.Task_Identification facility. -- Ada.Task_Identification facility.
-- Created_Task is the resulting task. -- Created_Task is the resulting task.
-- Build_Entry_Names is a flag which controls the allocation of the data
-- structure which stores all entry names.
-- --
-- This procedure can raise Storage_Error if the task creation failed. -- This procedure can raise Storage_Error if the task creation failed.
...@@ -276,6 +279,13 @@ package System.Tasking.Stages is ...@@ -276,6 +279,13 @@ package System.Tasking.Stages is
-- that doesn't happen, they will never be activated, and will become -- that doesn't happen, they will never be activated, and will become
-- terminated on leaving the return statement. -- terminated on leaving the return statement.
procedure Set_Entry_Name
(T : Task_Id;
Pos : Task_Entry_Index;
Val : String_Access);
-- This is called by the compiler to map a string which denotes an entry
-- name to a task entry index.
function Terminated (T : Task_Id) return Boolean; function Terminated (T : Task_Id) return Boolean;
-- This is called by the compiler to implement the 'Terminated attribute. -- This is called by the compiler to implement the 'Terminated attribute.
-- Though is not required to be so by the ARM, we choose to synchronize -- Though is not required to be so by the ARM, we choose to synchronize
......
...@@ -43,6 +43,8 @@ ...@@ -43,6 +43,8 @@
-- Note: the compiler generates direct calls to this interface, via Rtsfind -- Note: the compiler generates direct calls to this interface, via Rtsfind
with Ada.Unchecked_Deallocation;
with System.Task_Primitives.Operations; with System.Task_Primitives.Operations;
with System.Restrictions; with System.Restrictions;
with System.Parameters; with System.Parameters;
...@@ -58,6 +60,13 @@ package body System.Tasking.Protected_Objects.Entries is ...@@ -58,6 +60,13 @@ package body System.Tasking.Protected_Objects.Entries is
use Parameters; use Parameters;
use Task_Primitives.Operations; use Task_Primitives.Operations;
-----------------------
-- Local Subprograms --
-----------------------
procedure Free_Entry_Names (Object : Protection_Entries);
-- Deallocate all string names associated with protected entries
---------------- ----------------
-- Local Data -- -- Local Data --
---------------- ----------------
...@@ -134,6 +143,8 @@ package body System.Tasking.Protected_Objects.Entries is ...@@ -134,6 +143,8 @@ package body System.Tasking.Protected_Objects.Entries is
end loop; end loop;
end loop; end loop;
Free_Entry_Names (Object);
Object.Finalized := True; Object.Finalized := True;
if Single_Lock then if Single_Lock then
...@@ -145,6 +156,26 @@ package body System.Tasking.Protected_Objects.Entries is ...@@ -145,6 +156,26 @@ package body System.Tasking.Protected_Objects.Entries is
STPO.Finalize_Lock (Object.L'Unrestricted_Access); STPO.Finalize_Lock (Object.L'Unrestricted_Access);
end Finalize; end Finalize;
----------------------
-- Free_Entry_Names --
----------------------
procedure Free_Entry_Names (Object : Protection_Entries) is
Names : Entry_Names_Array_Access := Object.Entry_Names;
procedure Free_Entry_Names_Array_Access is new
Ada.Unchecked_Deallocation
(Entry_Names_Array, Entry_Names_Array_Access);
begin
if Names = null then
return;
end if;
Free_Entry_Names_Array (Names.all);
Free_Entry_Names_Array_Access (Names);
end Free_Entry_Names;
----------------- -----------------
-- Get_Ceiling -- -- Get_Ceiling --
----------------- -----------------
...@@ -177,14 +208,15 @@ package body System.Tasking.Protected_Objects.Entries is ...@@ -177,14 +208,15 @@ package body System.Tasking.Protected_Objects.Entries is
Ceiling_Priority : Integer; Ceiling_Priority : Integer;
Compiler_Info : System.Address; Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access; Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access) Find_Body_Index : Find_Body_Index_Access;
Build_Entry_Names : Boolean)
is is
Init_Priority : Integer := Ceiling_Priority; Init_Priority : Integer := Ceiling_Priority;
Self_ID : constant Task_Id := STPO.Self; Self_ID : constant Task_Id := STPO.Self;
begin begin
if Init_Priority = Unspecified_Priority then if Init_Priority = Unspecified_Priority then
Init_Priority := System.Priority'Last; Init_Priority := System.Priority'Last;
end if; end if;
if Locking_Policy = 'C' if Locking_Policy = 'C'
...@@ -213,6 +245,11 @@ package body System.Tasking.Protected_Objects.Entries is ...@@ -213,6 +245,11 @@ package body System.Tasking.Protected_Objects.Entries is
Object.Entry_Queues (E).Head := null; Object.Entry_Queues (E).Head := null;
Object.Entry_Queues (E).Tail := null; Object.Entry_Queues (E).Tail := null;
end loop; end loop;
if Build_Entry_Names then
Object.Entry_Names :=
new Entry_Names_Array (1 .. Entry_Index (Object.Num_Entries));
end if;
end Initialize_Protection_Entries; end Initialize_Protection_Entries;
------------------ ------------------
...@@ -358,6 +395,21 @@ package body System.Tasking.Protected_Objects.Entries is ...@@ -358,6 +395,21 @@ package body System.Tasking.Protected_Objects.Entries is
end Set_Ceiling; end Set_Ceiling;
-------------------- --------------------
-- Set_Entry_Name --
--------------------
procedure Set_Entry_Name
(Object : Protection_Entries'Class;
Pos : Protected_Entry_Index;
Val : String_Access)
is
begin
pragma Assert (Object.Entry_Names /= null);
Object.Entry_Names (Entry_Index (Pos)) := Val;
end Set_Entry_Name;
--------------------
-- Unlock_Entries -- -- Unlock_Entries --
-------------------- --------------------
......
...@@ -113,7 +113,7 @@ package System.Tasking.Protected_Objects.Entries is ...@@ -113,7 +113,7 @@ package System.Tasking.Protected_Objects.Entries is
Old_Base_Priority : System.Any_Priority; Old_Base_Priority : System.Any_Priority;
-- Task's base priority when the protected operation was called -- Task's base priority when the protected operation was called
Pending_Action : Boolean; Pending_Action : Boolean;
-- Flag indicating that priority has been dipped temporarily in order -- Flag indicating that priority has been dipped temporarily in order
-- to avoid violating the priority ceiling of the lock associated with -- to avoid violating the priority ceiling of the lock associated with
-- this protected object, in Lock_Server. The flag tells Unlock_Server -- this protected object, in Lock_Server. The flag tells Unlock_Server
...@@ -132,11 +132,16 @@ package System.Tasking.Protected_Objects.Entries is ...@@ -132,11 +132,16 @@ package System.Tasking.Protected_Objects.Entries is
-- Pointer to an array containing the executable code for all entry -- Pointer to an array containing the executable code for all entry
-- bodies of a protected type. -- bodies of a protected type.
-- The following function maps the entry index in a call (which denotes
-- the queue to the proper entry) into the body of the entry.
Find_Body_Index : Find_Body_Index_Access; Find_Body_Index : Find_Body_Index_Access;
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries); -- A function which maps the entry index in a call (which denotes the
-- queue of the proper entry) into the body of the entry.
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
Entry_Names : Entry_Names_Array_Access := null;
-- An array of string names which denotes entry [family member] names.
-- The structure is indexed by protected entry index and contains Num_
-- Entries components.
end record; end record;
-- No default initial values for this type, since call records -- No default initial values for this type, since call records
...@@ -164,11 +169,12 @@ package System.Tasking.Protected_Objects.Entries is ...@@ -164,11 +169,12 @@ package System.Tasking.Protected_Objects.Entries is
-- System.Tasking.Protected_Objects.Initialize_Protection. -- System.Tasking.Protected_Objects.Initialize_Protection.
procedure Initialize_Protection_Entries procedure Initialize_Protection_Entries
(Object : Protection_Entries_Access; (Object : Protection_Entries_Access;
Ceiling_Priority : Integer; Ceiling_Priority : Integer;
Compiler_Info : System.Address; Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access; Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access); Find_Body_Index : Find_Body_Index_Access;
Build_Entry_Names : Boolean);
-- Initialize the Object parameter so that it can be used by the runtime -- Initialize the Object parameter so that it can be used by the runtime
-- to keep track of the runtime state of a protected object. -- to keep track of the runtime state of a protected object.
...@@ -202,6 +208,13 @@ package System.Tasking.Protected_Objects.Entries is ...@@ -202,6 +208,13 @@ package System.Tasking.Protected_Objects.Entries is
Prio : System.Any_Priority); Prio : System.Any_Priority);
-- Sets the new ceiling priority of the protected object -- Sets the new ceiling priority of the protected object
procedure Set_Entry_Name
(Object : Protection_Entries'Class;
Pos : Protected_Entry_Index;
Val : String_Access);
-- This is called by the compiler to map a string which denotes an entry
-- name to a protected entry index.
procedure Unlock_Entries (Object : Protection_Entries_Access); procedure Unlock_Entries (Object : Protection_Entries_Access);
-- Relinquish ownership of the lock for the object represented by the -- Relinquish ownership of the lock for the object represented by the
-- Object parameter. If this ownership was for write access, or if it was -- Object parameter. If this ownership was for write access, or if it was
......
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