diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c200a06367c..f83800cb018 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,82 @@ +2012-10-29 Tristan Gingold + + * gnat_rm.texi: Document implementation advice for Pragma + Partition_Elaboration_Policy. + +2012-10-29 Yannick Moy + + * s-bignum.adb (Div_Rem): Reference that Algorithm_D is from + the second edition of TAOCP from Knuth, since the algo changed + in the third edition. Also correct the definition of 'd' which + could overflow. + +2012-10-29 Hristian Kirtchev + + * exp_ch3.adb (Build_Initialization_Call): Create static strings + which denote entry [family] names and associate them with the + object's Protection_Entries or ATCB. + (Build_Init_Statements): + Remove local variable Names. Do not generate the entry [family] + names inside the init proc because they are now static. + * exp_ch9.adb (Build_Entry_Names): Reimplemented. The strings + which denote entry [family] names are now generated statically + and associated with the concurrent object's Protection_Entries + or ATCB during initialization. + * exp_ch9.ads (Build_Entry_Names): Change subprogram profile + and associated comment on usage. + * rtsfind.ads: Add the following entries to tables RE_Id and + RE_Unit_Table: + + RE_Protected_Entry_Names_Array RE_Task_Entry_Names_Array + RO_PE_Number_Of_Entries RO_PE_Set_Entry_Names + RO_ST_Number_Of_Entries RO_ST_Set_Entry_Names + + Remove the following entries from tables RE_Id and RE_Unit_Table: + + RO_PE_Set_Entry_Name RO_TS_Set_Entry_Name + + * s-taskin.adb: Remove with clause for Ada.Unchecked_Deallocation. + (Free_Entry_Names_Array): Removed. + (Number_Of_Entries): New routine. + (Set_Entry_Names): New routine. + * s-taskin.ads: Rename type Entry_Names_Array to + Task_Entry_Names_Array. Rename type Entry_Names_Array_Access + to Task_Entry_Names_Access. Update the type of ACTB field + Entry_Names and add a comment on its protection status. + (Free_Entry_Names_Array): Removed. + (Number_Of_Entries): New routine. + (Set_Entry_Names): New routine. + * s-tassta.adb (Create_Task): Remove formal parameter + Build_Entry_Names. Do not allocate an array to hold the + string names of entries and families. + (Free_Entry_Names): Removed. + (Free_Task): Remove the call to Free_Entry_Names. + (Set_Entry_Name): Removed. + (Vulnerable_Free_Task): Remove the call to Free_Entry_Names. + * s-tassta.ads (Create_Task): Remove formal parameter + Build_Entry_Names along with associated comment. + (Set_Entry_Name): Removed. + * s-tpoben.adb: Remove with clause for Ada.Unchecked_Deallocation. + (Finalize): Remove the call to Free_Entry_Names. + (Free_Entry_Names): Removed. + (Initialize_Protection_Entries): + Remove formal parameter Build_Entry_Names. Do not allocate + an array to hold the string names of entries and families. + (Number_Of_Entries): New routine. + (Set_Entry_Name): Removed. + (Set_Entry_Names): New routine. + * s-tpoben.ads: Add types Protected_Entry_Names_Array and + Protected_Entry_Names_Access. Update the type of Protection_Enties + field Entry_Names. + (Initialize_Protection_Entries): Remove + formal parameter Build_Entry_Names along with associated comment. + (Number_Of_Entries): New routine. + (Set_Entry_Name): Removed. + (Set_Entry_Names): New routine. + +2012-10-29 Arnaud Charlet + + * gnat_ugn.texi: Minor typo fix. 2012-10-29 Yannick Moy * debug.adb Associate debug switch -gnatd.V to extensions for diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 0e703da2237..fdf3185cede 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1704,6 +1704,18 @@ package body Exp_Ch3 is end if; end if; + -- When the object is either protected or a task, create static strings + -- which denote the names of entries and families. Associate the strings + -- with the concurrent object's Protection_Entries or ATCB. This is a + -- VMS Debug feature. + + if OpenVMS_On_Target + and then Is_Concurrent_Type (Typ) + and then Entry_Names_OK + then + Build_Entry_Names (Id_Ref, Typ, Res); + end if; + return Res; exception @@ -2665,7 +2677,6 @@ package body Exp_Ch3 is Decl : Node_Id; Has_POC : Boolean; Id : Entity_Id; - Names : Node_Id; Stmts : List_Id; Typ : Entity_Id; @@ -3009,17 +3020,6 @@ package body Exp_Ch3 is Append_To (Stmts, 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 (Stmts, Names); - end if; - end if; - declare Task_Type : constant Entity_Id := Corresponding_Concurrent_Type (Rec_Type); @@ -3073,18 +3073,6 @@ package body Exp_Ch3 is if Is_Protected_Record_Type (Rec_Type) then Append_List_To (Stmts, 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 (Stmts, Names); - end if; - end if; end if; -- Second pass: components with per-object constraints diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 8ce3870f002..77397c65927 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1363,59 +1363,54 @@ package body Exp_Ch9 is -- 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_Names + (Obj_Ref : Node_Id; + Obj_Typ : Entity_Id; + Stmts : List_Id) + is + Loc : constant Source_Ptr := Sloc (Obj_Ref); + Data : Entity_Id := Empty; + Index : Entity_Id := Empty; + Typ : Entity_Id := Obj_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 _init._task_id, - -- Inn, - -- new String ("(" & Lnn'Img & ")")); - -- 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 (Comp_Id : Entity_Id); + -- Given an entry [family], create a static string which denotes the + -- name of Comp_Id and assign it to the underlying data structure which + -- contains the entry names of a concurrent object. - procedure Build_Entry_Name (Id : Entity_Id); - -- Generate: - -- Inn := Inn + 1; - -- Set_Entry_Name - -- (_init._object _init._task_id, - -- Inn, - -- new String (""); - -- The above construct is added directly to the statements of the block. + function Object_Reference return Node_Id; + -- Return a reference to field _object or _task_id depending on the + -- concurrent object being processed. - 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. - - 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_Temporary (Loc, 'L'); - L_Stmts : constant List_Id := New_List; - Val : Node_Id; + ---------------------- + -- Build_Entry_Name -- + ---------------------- + procedure Build_Entry_Name (Comp_Id : Entity_Id) is 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. + procedure Create_Index_And_Data; + -- Generate the declarations of variables Index and Data. Subsequent + -- calls do nothing. + + function Increment_Index return Node_Id; + -- Increment the index used in the assignment of string names to the + -- Data array. + + function Name_Declaration (Def_Id : Entity_Id) return Node_Id; + -- Given the name of a temporary variable, create the following + -- declaration for it: + -- + -- Def_Id : aliased constant String := ; + + function Set_Entry_Name (Def_Id : Entity_Id) return Node_Id; + -- Given the name of a temporary variable, place it in the array of + -- string names. Generate: + -- + -- Data (Index) := Def_Id'Unchecked_Access; + ----------------- -- Build_Range -- ----------------- @@ -1432,7 +1427,10 @@ package body Exp_Ch9 is if Is_Entity_Name (Low) and then Ekind (Entity (Low)) = E_Discriminant then - Low := Make_Identifier (Loc, Chars (Low)); + Low := + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (Obj_Ref), + Selector_Name => Make_Identifier (Loc, Chars (Low))); else Low := New_Copy_Tree (Low); end if; @@ -1440,7 +1438,10 @@ package body Exp_Ch9 is if Is_Entity_Name (High) and then Ekind (Entity (High)) = E_Discriminant then - High := Make_Identifier (Loc, Chars (High)); + High := + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (Obj_Ref), + Selector_Name => Make_Identifier (Loc, Chars (High))); else High := New_Copy_Tree (High); end if; @@ -1451,150 +1452,239 @@ package body Exp_Ch9 is High_Bound => High); end Build_Range; - -- Start of processing for Build_Entry_Family_Name + --------------------------- + -- Create_Index_And_Data -- + --------------------------- + + procedure Create_Index_And_Data is + begin + if No (Index) and then No (Data) then + declare + Count : RE_Id; + Data_Typ : RE_Id; + Index_Typ : RE_Id; + Size : Entity_Id; + + begin + if Is_Protected_Type (Typ) then + Count := RO_PE_Number_Of_Entries; + Data_Typ := RE_Protected_Entry_Names_Array; + Index_Typ := RE_Protected_Entry_Index; + else + Count := RO_ST_Number_Of_Entries; + Data_Typ := RE_Task_Entry_Names_Array; + Index_Typ := RE_Task_Entry_Index; + end if; + + -- Step 1: Generate the declaration of the index variable: + + -- Index : := 1; + + Index := Make_Temporary (Loc, 'I'); + + Append_To (Stmts, + Make_Object_Declaration (Loc, + Defining_Identifier => Index, + Object_Definition => + New_Reference_To (RTE (Index_Typ), Loc), + Expression => Make_Integer_Literal (Loc, 1))); + + -- Step 2: Generate the declaration of an array to house all + -- names: + + -- Size : constant := (Obj_Ref); + -- Data : aliased := (1 .. Size => null); + + Size := Make_Temporary (Loc, 'S'); + + Append_To (Stmts, + Make_Object_Declaration (Loc, + Defining_Identifier => Size, + Constant_Present => True, + Object_Definition => + New_Reference_To (RTE (Index_Typ), Loc), + Expression => + Make_Function_Call (Loc, + Name => + New_Reference_To (RTE (Count), Loc), + Parameter_Associations => + New_List (Object_Reference)))); + + Data := Make_Temporary (Loc, 'A'); + + Append_To (Stmts, + Make_Object_Declaration (Loc, + Defining_Identifier => Data, + Aliased_Present => True, + Object_Definition => + New_Reference_To (RTE (Data_Typ), Loc), + Expression => + Make_Aggregate (Loc, + Component_Associations => New_List ( + Make_Component_Association (Loc, + Choices => New_List ( + Make_Range (Loc, + Low_Bound => Make_Integer_Literal (Loc, 1), + High_Bound => New_Reference_To (Size, Loc))), + Expression => Make_Null (Loc)))))); + end; + end if; + end Create_Index_And_Data; + + --------------------- + -- Increment_Index -- + --------------------- + + function Increment_Index return Node_Id is + begin + return + 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; + + ---------------------- + -- Name_Declaration -- + ---------------------- + + function Name_Declaration (Def_Id : Entity_Id) return Node_Id is + begin + return + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Aliased_Present => True, + Constant_Present => True, + Object_Definition => New_Reference_To (Standard_String, Loc), + Expression => + Make_String_Literal (Loc, String_From_Name_Buffer)); + end Name_Declaration; + + -------------------- + -- Set_Entry_Name -- + -------------------- + + function Set_Entry_Name (Def_Id : Entity_Id) return Node_Id is + begin + return + Make_Assignment_Statement (Loc, + Name => + Make_Indexed_Component (Loc, + Prefix => New_Reference_To (Data, Loc), + Expressions => New_List (New_Reference_To (Index, Loc))), + + Expression => + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Def_Id, Loc), + Attribute_Name => Name_Unchecked_Access)); + end Set_Entry_Name; + + -- Local variables + + Temp_Id : Entity_Id; + Subt_Def : Node_Id; + + -- Start of processing for Build_Entry_Name begin - Get_Name_String (Chars (Id)); + if Ekind (Comp_Id) = E_Entry_Family then + Subt_Def := Discrete_Subtype_Definition (Parent (Comp_Id)); - -- Add a leading '(' + Create_Index_And_Data; - Add_Char_To_Name_Buffer ('('); + -- Step 1: Create the string name of the entry family. + -- Generate: + -- Temp : aliased constant String := "name ()"; - -- Generate: - -- new String'("(" & Lnn'Img & ")"); + Temp_Id := Make_Temporary (Loc, 'S'); + Get_Name_String (Chars (Comp_Id)); + Add_Char_To_Name_Buffer (' '); + Add_Char_To_Name_Buffer ('('); + Add_Char_To_Name_Buffer (')'); - -- This is an implicit heap allocation, and Comes_From_Source is - -- False, which ensures that it will get flagged as a violation of - -- No_Implicit_Heap_Allocations when that restriction applies. + Append_To (Stmts, Name_Declaration (Temp_Id)); - Val := - Make_Allocator (Loc, - Make_Qualified_Expression (Loc, - Subtype_Mark => - New_Reference_To (Standard_String, Loc), - Expression => - Make_Op_Concat (Loc, - Left_Opnd => - Make_Op_Concat (Loc, - Left_Opnd => - Make_String_Literal (Loc, - Strval => String_From_Name_Buffer), - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => - New_Reference_To (L_Id, Loc), - Attribute_Name => Name_Img)), - Right_Opnd => - Make_String_Literal (Loc, - Strval => ")")))); + -- Generate: + -- for Member in Family_Low .. Family_High loop + -- Set_Entry_Name (...); + -- Index := Index + 1; + -- end loop; - Increment_Index (L_Stmts); - Append_To (L_Stmts, Build_Set_Entry_Name_Call (Val)); + Append_To (Stmts, + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => + Make_Temporary (Loc, 'L'), + Discrete_Subtype_Definition => + Build_Range (Subt_Def))), - -- Generate: - -- for Lnn in Family_Low .. Family_High loop - -- Inn := Inn + 1; - -- Set_Entry_Name - -- (_init._object _init._task_id, Inn, ); - -- end loop; + Statements => New_List ( + Set_Entry_Name (Temp_Id), + Increment_Index), + End_Label => Empty)); - 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; + -- Entry - ---------------------- - -- Build_Entry_Name -- - ---------------------- + else + Create_Index_And_Data; - procedure Build_Entry_Name (Id : Entity_Id) is - Val : Node_Id; + -- Step 1: Create the string name of the entry. Generate: + -- Temp : aliased constant String := "name"; - begin - Get_Name_String (Chars (Id)); + Temp_Id := Make_Temporary (Loc, 'S'); + Get_Name_String (Chars (Comp_Id)); - -- This is an implicit heap allocation, and Comes_From_Source is - -- False, which ensures that it will get flagged as a violation of - -- No_Implicit_Heap_Allocations when that restriction applies. + Append_To (Stmts, Name_Declaration (Temp_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))); + -- Step 2: Associate the string name with the underlying data + -- structure. - Increment_Index (B_Stmts); - Append_To (B_Stmts, Build_Set_Entry_Name_Call (Val)); + Append_To (Stmts, Set_Entry_Name (Temp_Id)); + Append_To (Stmts, Increment_Index); + end if; end Build_Entry_Name; - ------------------------------- - -- Build_Set_Entry_Name_Call -- - ------------------------------- + ---------------------- + -- Object_Reference -- + ---------------------- - function Build_Set_Entry_Name_Call (Arg3 : Node_Id) return Node_Id is - Arg1 : Name_Id; - Proc : RE_Id; + function Object_Reference return Node_Id is + Conc_Typ : constant Entity_Id := Corresponding_Record_Type (Typ); + Field : Name_Id; + Ref : Node_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; + Field := Name_uObject; + else + Field := Name_uTask_Id; end if; - -- Generate: - -- Set_Entry_Name (_init.Arg1, Inn, Arg3); + Ref := + Make_Selected_Component (Loc, + Prefix => + Unchecked_Convert_To (Conc_Typ, New_Copy_Tree (Obj_Ref)), + Selector_Name => Make_Identifier (Loc, Field)); - 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; + if Is_Protected_Type (Typ) then + Ref := + Make_Attribute_Reference (Loc, + Prefix => Ref, + Attribute_Name => Name_Unchecked_Access); + end if; - --------------------- - -- Increment_Index -- - --------------------- + return Ref; + end Object_Reference; - procedure Increment_Index (Stmts : List_Id) is - begin - -- Generate: - -- Inn := Inn + 1; + -- Local variables - 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; + Comp : Node_Id; + Proc : RE_Id; -- Start of processing for Build_Entry_Names @@ -1605,67 +1695,57 @@ package body Exp_Ch9 is Typ := Corresponding_Concurrent_Type (Typ); end if; - pragma Assert (Is_Protected_Type (Typ) or else Is_Task_Type (Typ)); + pragma Assert (Is_Concurrent_Type (Typ)); -- Nothing to do if the type has no entries if not Has_Entries (Typ) then - return Empty; + return; 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) + and then Find_Protection_Type (Base_Type (Typ)) /= + RTE (RE_Protection_Entries) then - return Empty; + return; end if; - Index := Make_Temporary (Loc, '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. + -- Step 1: Populate the array with statically generated strings denoting + -- entries and entry family names. Comp := First_Entity (Typ); while Present (Comp) loop - if Ekind (Comp) = E_Entry then + if Comes_From_Source (Comp) + and then Ekind_In (Comp, E_Entry, E_Entry_Family) + 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 + -- Step 2: Associate the array with the related concurrent object: - return - Make_Block_Statement (Loc, - Declarations => B_Decls, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => B_Stmts)); + -- Set_Entry_Names (Obj_Ref, 'Unchecked_Access); + + if Present (Data) then + if Is_Protected_Type (Typ) then + Proc := RO_PE_Set_Entry_Names; + else + Proc := RO_ST_Set_Entry_Names; + end if; + + Append_To (Stmts, + Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (RTE (Proc), Loc), + Parameter_Associations => New_List ( + Object_Reference, + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Data, Loc), + Attribute_Name => Name_Unchecked_Access)))); + end if; end Build_Entry_Names; --------------------------- @@ -13505,20 +13585,6 @@ package body Exp_Ch9 is Make_Attribute_Reference (Loc, Prefix => New_Reference_To (P_Arr, Loc), 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; elsif Pkg_Id = @@ -13529,7 +13595,6 @@ package body Exp_Ch9 is elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then Append_To (Args, Make_Null (Loc)); Append_To (Args, Make_Null (Loc)); - Append_To (Args, New_Reference_To (Standard_False, Loc)); end if; Append_To (L, @@ -13953,16 +14018,6 @@ package body Exp_Ch9 is Prefix => Make_Identifier (Loc, Name_uInit), 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 - Append_To (Args, - New_Reference_To - (Boolean_Literals (Has_Entries (Ttyp) and then Entry_Names_OK), - Loc)); - end if; - if Restricted_Profile then Name := New_Reference_To (RTE (RE_Create_Restricted_Task), Loc); else diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads index 3bbbf0dc719..65b0c195302 100644 --- a/gcc/ada/exp_ch9.ads +++ b/gcc/ada/exp_ch9.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -55,10 +55,15 @@ package Exp_Ch9 is -- 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_Entry_Names + (Obj_Ref : Node_Id; + Obj_Typ : Entity_Id; + Stmts : List_Id); + -- Given a concurrent object, create static string names for all entries + -- and entry families. Associate each name with the Protection_Entries or + -- ATCB field of the object. Obj_Ref is a reference to the concurrent + -- object. Obj_Typ is the type of the object. Stmts is the list where all + -- generated code is attached. procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id); -- Given the name of an object or a type which is either a task, contains diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 36202bd84d3..c084b1cdcd4 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9422,6 +9422,18 @@ accuracy in some portions of the domain. @end cartouche Followed. +@cindex Sequential elaboration policy +@unnumberedsec H.6(15/2): Pragma Partition_Elaboration_Policy + +@sp 1 +@cartouche +If the partition elaboration policy is @code{Sequential} and the +Environment task becomes permanently blocked during elaboration then the +partition is deadlocked and it is recommended that the partition be +immediately terminated. +@end cartouche +Not followed. + @c ----------------------------------------- @node Implementation Defined Characteristics @chapter Implementation Defined Characteristics diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 1a38806f8c0..b1e723920c3 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -19150,7 +19150,7 @@ only. @item -fada-spec-parent=@var{unit} @cindex -fada-spec-parent (@command{gcc}) -Specifies that all files generated by @option{-fdump-ada-spec-slim} are +Specifies that all files generated by @option{-fdump-ada-spec*} are to be child units of the specified parent unit. @item -C diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 0ffaea3d9f8..63ff87cb33a 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1502,6 +1502,9 @@ package Rtsfind is RE_Unspecified_Task_Info, -- System.Task_Info RE_Task_Procedure_Access, -- System.Tasking + RE_Task_Entry_Names_Array, -- System.Tasking + RO_ST_Number_Of_Entries, -- System.Tasking + RO_ST_Set_Entry_Names, -- System.Tasking RO_ST_Task_Id, -- System.Tasking RO_ST_Null_Task, -- System.Tasking @@ -1687,14 +1690,16 @@ package Rtsfind is RE_Dispatching_Domain, -- Dispatching_Domains RE_Protected_Entry_Body_Array, -- Tasking.Protected_Objects.Entries + RE_Protected_Entry_Names_Array, -- Tasking.Protected_Objects.Entries RE_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Protection_Entries_Access, -- Tasking.Protected_Objects.Entries RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Lock_Entries, -- Tasking.Protected_Objects.Entries - RO_PE_Get_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 + RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries + RO_PE_Number_Of_Entries, -- Tasking.Protected_Objects.Entries + RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries + RO_PE_Set_Entry_Names, -- Tasking.Protected_Objects.Entries RE_Communication_Block, -- Protected_Objects.Operations RE_Protected_Entry_Call, -- Protected_Objects.Operations @@ -1769,7 +1774,6 @@ package Rtsfind is RE_Free_Task, -- System.Tasking.Stages RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages RE_Move_Activation_Chain, -- System_Tasking_Stages - RO_TS_Set_Entry_Name, -- System.Tasking.Stages RE_Terminated); -- System.Tasking.Stages -- The following declarations build a table that is indexed by the RTE @@ -2749,6 +2753,9 @@ package Rtsfind is RE_Unspecified_Task_Info => System_Task_Info, RE_Task_Procedure_Access => System_Tasking, + RE_Task_Entry_Names_Array => System_Tasking, + RO_ST_Number_Of_Entries => System_Tasking, + RO_ST_Set_Entry_Names => System_Tasking, RO_ST_Task_Id => System_Tasking, RO_ST_Null_Task => System_Tasking, @@ -2937,6 +2944,8 @@ package Rtsfind is RE_Protected_Entry_Body_Array => System_Tasking_Protected_Objects_Entries, + RE_Protected_Entry_Names_Array => + System_Tasking_Protected_Objects_Entries, RE_Protection_Entries => System_Tasking_Protected_Objects_Entries, RE_Protection_Entries_Access => @@ -2945,13 +2954,15 @@ package Rtsfind is System_Tasking_Protected_Objects_Entries, RE_Lock_Entries => System_Tasking_Protected_Objects_Entries, + RE_Unlock_Entries => + System_Tasking_Protected_Objects_Entries, RO_PE_Get_Ceiling => System_Tasking_Protected_Objects_Entries, + RO_PE_Number_Of_Entries => + System_Tasking_Protected_Objects_Entries, RO_PE_Set_Ceiling => System_Tasking_Protected_Objects_Entries, - RO_PE_Set_Entry_Name => - System_Tasking_Protected_Objects_Entries, - RE_Unlock_Entries => + RO_PE_Set_Entry_Names => System_Tasking_Protected_Objects_Entries, RE_Communication_Block => @@ -3054,7 +3065,6 @@ package Rtsfind is RE_Free_Task => System_Tasking_Stages, RE_Expunge_Unactivated_Tasks => System_Tasking_Stages, RE_Move_Activation_Chain => System_Tasking_Stages, - RO_TS_Set_Entry_Name => System_Tasking_Stages, RE_Terminated => System_Tasking_Stages); -------------------------------- diff --git a/gcc/ada/s-bignum.adb b/gcc/ada/s-bignum.adb index b3af4796136..955df4277c2 100644 --- a/gcc/ada/s-bignum.adb +++ b/gcc/ada/s-bignum.adb @@ -728,8 +728,9 @@ package body System.Bignums is -- The complex full multi-precision case. We will employ algorithm -- D defined in the section "The Classical Algorithms" (sec. 4.3.1) - -- of Donald Knuth's "The Art of Computer Programming", Vol. 2. The - -- terminology is adjusted for this section to match that reference. + -- of Donald Knuth's "The Art of Computer Programming", Vol. 2, 2nd + -- edition. The terminology is adjusted for this section to match that + -- reference. -- We are dividing X.Len digits of X (called u here) by Y.Len digits -- of Y (called v here), developing the quotient and remainder. The @@ -775,12 +776,12 @@ package body System.Bignums is v (J) := Y.D (J); end loop; - -- [Division of nonnegative integers]. Given nonnegative integers u + -- [Division of nonnegative integers.] Given nonnegative integers u -- = (ul,u2..um+n) and v = (v1,v2..vn), where v1 /= 0 and n > 1, we -- form the quotient u / v = (q0,ql..qm) and the remainder u mod v = -- (r1,r2..rn). - pragma Assert (v (1) /= 0); + pragma Assert (v1 /= 0); pragma Assert (n > 1); -- Dl. [Normalize.] Set d = b/(vl + 1). Then set (u0,u1,u2..um+n) @@ -789,7 +790,7 @@ package body System.Bignums is -- u0 at the left of u1; if d = 1 all we need to do in this step is -- to set u0 = 0. - d := b / DD (v1 + 1); + d := b / (DD (v1) + 1); if d = 1 then u0 := 0; @@ -826,15 +827,15 @@ package body System.Bignums is -- D2. [Initialize j.] Set j = 0. The loop on j, steps D2 through D7, -- will be essentially a division of (uj, uj+1..uj+n) by (v1,v2..vn) - -- to get a single quotient digit qj; + -- to get a single quotient digit qj. j := 0; -- Loop through digits loop - -- D3. [Calculate qhat] If uj = v1, set qhat to b-l; otherwise set - -- qhat to (uj,uj+1)/v1. + -- D3. [Calculate qhat.] If uj = v1, set qhat to b-l; otherwise + -- set qhat to (uj,uj+1)/v1. if u (j) = v1 then qhat := -1; diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 519626cb9c4..00c54ed9e47 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -33,8 +33,6 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during tasking -- operations. It causes infinite loops and other problems. -with Ada.Unchecked_Deallocation; - with System.Task_Primitives.Operations; with System.Storage_Elements; @@ -42,19 +40,6 @@ package body System.Tasking is 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 -- --------------------- @@ -70,6 +55,15 @@ package body System.Tasking is return GL_Detect_Blocking = 1; end Detect_Blocking; + ----------------------- + -- Number_Of_Entries -- + ----------------------- + + function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index is + begin + return Self_Id.Entry_Num; + end Number_Of_Entries; + ---------- -- Self -- ---------- @@ -257,4 +251,16 @@ package body System.Tasking is T.Entry_Calls (1).Self := T; end Initialize; + --------------------- + -- Set_Entry_Names -- + --------------------- + + procedure Set_Entry_Names + (Self_Id : Task_Id; + Names : Task_Entry_Names_Access) + is + begin + Self_Id.Entry_Names := Names; + end Set_Entry_Names; + end System.Tasking; diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index d31313708f7..9584901d3e7 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -252,13 +252,10 @@ package System.Tasking is type String_Access is access all String; - type Entry_Names_Array is - array (Entry_Index range <>) of String_Access; + type Task_Entry_Names_Array is + array (Task_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 + type Task_Entry_Names_Access is access all Task_Entry_Names_Array; ---------------------------------- -- Entry_Call_Record definition -- @@ -968,10 +965,13 @@ package System.Tasking is -- associated with protected objects or task entries, and are protected -- by the protected object lock or Acceptor.L, respectively. - Entry_Names : Entry_Names_Array_Access := null; + Entry_Names : Task_Entry_Names_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. + -- + -- Protection: The array is populated during task initialization, before + -- the task has been activated. No protection is required in this case. New_Base_Priority : System.Any_Priority; -- New value for Base_Priority (for dynamic priorities package) @@ -1203,4 +1203,13 @@ private -- registered for removal (Expunge_Unactivated_Tasks). The "limited" forces -- Activation_Chain to be a by-reference type; see RM-6.2(4). + function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index; + -- Given a task, return the number of entries it contains + + procedure Set_Entry_Names + (Self_Id : Task_Id; + Names : Task_Entry_Names_Access); + -- Associate an array of string that denote entry [family] names with a + -- task. + end System.Tasking; diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index ab75b2337c5..cf63a304546 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -91,9 +91,6 @@ package body System.Tasking.Stages is procedure Free is new 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); -- This procedure outputs the task specific message for exception -- tracing purposes. @@ -487,8 +484,7 @@ package body System.Tasking.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_Id; - Build_Entry_Names : Boolean) + Created_Task : out Task_Id) is T, P : Task_Id; Self_ID : constant Task_Id := STPO.Self; @@ -706,14 +702,6 @@ 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. - - if Build_Entry_Names then - T.Entry_Names := - new Entry_Names_Array (1 .. Entry_Index (Num_Entries)); - end if; - -- Create TSD as early as possible in the creation of a task, since it -- may be used by the operation of Ada code within the task. @@ -942,26 +930,6 @@ package body System.Tasking.Stages is 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 -- --------------- @@ -983,7 +951,6 @@ package body System.Tasking.Stages is Initialization.Task_Unlock (Self_Id); - Free_Entry_Names (T); System.Task_Primitives.Operations.Finalize_TCB (T); else @@ -1041,23 +1008,6 @@ package body System.Tasking.Stages is Initialization.Undefer_Abort (Self_ID); 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 -- ------------------ @@ -2119,7 +2069,6 @@ package body System.Tasking.Stages is Unlock_RTS; end if; - Free_Entry_Names (T); System.Task_Primitives.Operations.Finalize_TCB (T); end Vulnerable_Free_Task; diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index 9058d068a4a..e37fd59b665 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -180,8 +180,7 @@ package System.Tasking.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_Id; - Build_Entry_Names : Boolean); + Created_Task : out Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task. -- @@ -212,8 +211,6 @@ package System.Tasking.Stages is -- run time can store to ease the debugging and the -- Ada.Task_Identification facility. -- 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. @@ -285,13 +282,6 @@ package System.Tasking.Stages is -- that doesn't happen, they will never be activated, and will become -- 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; -- 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 diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index 88527315e42..f535a067bf7 100644 --- a/gcc/ada/s-tpoben.adb +++ b/gcc/ada/s-tpoben.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -41,8 +41,6 @@ -- Note: the compiler generates direct calls to this interface, via Rtsfind -with Ada.Unchecked_Deallocation; - with System.Task_Primitives.Operations; with System.Restrictions; with System.Parameters; @@ -58,13 +56,6 @@ package body System.Tasking.Protected_Objects.Entries is use Parameters; use Task_Primitives.Operations; - ----------------------- - -- Local Subprograms -- - ----------------------- - - procedure Free_Entry_Names (Object : Protection_Entries); - -- Deallocate all string names associated with protected entries - ---------------- -- Local Data -- ---------------- @@ -141,8 +132,6 @@ package body System.Tasking.Protected_Objects.Entries is end loop; end loop; - Free_Entry_Names (Object); - Object.Finalized := True; if Single_Lock then @@ -154,26 +143,6 @@ package body System.Tasking.Protected_Objects.Entries is STPO.Finalize_Lock (Object.L'Unrestricted_Access); 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 -- ----------------- @@ -202,12 +171,11 @@ package body System.Tasking.Protected_Objects.Entries is ----------------------------------- procedure Initialize_Protection_Entries - (Object : Protection_Entries_Access; - Ceiling_Priority : Integer; - Compiler_Info : System.Address; - Entry_Bodies : Protected_Entry_Body_Access; - Find_Body_Index : Find_Body_Index_Access; - Build_Entry_Names : Boolean) + (Object : Protection_Entries_Access; + Ceiling_Priority : Integer; + Compiler_Info : System.Address; + Entry_Bodies : Protected_Entry_Body_Access; + Find_Body_Index : Find_Body_Index_Access) is Init_Priority : Integer := Ceiling_Priority; Self_ID : constant Task_Id := STPO.Self; @@ -250,11 +218,6 @@ package body System.Tasking.Protected_Objects.Entries is Object.Entry_Queues (E).Head := null; Object.Entry_Queues (E).Tail := null; 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; ------------------ @@ -391,6 +354,17 @@ package body System.Tasking.Protected_Objects.Entries is end if; end Lock_Read_Only_Entries; + ----------------------- + -- Number_Of_Entries -- + ----------------------- + + function Number_Of_Entries + (Object : Protection_Entries_Access) return Protected_Entry_Index + is + begin + return Object.Num_Entries; + end Number_Of_Entries; + ----------------- -- Set_Ceiling -- ----------------- @@ -402,20 +376,17 @@ package body System.Tasking.Protected_Objects.Entries is Object.New_Ceiling := Prio; end Set_Ceiling; - -------------------- - -- Set_Entry_Name -- - -------------------- + --------------------- + -- Set_Entry_Names -- + --------------------- - procedure Set_Entry_Name - (Object : Protection_Entries'Class; - Pos : Protected_Entry_Index; - Val : String_Access) + procedure Set_Entry_Names + (Object : Protection_Entries_Access; + Names : Protected_Entry_Names_Access) is begin - pragma Assert (Object.Entry_Names /= null); - - Object.Entry_Names (Entry_Index (Pos)) := Val; - end Set_Entry_Name; + Object.Entry_Names := Names; + end Set_Entry_Names; -------------------- -- Unlock_Entries -- diff --git a/gcc/ada/s-tpoben.ads b/gcc/ada/s-tpoben.ads index ce7045cf56e..acdf69fbee9 100644 --- a/gcc/ada/s-tpoben.ads +++ b/gcc/ada/s-tpoben.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -67,6 +67,14 @@ package System.Tasking.Protected_Objects.Entries is type Protected_Entry_Queue_Array is array (Protected_Entry_Index range <>) of Entry_Queue; + -- A data structure which contains the string names of entries and entry + -- family members. + + type Protected_Entry_Names_Array is + array (Protected_Entry_Index range <>) of String_Access; + + type Protected_Entry_Names_Access is access all Protected_Entry_Names_Array; + -- This type contains the GNARL state of a protected object. The -- application-defined portion of the state (i.e. private objects) -- is maintained by the compiler-generated code. @@ -136,7 +144,7 @@ package System.Tasking.Protected_Objects.Entries is Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries); - Entry_Names : Entry_Names_Array_Access := null; + Entry_Names : Protected_Entry_Names_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. @@ -167,12 +175,11 @@ package System.Tasking.Protected_Objects.Entries is -- System.Tasking.Protected_Objects.Initialize_Protection. procedure Initialize_Protection_Entries - (Object : Protection_Entries_Access; - Ceiling_Priority : Integer; - Compiler_Info : System.Address; - Entry_Bodies : Protected_Entry_Body_Access; - Find_Body_Index : Find_Body_Index_Access; - Build_Entry_Names : Boolean); + (Object : Protection_Entries_Access; + Ceiling_Priority : Integer; + Compiler_Info : System.Address; + Entry_Bodies : Protected_Entry_Body_Access; + Find_Body_Index : Find_Body_Index_Access); -- Initialize the Object parameter so that it can be used by the runtime -- to keep track of the runtime state of a protected object. @@ -201,17 +208,20 @@ package System.Tasking.Protected_Objects.Entries is -- possible future use. At the current time, everyone uses Lock for both -- read and write locks. + function Number_Of_Entries + (Object : Protection_Entries_Access) return Protected_Entry_Index; + -- Return the number of entries of a protected object + procedure Set_Ceiling (Object : Protection_Entries_Access; Prio : System.Any_Priority); -- 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 Set_Entry_Names + (Object : Protection_Entries_Access; + Names : Protected_Entry_Names_Access); + -- Associate an array of string that denote entry [family] names with a + -- protected object. procedure Unlock_Entries (Object : Protection_Entries_Access); -- Relinquish ownership of the lock for the object represented by the