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

a-tags.ads, a-tags.adb (Get_TSD): Subprogram removed.

Browse Source 
2005-03-29  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads, a-tags.adb (Get_TSD): Subprogram removed.
	(Inherit_DT): The first formal has been redefined as a Tag.
	This allows us the removal of the subprogram Get_TSD.
	(TSD): Replace the call to Get_TSD by the actual code.

	* exp_disp.ads, exp_disp.adb: Remove support to call Get_TSD.
	(Make_DT): Upgrade the call to Inherit_TSD according to the
	new interface: the first formal is now a Tag.

	* i-cpp.ads, i-cpp.adb (CPP_Inherit_DT): The first formal has been
	redefined as a Tag.
	This change allows us to remove the subprogram Get_TSD.
	(CPP_Get_TSD): Subprogram removed.
	(TSD): Replace the call to CPP_Get_TSD by the actual code.

	* rtsfind.ads: Remove support to call the run-time
	subprogram Get_TSD

From-SVN: r97168
This commit is contained in:
Javier Miranda 2005-03-29 18:13:49 +02:00 committed by Arnaud Charlet
parent 78dabc95d5
commit d127f91b1d
7 changed files with 38 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/a-tags.adb
View File

@ -342,18 +342,6 @@ package body Ada.Tags is
return TSD (T).Remotely_Callable = True;
end Get_Remotely_Callable;
-------------
-- Get_TSD --
-------------
function Get_TSD (T : Tag) return System.Address is
use type System.Storage_Elements.Storage_Offset;
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
begin
return TSD_Ptr.all;
end Get_TSD;
----------------
-- Inherit_DT --
----------------
@ -374,14 +362,13 @@ package body Ada.Tags is
-- Inherit_TSD --
-----------------
procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag) is
Old_TSD_Ptr : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (Old_TSD);
New_TSD_Ptr : constant Type_Specific_Data_Ptr :=
TSD (New_Tag);
procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag) is
New_TSD_Ptr : constant Type_Specific_Data_Ptr := TSD (New_Tag);
Old_TSD_Ptr : Type_Specific_Data_Ptr;
begin
if Old_TSD_Ptr /= null then
if Old_Tag /= null then
Old_TSD_Ptr := TSD (Old_Tag);
New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) :=
Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth);
@ -577,8 +564,11 @@ package body Ada.Tags is
---------
function TSD (T : Tag) return Type_Specific_Data_Ptr is
use type System.Storage_Elements.Storage_Offset;
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
begin
return To_Type_Specific_Data_Ptr (Get_TSD (T));
return To_Type_Specific_Data_Ptr (TSD_Ptr.all);
end TSD;
end Ada.Tags;

15
gcc/ada/a-tags.ads
View File

