OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

cstand.adb (Create_Standard): Create an entity for a zero-sized type associated with...

Browse Source 
2007-08-16  Gary Dismukes  <dismukes@adacore.com>

	* cstand.adb (Create_Standard): Create an entity for a zero-sized type
	associated with Standard_Debug_Renaming_Type, to be used as the type of
	the special variables whose names provide debugger encodings for
	renaming declarations.

	* einfo.ads, einfo.adb (Debug_Renaming_Link): Change to return Node25.
	(Set_Debug_Renaming_Link): Change to set Node25.
	(Write_Field13_Name): Remove case for E_Enumeration_Literal.
	(Write_Field25_Name): Add case for E_Variable to output
	"Debug_Renaming_Link".
	(Write_Field23_Name): Correct the output string for "Limited_View".

	* exp_dbug.adb: Add with and use of Tbuild.
	(Debug_Renaming_Declaration): Replace creation of an enumeration type
	and literal with creation of a variable of type
	Standard_Debug_Renaming_Type whose name encodes both the renamed object
	and the entity of the renaming declaration.
	(Qualify_Entity_Name): Add the delayed qualification of the entity name
	part of the name of a variable that has a Debug_Renaming_Link.

	* stand.ads (Standard_Debug_Renaming_Type): New Entity_Id denoting a
	special type to be associated with variables that provide debugger
	encodings for renaming declarations.

From-SVN: r127537
This commit is contained in:
Gary Dismukes 2007-08-16 14:17:54 +02:00 committed by Arnaud Charlet
parent c07fdd94f4
commit 4c8e94abdc
5 changed files with 140 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/cstand.adb
View File

@ -927,6 +927,28 @@ package body CStand is
Set_Directly_Designated_Type (Standard_A_Char, Standard_Character);
Make_Name (Standard_A_Char, "access_character");
-- Standard_Debug_Renaming_Type is used for the special objects created
-- to encode the names occurring in renaming declarations for use by the
-- debugger (see exp_dbug.adb). The type is a zero-sized subtype of
-- Standard.Integer.
Standard_Debug_Renaming_Type := New_Standard_Entity;
Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard);
Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer));
Init_Esize (Standard_Debug_Renaming_Type, 0);
Init_RM_Size (Standard_Debug_Renaming_Type, 0);
Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type);
Set_Integer_Bounds (Standard_Debug_Renaming_Type,
Typ => Base_Type (Standard_Debug_Renaming_Type),
Lb => Uint_1,
Hb => Uint_0);
Set_Is_Constrained (Standard_Debug_Renaming_Type);
Set_Has_Size_Clause (Standard_Debug_Renaming_Type);
Make_Name (Standard_Debug_Renaming_Type, "_renaming_type");
-- Note on type names. The type names for the following special types
-- are constructed so that they will look reasonable should they ever
-- appear in error messages etc, although in practice the use of the

14
gcc/ada/einfo.adb
View File

@ -106,7 +106,6 @@ package body Einfo is
-- Corresponding_Equality Node13
-- Component_Clause Node13
-- Debug_Renaming_Link Node13
-- Elaboration_Entity Node13
-- Extra_Accessibility Node13
-- RM_Size Uint13
@ -214,6 +213,7 @@ package body Einfo is
-- Abstract_Interface_Alias Node25
-- Abstract_Interfaces Elist25
-- Current_Use_Clause Node25
-- Debug_Renaming_Link Node25
-- DT_Offset_To_Top_Func Node25
-- Task_Body_Procedure Node25
@ -741,7 +741,7 @@ package body Einfo is
function Debug_Renaming_Link (Id : E) return E is
begin
return Node13 (Id);
return Node25 (Id);
end Debug_Renaming_Link;
function Default_Expr_Function (Id : E) return E is
@ -2997,7 +2997,7 @@ package body Einfo is
procedure Set_Debug_Renaming_Link (Id : E; V : E) is
begin
Set_Node13 (Id, V);
Set_Node25 (Id, V);
end Set_Debug_Renaming_Link;
procedure Set_Default_Expr_Function (Id : E; V : E) is
@ -7604,9 +7604,6 @@ package body Einfo is
E_Discriminant =>
Write_Str ("Component_Clause");
when E_Enumeration_Literal =>
Write_Str ("Debug_Renaming_Link");
when E_Function =>
if not Comes_From_Source (Id)
and then
@ -8149,7 +8146,7 @@ package body Einfo is
if Is_Generic_Instance (Id) then
Write_Str ("Generic_Renamings");
else
Write_Str ("Limited Views");
Write_Str ("Limited_View");
end if;
-- What about Privals_Chain for protected operations ???
@ -8198,6 +8195,9 @@ package body Einfo is
when Task_Kind =>
Write_Str ("Task_Body_Procedure");
when E_Variable =>
Write_Str ("Debug_Renaming_Link");
when others =>
Write_Str ("Field25??");
end case;

