git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

exp_ch9.ads, [...] (Build_Entry_Names): Remove (unused). 

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* 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
This commit is contained in:
Tristan Gingold 2017-01-06 11:50:15 +00:00 committed by Arnaud Charlet
parent 0789ef6f84
commit dbf2a2d34a
8 changed files with 16 additions and 479 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2017-01-06 Tristan Gingold <gingold@adacore.com>
* 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 <duff@adacore.com>
* sinfo.ads, sinfo.adb (Map_Pragma_Name): Preparation work,

390
gcc/ada/exp_ch9.adb
View File

@ -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 := <String_Name_From_Buffer>;
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 := <Count> (Obj_Ref);
-- Data : aliased <Data_Typ> := (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, <Data>'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 --
---------------------------

12
gcc/ada/exp_ch9.ads
View File

@ -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

10
gcc/ada/rtsfind.ads
View File

@ -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,

15
gcc/ada/s-taskin.adb
View File

@ -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;

21
gcc/ada/s-taskin.ads
View File

@ -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;

12
gcc/ada/s-tpoben.adb
View File

@ -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 --
--------------------

24
gcc/ada/s-tpoben.ads
View File

@ -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