From dbf2a2d34ad8a708e01869e30da252a9aff8ef6b Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 6 Jan 2017 11:50:15 +0000 Subject: [PATCH] exp_ch9.ads, [...] (Build_Entry_Names): Remove (unused). 2017-01-06 Tristan Gingold * exp_ch9.ads, exp_ch9.adb (Build_Entry_Names): Remove (unused). * rtsfind.ads (RE_Task_Entry_Names_Array, RO_ST_Set_Entry_Names) (RE_Protected_Entry_Names_Array, RO_PE_Set_Entry_Names): Remove (unused). * s-taskin.ads, s-taskin.adb (Set_Entry_Names, Task_Entry_Names_Array, Task_Entry_Names_Access): Remove. * s-tpoben.ads, s-tpoben.adb (Set_Entry_Names, Protected_Entry_Names_Array, Protected_Entry_Names_Access): Remove. From-SVN: r244142 --- gcc/ada/ChangeLog | 11 ++ gcc/ada/exp_ch9.adb | 390 ------------------------------------------- gcc/ada/exp_ch9.ads | 12 +- gcc/ada/rtsfind.ads | 10 -- gcc/ada/s-taskin.adb | 15 +- gcc/ada/s-taskin.ads | 21 +-- gcc/ada/s-tpoben.adb | 12 -- gcc/ada/s-tpoben.ads | 24 +-- 8 files changed, 16 insertions(+), 479 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aca2564c763..cbb28a2a6bb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2017-01-06 Tristan Gingold + + * exp_ch9.ads, exp_ch9.adb (Build_Entry_Names): Remove (unused). + * rtsfind.ads (RE_Task_Entry_Names_Array, RO_ST_Set_Entry_Names) + (RE_Protected_Entry_Names_Array, RO_PE_Set_Entry_Names): Remove + (unused). + * s-taskin.ads, s-taskin.adb (Set_Entry_Names, + Task_Entry_Names_Array, Task_Entry_Names_Access): Remove. + * s-tpoben.ads, s-tpoben.adb (Set_Entry_Names, + Protected_Entry_Names_Array, Protected_Entry_Names_Access): Remove. + 2017-01-06 Bob Duff * sinfo.ads, sinfo.adb (Map_Pragma_Name): Preparation work, diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 56e426bbd83..2e0f8de61ff 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -60,7 +60,6 @@ with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; -with Stringt; use Stringt; with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -1682,395 +1681,6 @@ package body Exp_Ch9 is return Ecount; end Build_Entry_Count_Expression; - ----------------------- - -- Build_Entry_Names -- - ----------------------- - - 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_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. - - function Object_Reference return Node_Id; - -- Return a reference to field _object or _task_id depending on the - -- concurrent object being processed. - - ---------------------- - -- 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 -- - ----------------- - - 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_Selected_Component (Loc, - Prefix => New_Copy_Tree (Obj_Ref), - Selector_Name => 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_Selected_Component (Loc, - Prefix => New_Copy_Tree (Obj_Ref), - Selector_Name => 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; - - --------------------------- - -- 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; - Size : Entity_Id; - - begin - if Is_Protected_Type (Typ) then - Count := RO_PE_Number_Of_Entries; - Data_Typ := RE_Protected_Entry_Names_Array; - else - Count := RO_ST_Number_Of_Entries; - Data_Typ := RE_Task_Entry_Names_Array; - end if; - - -- Step 1: Generate the declaration of the index variable: - - -- Index : Entry_Index := 1; - - Index := Make_Temporary (Loc, 'I'); - - Append_To (Stmts, - Make_Object_Declaration (Loc, - Defining_Identifier => Index, - Object_Definition => - New_Occurrence_Of (RTE (RE_Entry_Index), Loc), - Expression => Make_Integer_Literal (Loc, 1))); - - -- Step 2: Generate the declaration of an array to house all - -- names: - - -- Size : constant Entry_Index := (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_Occurrence_Of (RTE (RE_Entry_Index), Loc), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (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_Occurrence_Of (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_Occurrence_Of (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_Occurrence_Of (Index, Loc), - Expression => - Make_Op_Add (Loc, - Left_Opnd => New_Occurrence_Of (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_Occurrence_Of (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_Occurrence_Of (Data, Loc), - Expressions => New_List (New_Occurrence_Of (Index, Loc))), - - Expression => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (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 - if Ekind (Comp_Id) = E_Entry_Family then - Subt_Def := Discrete_Subtype_Definition (Parent (Comp_Id)); - - Create_Index_And_Data; - - -- Step 1: Create the string name of the entry family. - -- Generate: - -- Temp : aliased constant String := "name ()"; - - 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 (')'); - - Append_To (Stmts, Name_Declaration (Temp_Id)); - - -- Generate: - -- for Member in Family_Low .. Family_High loop - -- Set_Entry_Name (...); - -- Index := Index + 1; - -- end loop; - - 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))), - - Statements => New_List ( - Set_Entry_Name (Temp_Id), - Increment_Index), - End_Label => Empty)); - - -- Entry - - else - Create_Index_And_Data; - - -- Step 1: Create the string name of the entry. Generate: - -- Temp : aliased constant String := "name"; - - Temp_Id := Make_Temporary (Loc, 'S'); - Get_Name_String (Chars (Comp_Id)); - - Append_To (Stmts, Name_Declaration (Temp_Id)); - - -- Step 2: Associate the string name with the underlying data - -- structure. - - Append_To (Stmts, Set_Entry_Name (Temp_Id)); - Append_To (Stmts, Increment_Index); - end if; - end Build_Entry_Name; - - ---------------------- - -- Object_Reference -- - ---------------------- - - function Object_Reference return Node_Id is - Conc_Typ : constant Entity_Id := Corresponding_Record_Type (Typ); - Field : Name_Id; - Ref : Node_Id; - - begin - if Is_Protected_Type (Typ) then - Field := Name_uObject; - else - Field := Name_uTask_Id; - end if; - - Ref := - Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To (Conc_Typ, New_Copy_Tree (Obj_Ref)), - Selector_Name => Make_Identifier (Loc, Field)); - - if Is_Protected_Type (Typ) then - Ref := - Make_Attribute_Reference (Loc, - Prefix => Ref, - Attribute_Name => Name_Unchecked_Access); - end if; - - return Ref; - end Object_Reference; - - -- Local variables - - Comp : Node_Id; - Proc : RE_Id; - - -- 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_Concurrent_Type (Typ)); - - -- Nothing to do if the type has no entries - - if not Has_Entries (Typ) then - 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 (Base_Type (Typ)) /= - RTE (RE_Protection_Entries) - then - return; - end if; - - -- Step 1: Populate the array with statically generated strings denoting - -- entries and entry family names. - - Comp := First_Entity (Typ); - while Present (Comp) loop - if Comes_From_Source (Comp) - and then Ekind_In (Comp, E_Entry, E_Entry_Family) - then - Build_Entry_Name (Comp); - end if; - - Next_Entity (Comp); - end loop; - - -- Step 2: Associate the array with the related concurrent object: - - -- 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_Occurrence_Of (RTE (Proc), Loc), - Parameter_Associations => New_List ( - Object_Reference, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Data, Loc), - Attribute_Name => Name_Unchecked_Access)))); - end if; - end Build_Entry_Names; - --------------------------- -- Build_Parameter_Block -- --------------------------- diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads index d49201bfe0d..a677324b2fe 100644 --- a/gcc/ada/exp_ch9.ads +++ b/gcc/ada/exp_ch9.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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,16 +55,6 @@ 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. - 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 -- tasks or designates tasks, create a _master in the appropriate scope diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 1f859dffc80..a79064644d9 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1547,9 +1547,7 @@ 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 @@ -1683,7 +1681,6 @@ package Rtsfind is RE_Dispatching_Domain, -- Multiprocessors.Dispatching_Domains RE_Protected_Entry_Body_Array, -- Tasking.Protected_Objects.Entries - RE_Protected_Entry_Names_Array, -- Tasking.Protected_Objects.Entries RE_Protected_Entry_Queue_Max_Array, -- Tasking.Protected_Objects.Entries RE_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Protection_Entries_Access, -- Tasking.Protected_Objects.Entries @@ -1693,7 +1690,6 @@ package Rtsfind is 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 @@ -2787,9 +2783,7 @@ 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, @@ -2926,8 +2920,6 @@ package Rtsfind is RE_Protected_Entry_Body_Array => System_Tasking_Protected_Objects_Entries, - RE_Protected_Entry_Names_Array => - System_Tasking_Protected_Objects_Entries, RE_Protected_Entry_Queue_Max_Array => System_Tasking_Protected_Objects_Entries, RE_Protection_Entries => @@ -2946,8 +2938,6 @@ package Rtsfind is System_Tasking_Protected_Objects_Entries, RO_PE_Set_Ceiling => System_Tasking_Protected_Objects_Entries, - RO_PE_Set_Entry_Names => - System_Tasking_Protected_Objects_Entries, RE_Communication_Block => System_Tasking_Protected_Objects_Operations, diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 1c18a89d43b..153fe79b2fa 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -272,17 +272,4 @@ 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 539d08854fb..c1fe020f5b8 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -254,11 +254,6 @@ package System.Tasking is type String_Access is access all String; - type Task_Entry_Names_Array is - array (Entry_Index range <>) of String_Access; - - type Task_Entry_Names_Access is access all Task_Entry_Names_Array; - ---------------------------------- -- Entry_Call_Record definition -- ---------------------------------- @@ -965,14 +960,6 @@ 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 : 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) -- @@ -1202,10 +1189,4 @@ private function Number_Of_Entries (Self_Id : Task_Id) return 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 strings denotinge entry [family] names with a task - end System.Tasking; diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index 79f425e1395..ddea94802b8 100644 --- a/gcc/ada/s-tpoben.adb +++ b/gcc/ada/s-tpoben.adb @@ -378,18 +378,6 @@ package body System.Tasking.Protected_Objects.Entries is Object.New_Ceiling := Prio; end Set_Ceiling; - --------------------- - -- Set_Entry_Names -- - --------------------- - - procedure Set_Entry_Names - (Object : Protection_Entries_Access; - Names : Protected_Entry_Names_Access) - is - begin - 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 6bd09879946..8f928204d68 100644 --- a/gcc/ada/s-tpoben.ads +++ b/gcc/ada/s-tpoben.ads @@ -57,8 +57,8 @@ package System.Tasking.Protected_Objects.Entries is (O : System.Address; E : Protected_Entry_Index) return Protected_Entry_Index; - -- Convert a queue index to an entry index (an entries family has one entry - -- index for several queue index). + -- Convert a queue index to an entry index (an entry family has one entry + -- index for several queue indexes). type Protected_Entry_Body_Array is array (Positive_Protected_Entry_Index range <>) of Entry_Body; @@ -76,15 +76,6 @@ package System.Tasking.Protected_Objects.Entries is type Protected_Entry_Queue_Max_Access is access constant Protected_Entry_Queue_Max_Array; - -- The following declarations define an array that contains the string - -- names of entries and entry family members, together with an associated - -- access type. - - type Protected_Entry_Names_Array is - array (Entry_Index range <>) of String_Access; - - type Protected_Entry_Names_Access is access all Protected_Entry_Names_Array; - -- The following 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. Note that there is a @@ -156,11 +147,6 @@ package System.Tasking.Protected_Objects.Entries is -- Access to an array of naturals representing the max value for each -- entry's queue length. A value of 0 signifies no max. - 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. - Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries); -- Action and barrier subprograms for the protected type. end record; @@ -233,12 +219,6 @@ package System.Tasking.Protected_Objects.Entries is Prio : System.Any_Priority); -- Sets the new ceiling priority of the protected object - 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 -- Object parameter. If this ownership was for write access, or if it was -- 2.30.2