6
gcc/ada/einfo.ads
View File

@ -665,8 +665,8 @@ package Einfo is
-- determining if Needs_Debug_Info should be set. The back end should
-- always test Needs_Debug_Info, it should never test Debug_Info_Off.
-- Debug_Renaming_Link (Node13)
-- Used to link the enumeration literal of a debug renaming declaration
-- Debug_Renaming_Link (Node25)
-- Used to link the variable associated with a debug renaming declaration
-- to the renamed entity. See Exp_Dbug.Debug_Renaming_Declaration for
-- details of the use of this field.
@ -4717,7 +4717,6 @@ package Einfo is
-- E_Enumeration_Literal
-- Enumeration_Pos (Uint11)
-- Enumeration_Rep (Uint12)
-- Debug_Renaming_Link (Node13)
-- Alias (Node18)
-- Enumeration_Rep_Expr (Node22)
-- Next_Literal (synth)
@ -5250,6 +5249,7 @@ package Einfo is
-- Interface_Name (Node21)
-- Shared_Var_Assign_Proc (Node22)
-- Extra_Constrained (Node23)
-- Debug_Renaming_Link (Node25)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)

157
gcc/ada/exp_dbug.adb
View File

@ -38,6 +38,7 @@ with Sinfo; use Sinfo;
with Stand; use Stand;
with Stringt; use Stringt;
with Table;
with Tbuild; use Tbuild;
with Urealp; use Urealp;
package body Exp_Dbug is
@ -295,12 +296,10 @@ package body Exp_Dbug is
Loc : constant Source_Ptr := Sloc (N);
Ent : constant Node_Id := Defining_Entity (N);
Nam : constant Node_Id := Name (N);
Rnm : Name_Id;
Ren : Node_Id;
Lit : Entity_Id;
Typ : Entity_Id;
Obj : Entity_Id;
Res : Node_Id;
Def : Entity_Id;
function Output_Subscript (N : Node_Id; S : String) return Boolean;
-- Outputs a single subscript value as ?nnn (subscript is compile time
@ -342,36 +341,6 @@ package body Exp_Dbug is
return Empty;
end if;
-- Prepare entity name for type declaration
Get_Name_String (Chars (Ent));
case Nkind (N) is
when N_Object_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XR");
when N_Exception_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XRE");
when N_Package_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XRP");
-- If it is a child unit create a fully qualified name, to
-- disambiguate multiple child units with the same name and
-- different parents.
if Is_Child_Unit (Ent) then
Prepend_String_To_Buffer ("__");
Prepend_String_To_Buffer
(Get_Name_String (Chars (Scope (Ent))));
end if;
when others =>
return Empty;
end case;
Rnm := Name_Find;
-- Get renamed entity and compute suffix
Name_Len := 0;
@ -443,9 +412,43 @@ package body Exp_Dbug is
Prepend_String_To_Buffer ("___XE");
-- For now, the literal name contains only the suffix. The Entity_Id
-- value for the name is used to create a link from this literal name
-- to the renamed entity using the Debug_Renaming_Link field. Then the
-- Include the designation of the form of renaming
case Nkind (N) is
when N_Object_Renaming_Declaration =>
Prepend_String_To_Buffer ("___XR");
when N_Exception_Renaming_Declaration =>
Prepend_String_To_Buffer ("___XRE");
when N_Package_Renaming_Declaration =>
Prepend_String_To_Buffer ("___XRP");
when others =>
return Empty;
end case;
-- Add the name of the renaming entity to the front
Prepend_String_To_Buffer (Get_Name_String (Chars (Ent)));
-- If it is a child unit create a fully qualified name, to disambiguate
-- multiple child units with the same name and different parents.
if Nkind (N) = N_Package_Renaming_Declaration
and then Is_Child_Unit (Ent)
then
Prepend_String_To_Buffer ("__");
Prepend_String_To_Buffer
(Get_Name_String (Chars (Scope (Ent))));
end if;
-- Create the special object whose name is the debug encoding for the
-- renaming declaration.
-- For now, the object name contains the suffix encoding for the renamed
-- object, but not the name of the leading entity. The object is linked
-- the renamed entity using the Debug_Renaming_Link field. Then the
-- Qualify_Entity_Name procedure uses this link to create the proper
-- fully qualified name.
@ -453,23 +456,17 @@ package body Exp_Dbug is
-- qualification of the renamed entity, and it is really much easier to
-- do this after the renamed entity has itself been fully qualified.
Lit := Make_Defining_Identifier (Loc, Chars => Name_Enter);
Set_Debug_Renaming_Link (Lit, Entity (Ren));
-- Return the appropriate enumeration type
Def := Make_Defining_Identifier (Loc, Chars => Rnm);
Obj := Make_Defining_Identifier (Loc, Chars => Name_Enter);
Res :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Def,
Type_Definition =>
Make_Enumeration_Type_Definition (Loc,
Literals => New_List (Lit)));
Make_Object_Declaration (Loc,
Defining_Identifier => Obj,
Object_Definition => New_Reference_To
(Standard_Debug_Renaming_Type, Loc));
Set_Needs_Debug_Info (Def);
Set_Needs_Debug_Info (Lit);
Set_Debug_Renaming_Link (Obj, Entity (Ren));
Set_Needs_Debug_Info (Obj);
Set_Discard_Names (Defining_Identifier (Res));
return Res;
-- If we get an exception, just figure it is a case that we cannot
@ -1251,17 +1248,69 @@ package body Exp_Dbug is
if Has_Qualified_Name (Ent) then
return;
-- Here is where we create the proper link for renaming
-- If the entity is a variable encoding the debug name for an object
-- renaming, then the qualified name of the entity associated with the
-- renamed object can now be incorporated in the debug name.
elsif Ekind (Ent) = E_Enumeration_Literal
elsif Ekind (Ent) = E_Variable
and then Present (Debug_Renaming_Link (Ent))
then
Name_Len := 0;
Qualify_Entity_Name (Debug_Renaming_Link (Ent));
Get_Name_String (Chars (Ent));
Prepend_String_To_Buffer
(Get_Name_String (Chars (Debug_Renaming_Link (Ent))));
-- Retrieve the now-qualified name of the renamed entity and insert
-- it in the middle of the name, just preceding the suffix encoding
-- describing the renamed object.
declare
Renamed_Id : constant String :=
Get_Name_String (Chars (Debug_Renaming_Link (Ent)));
Insert_Len : constant Integer := Renamed_Id'Length + 1;
Index : Natural := Name_Len - 3;
begin
-- Loop backwards through the name to find the start of the "___"
-- sequence associated with the suffix.
while Index >= Name_Buffer'First
and then (Name_Buffer (Index + 1) /= '_'
or else Name_Buffer (Index + 2) /= '_'
or else Name_Buffer (Index + 3) /= '_')
loop
Index := Index - 1;
end loop;
pragma Assert (Name_Buffer (Index + 1 .. Index + 3) = "___");
-- Insert an underscore separator and the entity name just in
-- front of the suffix.
Name_Buffer (Index + 1 + Insert_Len .. Name_Len + Insert_Len) :=
Name_Buffer (Index + 1 .. Name_Len);
Name_Buffer (Index + 1) := '_';
Name_Buffer (Index + 2 .. Index + Insert_Len) := Renamed_Id;
Name_Len := Name_Len + Insert_Len;
end;
-- Reset the name of the variable to the new name that includes the
-- name of the renamed entity.
Set_Chars (Ent, Name_Enter);
-- If the entity needs qualification by its scope then develop it
-- here, add the variable's name, and again reset the entity name.
if Qualify_Needed (Scope (Ent)) then
Name_Len := 0;
Set_Entity_Name (Scope (Ent));
Add_Str_To_Name_Buffer ("__");
Get_Name_String_And_Append (Chars (Ent));
Set_Chars (Ent, Name_Enter);
end if;
Set_Has_Qualified_Name (Ent);
return;

6
gcc/ada/stand.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -345,6 +345,10 @@ package Stand is
-- Access to character, used as a component of the exception type to
-- denote a thin pointer component.
Standard_Debug_Renaming_Type : Entity_Id;
-- A null record type with zero size, used as the type of variables used
-- to provide the debugger with name encodings for renaming declarations.
-- The entities labeled Any_xxx are used in situations where the full
-- characteristics of an entity are not yet known, e.g. Any_Character
-- is used to label a character literal before resolution is complete.