Skip to content

R
riscv-gcc-1
Commit 7bc1c7df by Ed Schonberg Committed by Geert Bosch
Options

exp_ch4.adb (Expand_N_Allocator): Generate meaningful names for a dynamic task if... 

	* exp_ch4.adb (Expand_N_Allocator): Generate meaningful names for
	a dynamic task if the allocator appears in an indexed assignment
	or selected component assignment.

	* exp_util.adb (Build_Task_Array_Image, Build_Task_Record_Image):
	For a dynamic task in an assignment statement, use target of
	assignment to generate meaningful name.

From-SVN: r46166
parent c84700e7
Showing with 94 additions and 33 deletions
gcc/ada/ChangeLog
2001-10-10 Ed Schonberg <schonber@gnat.com>
* exp_ch4.adb (Expand_N_Allocator): Generate meaningful names for
a dynamic task if the allocator appears in an indexed assignment
or selected component assignment.
* exp_util.adb (Build_Task_Array_Image, Build_Task_Record_Image):
For a dynamic task in an assignment statement, use target of
assignment to generate meaningful name.
2001-10-10 Ed Schonberg <schonber@gnat.com>
* einfo.adb (Write_Field19_Name): Body_Entity is also defined for
a generic package.
......
gcc/ada/exp_ch4.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.463 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
......@@ -1818,7 +1818,10 @@ package body Exp_Ch4 is
-- If the context of the allocator is a declaration or
-- an assignment, we can generate a meaningful image for
-- it, even though subsequent assignments might remove
-- the connection between task and entity.
-- the connection between task and entity. We build this
-- image when the left-hand side is a simple variable,
-- a simple indexed assignment or a simple selected
-- component.
if Nkind (Parent (N)) = N_Assignment_Statement then
declare
......@@ -1832,6 +1835,13 @@ package body Exp_Ch4 is
New_Occurrence_Of
(Entity (Nam), Sloc (Nam)), T);
elsif (Nkind (Nam) = N_Indexed_Component
or else Nkind (Nam) = N_Selected_Component)
and then Is_Entity_Name (Prefix (Nam))
then
Decls :=
Build_Task_Image_Decls (
Loc, Nam, Etype (Prefix (Nam)));
else
Decls := Build_Task_Image_Decls (Loc, T, T);
end if;
......
gcc/ada/exp_util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.331 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
......@@ -64,11 +64,15 @@ package body Exp_Util is
function Build_Task_Array_Image
(Loc : Source_Ptr;
Id_Ref : Node_Id;
A_Type : Entity_Id)
A_Type : Entity_Id;
Dyn : Boolean := False)
return Node_Id;
-- Build function to generate the image string for a task that is an
-- array component, concatenating the images of each index. To avoid
-- storage leaks, the string is built with successive slice assignments.
-- The flag Dyn indicates whether this is called for the initialization
-- procedure of an array of tasks, or for the name of a dynamically
-- created task that is assigned to an indexed component.
function Build_Task_Image_Function
(Loc : Source_Ptr;
......@@ -94,10 +98,14 @@ package body Exp_Util is
function Build_Task_Record_Image
(Loc : Source_Ptr;
Id_Ref : Node_Id;
A_Type : Entity_Id)
A_Type : Entity_Id;
Dyn : Boolean := False)
return Node_Id;
-- Build function to generate the image string for a task that is a
-- record component. Concatenate name of variable with that of selector.
-- The flag Dyn indicates whether this is called for the initialization
-- procedure of record with task components, or for a dynamically
-- created task that is assigned to a selected component.
function Make_CW_Equivalent_Type
(T : Entity_Id;
......@@ -326,17 +334,17 @@ package body Exp_Util is
-- The generated function has the following structure:
-- function F return Task_Image_Type is
-- Prefix : string := Task_Id.all;
-- Pref : string := Task_Id.all;
-- T1 : String := Index1'Image (Val1);
-- ...
-- Tn : String := indexn'image (Valn);
-- Len : Integer := T1'Length + ... + Tn'Length + n + 1;
-- -- Len includes commas and the end parentheses.
-- Res : String (1..Len);
-- Pos : Integer := Prefix'Length;
-- Pos : Integer := Pref'Length;
--
-- begin
-- Res (1 .. Pos) := Prefix;
-- Res (1 .. Pos) := Pref;
-- Pos := Pos + 1;
-- Res (Pos) := '(';
-- Pos := Pos + 1;
......@@ -357,7 +365,8 @@ package body Exp_Util is
function Build_Task_Array_Image
(Loc : Source_Ptr;
Id_Ref : Node_Id;
A_Type : Entity_Id)
A_Type : Entity_Id;
Dyn : Boolean := False)
return Node_Id
is
Dims : constant Nat := Number_Dimensions (A_Type);
......@@ -375,9 +384,12 @@ package body Exp_Util is
Pos : Entity_Id;
-- Running index for substring assignments
Prefix : Entity_Id;
Pref : Entity_Id;
-- Name of enclosing variable, prefix of resulting name
P_Nam : Node_Id;
-- string expression for Pref.
Res : Entity_Id;
-- String to hold result
......@@ -394,15 +406,26 @@ package body Exp_Util is
Stats : List_Id := New_List;
begin
Prefix := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Pref := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
-- For a dynamic task, the name comes from the target variable.
-- For a static one it is a formal of the enclosing init_proc.
if Dyn then
Get_Name_String (Chars (Entity (Prefix (Id_Ref))));
P_Nam :=
Make_String_Literal (Loc, Strval => String_From_Name_Buffer);
else
P_Nam :=
Make_Explicit_Dereference (Loc,
Prefix => Make_Identifier (Loc, Name_uTask_Id));
end if;
Append_To (Decls,
Make_Object_Declaration (Loc,
Defining_Identifier => Prefix,
Defining_Identifier => Pref,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression =>
Make_Explicit_Dereference (Loc,
Prefix => Make_Identifier (Loc, Name_uTask_Id))));
Expression => P_Nam));
Indx := First_Index (A_Type);
Val := First (Expressions (Id_Ref));
......@@ -436,7 +459,7 @@ package body Exp_Util is
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix =>
New_Occurrence_Of (Prefix, Loc),
New_Occurrence_Of (Pref, Loc),
Expressions => New_List (Make_Integer_Literal (Loc, 1))));
for J in 1 .. Dims loop
......@@ -451,7 +474,7 @@ package body Exp_Util is
Expressions => New_List (Make_Integer_Literal (Loc, 1))));
end loop;
Build_Task_Image_Prefix (Loc, Len, Res, Pos, Prefix, Sum, Decls, Stats);
Build_Task_Image_Prefix (Loc, Len, Res, Pos, Pref, Sum, Decls, Stats);
Set_Character_Literal_Name (Char_Code (Character'Pos ('(')));
......@@ -560,11 +583,14 @@ package body Exp_Util is
A_Type : Entity_Id)
return List_Id
is
T_Id : Entity_Id := Empty;
Decl : Node_Id;
Decls : List_Id := New_List;
Expr : Node_Id := Empty;
Fun : Node_Id := Empty;
T_Id : Entity_Id := Empty;
Decl : Node_Id;
Decls : List_Id := New_List;
Expr : Node_Id := Empty;
Fun : Node_Id := Empty;
Is_Dyn : constant Boolean :=
Nkind (Parent (Id_Ref)) = N_Assignment_Statement
and then Nkind (Expression (Parent (Id_Ref))) = N_Allocator;
begin
-- If Discard_Names is in effect, generate a dummy declaration only.
......@@ -607,14 +633,14 @@ package body Exp_Util is
T_Id :=
Make_Defining_Identifier (Loc,
New_External_Name (Chars (Selector_Name (Id_Ref)), 'I'));
Fun := Build_Task_Record_Image (Loc, Id_Ref, A_Type);
Fun := Build_Task_Record_Image (Loc, Id_Ref, A_Type, Is_Dyn);
elsif Nkind (Id_Ref) = N_Indexed_Component then
T_Id :=
Make_Defining_Identifier (Loc,
New_External_Name (Chars (A_Type), 'I'));
Fun := Build_Task_Array_Image (Loc, Id_Ref, A_Type);
Fun := Build_Task_Array_Image (Loc, Id_Ref, A_Type, Is_Dyn);
end if;
end if;
......@@ -760,7 +786,8 @@ package body Exp_Util is
function Build_Task_Record_Image
(Loc : Source_Ptr;
Id_Ref : Node_Id;
A_Type : Entity_Id)
A_Type : Entity_Id;
Dyn : Boolean := False)
return Node_Id
is
Len : Entity_Id;
......@@ -772,9 +799,12 @@ package body Exp_Util is
Res : Entity_Id;
-- String to hold result
Prefix : Entity_Id;
Pref : Entity_Id;
-- Name of enclosing variable, prefix of resulting name
P_Nam : Node_Id;
-- string expression for Pref.
Sum : Node_Id;
-- Expression to compute total size of string.
......@@ -785,15 +815,26 @@ package body Exp_Util is
Stats : List_Id := New_List;
begin
Prefix := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Pref := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
-- For a dynamic task, the name comes from the target variable.
-- For a static one it is a formal of the enclosing init_proc.
if Dyn then
Get_Name_String (Chars (Entity (Prefix (Id_Ref))));
P_Nam :=
Make_String_Literal (Loc, Strval => String_From_Name_Buffer);
else
P_Nam :=
Make_Explicit_Dereference (Loc,
Prefix => Make_Identifier (Loc, Name_uTask_Id));
end if;
Append_To (Decls,
Make_Object_Declaration (Loc,
Defining_Identifier => Prefix,
Defining_Identifier => Pref,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression =>
Make_Explicit_Dereference (Loc,
Prefix => Make_Identifier (Loc, Name_uTask_Id))));
Expression => P_Nam));
Sel := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
......@@ -815,10 +856,10 @@ package body Exp_Util is
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix =>
New_Occurrence_Of (Prefix, Loc),
New_Occurrence_Of (Pref, Loc),
Expressions => New_List (Make_Integer_Literal (Loc, 1))));
Build_Task_Image_Prefix (Loc, Len, Res, Pos, Prefix, Sum, Decls, Stats);
Build_Task_Image_Prefix (Loc, Len, Res, Pos, Pref, Sum, Decls, Stats);
Set_Character_Literal_Name (Char_Code (Character'Pos ('.')));
......
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