@ -114,10 +114,6 @@ private
function Get_Remotely_Callable (T : Tag) return Boolean;
-- Return the value previously set by Set_Remotely_Callable
function Get_TSD (T : Tag) return System.Address;
-- Given a pointer T to a dispatch Table, retreives the address of the
-- record containing the Type Specific Data generated by GNAT
procedure Inherit_DT
(Old_T : Tag;
New_T : Tag;
@ -126,9 +122,8 @@ private
-- of the direct ancestor and the number of primitive ops that are
-- inherited (Entry_Count).
procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag);
-- Entry point used to initialize the TSD of a type knowing the
-- TSD of the direct ancestor.
procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag);
-- Initialize the TSD of a type knowing the tag of the direct ancestor
function Parent_Size
(Obj : System.Address;
@ -182,9 +177,8 @@ private
-- in E.4 (18).
function TSD (T : Tag) return Type_Specific_Data_Ptr;
-- This function is conceptually equivalent to Get_TSD, but
-- returning a Type_Specific_Data_Ptr type (rather than an Address)
-- simplifies the implementation of the other subprograms.
-- Given a pointer T to a dispatch Table, retreives the address of the
-- record containing the Type Specific Data generated by GNAT
DT_Prologue_Size : constant SSE.Storage_Count :=
SSE.Storage_Count
@ -237,7 +231,6 @@ private
pragma Inline_Always (Get_Prim_Op_Address);
pragma Inline_Always (Get_RC_Offset);
pragma Inline_Always (Get_Remotely_Callable);
pragma Inline_Always (Get_TSD);
pragma Inline_Always (Inherit_DT);
pragma Inline_Always (Inherit_TSD);
pragma Inline_Always (Register_Tag);

34
gcc/ada/exp_disp.adb
View File

@ -58,7 +58,6 @@ package body Exp_Disp is
Get_Prim_Op_Address => RE_Get_Prim_Op_Address,
Get_RC_Offset => RE_Get_RC_Offset,
Get_Remotely_Callable => RE_Get_Remotely_Callable,
Get_TSD => RE_Get_TSD,
Inherit_DT => RE_Inherit_DT,
Inherit_TSD => RE_Inherit_TSD,
Register_Tag => RE_Register_Tag,
@ -79,7 +78,6 @@ package body Exp_Disp is
Get_Prim_Op_Address => RE_CPP_Get_Prim_Op_Address,
Get_RC_Offset => RE_CPP_Get_RC_Offset,
Get_Remotely_Callable => RE_CPP_Get_Remotely_Callable,
Get_TSD => RE_CPP_Get_TSD,
Inherit_DT => RE_CPP_Inherit_DT,
Inherit_TSD => RE_CPP_Inherit_TSD,
Register_Tag => RE_CPP_Register_Tag,
@ -100,7 +98,6 @@ package body Exp_Disp is
Get_Prim_Op_Address => False,
Get_Remotely_Callable => False,
Get_RC_Offset => False,
Get_TSD => False,
Inherit_DT => True,
Inherit_TSD => True,
Register_Tag => True,
@ -121,7 +118,6 @@ package body Exp_Disp is
Get_Prim_Op_Address => 2,
Get_RC_Offset => 1,
Get_Remotely_Callable => 1,
Get_TSD => 1,
Inherit_DT => 3,
Inherit_TSD => 2,
Register_Tag => 1,
@ -640,8 +636,8 @@ package body Exp_Disp is
I_Depth : Int;
Generalized_Tag : Entity_Id;
Size_Expr_Node : Node_Id;
Old_Tag : Node_Id;
Old_TSD : Node_Id;
Old_Tag1 : Node_Id;
Old_Tag2 : Node_Id;
begin
if not RTE_Available (RE_Tag) then
@ -834,24 +830,20 @@ package body Exp_Disp is
if Typ = Etype (Typ)
or else Is_CPP_Class (Etype (Typ))
then
Old_Tag :=
Old_Tag1 :=
Unchecked_Convert_To (Generalized_Tag,
Make_Integer_Literal (Loc, 0));
Old_Tag2 :=
Unchecked_Convert_To (Generalized_Tag,
Make_Integer_Literal (Loc, 0));
Old_TSD :=
Unchecked_Convert_To (RTE (RE_Address),
Make_Integer_Literal (Loc, 0));
else
Old_Tag :=
Old_Tag1 :=
New_Reference_To
(Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
Old_Tag2 :=
New_Reference_To
(Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
Old_TSD :=
Make_DT_Access_Action (Typ,
Action => Get_TSD,
Args => New_List (
New_Reference_To
(Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc)));
end if;
-- Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
@ -860,18 +852,18 @@ package body Exp_Disp is
Make_DT_Access_Action (Typ,
Action => Inherit_DT,
Args => New_List (
Node1 => Old_Tag,
Node1 => Old_Tag1,
Node2 => New_Reference_To (DT_Ptr, Loc),
Node3 => Make_Integer_Literal (Loc,
DT_Entry_Count (First_Tag_Component (Etype (Typ)))))));
-- Generate: Inherit_TSD (Get_TSD (parent), DT_Ptr);
-- Generate: Inherit_TSD (parent'tag, DT_Ptr);
Append_To (Elab_Code,
Make_DT_Access_Action (Typ,
Action => Inherit_TSD,
Args => New_List (
Node1 => Old_TSD,
Node1 => Old_Tag2,
Node2 => New_Reference_To (DT_Ptr, Loc))));
-- Generate: Exname : constant String := full_qualified_name (typ);

1
gcc/ada/exp_disp.ads
View File

@ -38,7 +38,6 @@ package Exp_Disp is
Get_Prim_Op_Address,
Get_RC_Offset,
Get_Remotely_Callable,
Get_TSD,
Inherit_DT,
Inherit_TSD,
Register_Tag,

29
gcc/ada/i-cpp.adb
View File

@ -187,18 +187,6 @@ package body Interfaces.CPP is
return True;
end CPP_Get_Remotely_Callable;
-----------------
-- CPP_Get_TSD --
-----------------
function CPP_Get_TSD (T : Vtable_Ptr) return Address is
use type System.Storage_Elements.Storage_Offset;
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
begin
return TSD_Ptr.all;
end CPP_Get_TSD;
--------------------
-- CPP_Inherit_DT --
--------------------
@ -220,17 +208,15 @@ package body Interfaces.CPP is
---------------------
procedure CPP_Inherit_TSD
(Old_TSD : Address;
(Old_Tag : Vtable_Ptr;
New_Tag : Vtable_Ptr)
is
Old_TSD_Ptr : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (Old_TSD);
New_TSD_Ptr : constant Type_Specific_Data_Ptr :=
TSD (New_Tag);
New_TSD_Ptr : constant Type_Specific_Data_Ptr := TSD (New_Tag);
Old_TSD_Ptr : Type_Specific_Data_Ptr;
begin
if Old_TSD_Ptr /= null then
if Old_Tag /= null then
Old_TSD_Ptr := TSD (Old_Tag);
New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) :=
Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth);
@ -391,8 +377,11 @@ package body Interfaces.CPP is
---------
function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr is
use type System.Storage_Elements.Storage_Offset;
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
begin
return To_Type_Specific_Data_Ptr (CPP_Get_TSD (T));
return To_Type_Specific_Data_Ptr (TSD_Ptr.all);
end TSD;
end Interfaces.CPP;

12
gcc/ada/i-cpp.ads
View File

@ -88,10 +88,6 @@ private
-- Given a pointer T to a dispatch Table, stores the address of the
-- record containing the Type Specific Data generated by GNAT
function CPP_Get_TSD (T : Vtable_Ptr) return S.Address;
-- Given a pointer T to a dispatch Table, retreives the address of the
-- record containing the Type Specific Data generated by GNAT
CPP_DT_Prologue_Size : constant SSE.Storage_Count :=
SSE.Storage_Count
(2 * (Standard'Address_Size / S.Storage_Unit));
@ -126,7 +122,7 @@ private
-- inherited (Entry_Count).
procedure CPP_Inherit_TSD
(Old_TSD : S.Address;
(Old_Tag : Vtable_Ptr;
New_Tag : Vtable_Ptr);
-- Entry point used to initialize the TSD of a type knowing the
-- TSD of the direct ancestor.
@ -172,9 +168,8 @@ private
-- (used for virtual function calls)
function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr;
-- This function is conceptually equivalent to Get_TSD, but
-- returning a Type_Specific_Data_Ptr type (rather than an Address)
-- simplifies the implementation of the other subprograms.
-- Given a pointer T to a dispatch Table, retreives the address of the
-- record containing the Type Specific Data generated by GNAT
type Addr_Ptr is access System.Address;
@ -190,7 +185,6 @@ private
pragma Inline (CPP_Set_Prim_Op_Address);
pragma Inline (CPP_Get_Prim_Op_Address);
pragma Inline (CPP_Set_TSD);
pragma Inline (CPP_Get_TSD);
pragma Inline (CPP_Inherit_DT);
pragma Inline (CPP_CW_Membership);
pragma Inline (CPP_Set_External_Tag);

4
gcc/ada/rtsfind.ads
View File

@ -492,7 +492,6 @@ package Rtsfind is
RE_Get_Prim_Op_Address, -- Ada.Tags
RE_Get_RC_Offset, -- Ada.Tags
RE_Get_Remotely_Callable, -- Ada.Tags
RE_Get_TSD, -- Ada.Tags
RE_Inherit_DT, -- Ada.Tags
RE_Inherit_TSD, -- Ada.Tags
RE_Internal_Tag, -- Ada.Tags
@ -539,7 +538,6 @@ package Rtsfind is
RE_CPP_Get_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Get_RC_Offset, -- Interfaces.CPP
RE_CPP_Get_Remotely_Callable, -- Interfaces.CPP
RE_CPP_Get_TSD, -- Interfaces.CPP
RE_CPP_Inherit_DT, -- Interfaces.CPP
RE_CPP_Inherit_TSD, -- Interfaces.CPP
RE_CPP_Register_Tag, -- Interfaces.CPP
@ -1592,7 +1590,6 @@ package Rtsfind is
RE_Get_Prim_Op_Address => Ada_Tags,
RE_Get_RC_Offset => Ada_Tags,
RE_Get_Remotely_Callable => Ada_Tags,
RE_Get_TSD => Ada_Tags,
RE_Inherit_DT => Ada_Tags,
RE_Inherit_TSD => Ada_Tags,
RE_Internal_Tag => Ada_Tags,
@ -1637,7 +1634,6 @@ package Rtsfind is
RE_CPP_Get_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Get_RC_Offset => Interfaces_CPP,
RE_CPP_Get_Remotely_Callable => Interfaces_CPP,
RE_CPP_Get_TSD => Interfaces_CPP,
RE_CPP_Inherit_DT => Interfaces_CPP,
RE_CPP_Inherit_TSD => Interfaces_CPP,
RE_CPP_Register_Tag => Interfaces_CPP,