Skip to content

R
riscv-gcc-1
Commit 5fa28bbb by Javier Miranda Committed by Arnaud Charlet
Options

a-tags.ads, a-tags.adb (Get_Expanded_Name): Removed. 

2005-03-17  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads, a-tags.adb (Get_Expanded_Name): Removed.
	(Get_Inheritance_Depth): Removed.
	(Set_Inheritance_Depth): Removed.

	* rtsfind.ads, exp_disp.ads, exp_disp.adb: Remove support to call the
	subprogram Get_Expanded_Name because it is not referenced by the
	frontend.

	* i-cpp.ads, i-cpp.adb (CPP_Get_Expanded_Name): Removed.
	(CPP_Get_Inheritance_Depth): Removed.
	(CPP_Set_Inheritance_Depth): Removed.

	* tbuild.ads, tbuild.adb (Make_DT_Component): Removed.

From-SVN: r96662
parent 2d072788
Showing with 0 additions and 148 deletions
gcc/ada/a-tags.adb
...@@ -303,15 +303,6 @@ package body Ada.Tags is ...@@ -303,15 +303,6 @@ package body Ada.Tags is
return Result (1 .. Length (Result)); return Result (1 .. Length (Result));
end External_Tag; end External_Tag;
-----------------------
-- Get_Expanded_Name --
-----------------------
function Get_Expanded_Name (T : Tag) return System.Address is
begin
return To_Address (TSD (T).Expanded_Name);
end Get_Expanded_Name;
---------------------- ----------------------
-- Get_External_Tag -- -- Get_External_Tag --
---------------------- ----------------------
...@@ -321,15 +312,6 @@ package body Ada.Tags is ...@@ -321,15 +312,6 @@ package body Ada.Tags is
return To_Address (TSD (T).External_Tag); return To_Address (TSD (T).External_Tag);
end Get_External_Tag; end Get_External_Tag;
---------------------------
-- Get_Inheritance_Depth --
---------------------------
function Get_Inheritance_Depth (T : Tag) return Natural is
begin
return TSD (T).Idepth;
end Get_Inheritance_Depth;
------------------------- -------------------------
-- Get_Prim_Op_Address -- -- Get_Prim_Op_Address --
------------------------- -------------------------
...@@ -519,18 +501,6 @@ package body Ada.Tags is ...@@ -519,18 +501,6 @@ package body Ada.Tags is
TSD (T).External_Tag := To_Cstring_Ptr (Value); TSD (T).External_Tag := To_Cstring_Ptr (Value);
end Set_External_Tag; end Set_External_Tag;
---------------------------
-- Set_Inheritance_Depth --
---------------------------
procedure Set_Inheritance_Depth
(T : Tag;
Value : Natural)
is
begin
TSD (T).Idepth := Value;
end Set_Inheritance_Depth;
------------------------- -------------------------
-- Set_Prim_Op_Address -- -- Set_Prim_Op_Address --
------------------------- -------------------------
......
gcc/ada/a-tags.ads
...@@ -91,10 +91,6 @@ private ...@@ -91,10 +91,6 @@ private
-- Given the tag of an object and the tag associated to a type, return -- Given the tag of an object and the tag associated to a type, return
-- true if Obj is in Typ'Class. -- true if Obj is in Typ'Class.
function Get_Expanded_Name (T : Tag) return System.Address;
-- Retrieve the address of a null terminated string containing
-- the expanded name
function Get_External_Tag (T : Tag) return System.Address; function Get_External_Tag (T : Tag) return System.Address;
-- Retrieve the address of a null terminated string containing -- Retrieve the address of a null terminated string containing
-- the external name -- the external name
...@@ -106,10 +102,6 @@ private ...@@ -106,10 +102,6 @@ private
-- this function returns the address of the virtual function stored -- this function returns the address of the virtual function stored
-- in it (used for dispatching calls) -- in it (used for dispatching calls)
function Get_Inheritance_Depth (T : Tag) return Natural;
-- Given a pointer to a dispatch Table, retrieves the value representing
-- the depth in the inheritance tree (used for membership).
function Get_RC_Offset (T : Tag) return SSE.Storage_Offset; function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
-- Return the Offset of the implicit record controller when the object -- Return the Offset of the implicit record controller when the object
-- has controlled components. O otherwise. -- has controlled components. O otherwise.
...@@ -161,13 +153,6 @@ private ...@@ -161,13 +153,6 @@ private
-- Insert the Tag and its associated external_tag in a table for the -- Insert the Tag and its associated external_tag in a table for the
-- sake of Internal_Tag -- sake of Internal_Tag
procedure Set_Inheritance_Depth
(T : Tag;
Value : Natural);
-- Given a pointer to a dispatch Table, stores the value representing
-- the depth in the inheritance tree (the second parameter). Used during
-- elaboration of the tagged type.
procedure Set_Prim_Op_Address procedure Set_Prim_Op_Address
(T : Tag; (T : Tag;
Position : Positive; Position : Positive;
...@@ -249,8 +234,6 @@ private ...@@ -249,8 +234,6 @@ private
-- use in a minimal/no run-time environment for high integrity use. -- use in a minimal/no run-time environment for high integrity use.
pragma Inline_Always (CW_Membership); pragma Inline_Always (CW_Membership);
pragma Inline_Always (Get_Expanded_Name);
pragma Inline_Always (Get_Inheritance_Depth);
pragma Inline_Always (Get_Prim_Op_Address); pragma Inline_Always (Get_Prim_Op_Address);
pragma Inline_Always (Get_RC_Offset); pragma Inline_Always (Get_RC_Offset);
pragma Inline_Always (Get_Remotely_Callable); pragma Inline_Always (Get_Remotely_Callable);
...@@ -260,7 +243,6 @@ private ...@@ -260,7 +243,6 @@ private
pragma Inline_Always (Register_Tag); pragma Inline_Always (Register_Tag);
pragma Inline_Always (Set_Expanded_Name); pragma Inline_Always (Set_Expanded_Name);
pragma Inline_Always (Set_External_Tag); pragma Inline_Always (Set_External_Tag);
pragma Inline_Always (Set_Inheritance_Depth);
pragma Inline_Always (Set_Prim_Op_Address); pragma Inline_Always (Set_Prim_Op_Address);
pragma Inline_Always (Set_RC_Offset); pragma Inline_Always (Set_RC_Offset);
pragma Inline_Always (Set_Remotely_Callable); pragma Inline_Always (Set_Remotely_Callable);
......
gcc/ada/exp_disp.adb
...@@ -54,7 +54,6 @@ package body Exp_Disp is ...@@ -54,7 +54,6 @@ package body Exp_Disp is
(CW_Membership => RE_CW_Membership, (CW_Membership => RE_CW_Membership,
DT_Entry_Size => RE_DT_Entry_Size, DT_Entry_Size => RE_DT_Entry_Size,
DT_Prologue_Size => RE_DT_Prologue_Size, DT_Prologue_Size => RE_DT_Prologue_Size,
Get_Expanded_Name => RE_Get_Expanded_Name,
Get_External_Tag => RE_Get_External_Tag, Get_External_Tag => RE_Get_External_Tag,
Get_Prim_Op_Address => RE_Get_Prim_Op_Address, Get_Prim_Op_Address => RE_Get_Prim_Op_Address,
Get_RC_Offset => RE_Get_RC_Offset, Get_RC_Offset => RE_Get_RC_Offset,
...@@ -76,7 +75,6 @@ package body Exp_Disp is ...@@ -76,7 +75,6 @@ package body Exp_Disp is
(CW_Membership => RE_CPP_CW_Membership, (CW_Membership => RE_CPP_CW_Membership,
DT_Entry_Size => RE_CPP_DT_Entry_Size, DT_Entry_Size => RE_CPP_DT_Entry_Size,
DT_Prologue_Size => RE_CPP_DT_Prologue_Size, DT_Prologue_Size => RE_CPP_DT_Prologue_Size,
Get_Expanded_Name => RE_CPP_Get_Expanded_Name,
Get_External_Tag => RE_CPP_Get_External_Tag, Get_External_Tag => RE_CPP_Get_External_Tag,
Get_Prim_Op_Address => RE_CPP_Get_Prim_Op_Address, Get_Prim_Op_Address => RE_CPP_Get_Prim_Op_Address,
Get_RC_Offset => RE_CPP_Get_RC_Offset, Get_RC_Offset => RE_CPP_Get_RC_Offset,
...@@ -98,7 +96,6 @@ package body Exp_Disp is ...@@ -98,7 +96,6 @@ package body Exp_Disp is
(CW_Membership => False, (CW_Membership => False,
DT_Entry_Size => False, DT_Entry_Size => False,
DT_Prologue_Size => False, DT_Prologue_Size => False,
Get_Expanded_Name => False,
Get_External_Tag => False, Get_External_Tag => False,
Get_Prim_Op_Address => False, Get_Prim_Op_Address => False,
Get_Remotely_Callable => False, Get_Remotely_Callable => False,
...@@ -120,7 +117,6 @@ package body Exp_Disp is ...@@ -120,7 +117,6 @@ package body Exp_Disp is
(CW_Membership => 2, (CW_Membership => 2,
DT_Entry_Size => 0, DT_Entry_Size => 0,
DT_Prologue_Size => 0, DT_Prologue_Size => 0,
Get_Expanded_Name => 1,
Get_External_Tag => 1, Get_External_Tag => 1,
Get_Prim_Op_Address => 2, Get_Prim_Op_Address => 2,
Get_RC_Offset => 1, Get_RC_Offset => 1,
......
gcc/ada/exp_disp.ads
...@@ -34,7 +34,6 @@ package Exp_Disp is ...@@ -34,7 +34,6 @@ package Exp_Disp is
(CW_Membership, (CW_Membership,
DT_Entry_Size, DT_Entry_Size,
DT_Prologue_Size, DT_Prologue_Size,
Get_Expanded_Name,
Get_External_Tag, Get_External_Tag,
Get_Prim_Op_Address, Get_Prim_Op_Address,
Get_RC_Offset, Get_RC_Offset,
......
gcc/ada/i-cpp.adb
...@@ -146,15 +146,6 @@ package body Interfaces.CPP is ...@@ -146,15 +146,6 @@ package body Interfaces.CPP is
return Pos >= 0 and then TSD (Obj_Tag).Ancestor_Tags (Pos) = Typ_Tag; return Pos >= 0 and then TSD (Obj_Tag).Ancestor_Tags (Pos) = Typ_Tag;
end CPP_CW_Membership; end CPP_CW_Membership;
---------------------------
-- CPP_Get_Expanded_Name --
---------------------------
function CPP_Get_Expanded_Name (T : Vtable_Ptr) return Address is
begin
return To_Address (TSD (T).Expanded_Name);
end CPP_Get_Expanded_Name;
-------------------------- --------------------------
-- CPP_Get_External_Tag -- -- CPP_Get_External_Tag --
-------------------------- --------------------------
...@@ -164,15 +155,6 @@ package body Interfaces.CPP is ...@@ -164,15 +155,6 @@ package body Interfaces.CPP is
return To_Address (TSD (T).External_Tag); return To_Address (TSD (T).External_Tag);
end CPP_Get_External_Tag; end CPP_Get_External_Tag;
-------------------------------
-- CPP_Get_Inheritance_Depth --
-------------------------------
function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural is
begin
return TSD (T).Idepth;
end CPP_Get_Inheritance_Depth;
------------------------- -------------------------
-- CPP_Get_Prim_Op_Address -- -- CPP_Get_Prim_Op_Address --
------------------------- -------------------------
...@@ -277,18 +259,6 @@ package body Interfaces.CPP is ...@@ -277,18 +259,6 @@ package body Interfaces.CPP is
TSD (T).External_Tag := To_Cstring_Ptr (Value); TSD (T).External_Tag := To_Cstring_Ptr (Value);
end CPP_Set_External_Tag; end CPP_Set_External_Tag;
-------------------------------
-- CPP_Set_Inheritance_Depth --
-------------------------------
procedure CPP_Set_Inheritance_Depth
(T : Vtable_Ptr;
Value : Natural)
is
begin
TSD (T).Idepth := Value;
end CPP_Set_Inheritance_Depth;
----------------------------- -----------------------------
-- CPP_Set_Prim_Op_Address -- -- CPP_Set_Prim_Op_Address --
----------------------------- -----------------------------
......
gcc/ada/i-cpp.ads
...@@ -84,17 +84,6 @@ private ...@@ -84,17 +84,6 @@ private
-- this function returns the address of the virtual function stored -- this function returns the address of the virtual function stored
-- in it (used for dispatching calls) -- in it (used for dispatching calls)
procedure CPP_Set_Inheritance_Depth
(T : Vtable_Ptr;
Value : Natural);
-- Given a pointer to a dispatch Table, stores the value representing
-- the depth in the inheritance tree. Used during elaboration of the
-- tagged type.
function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural;
-- Given a pointer to a dispatch Table, retreives the value representing
-- the depth in the inheritance tree. Used for membership.
procedure CPP_Set_TSD (T : Vtable_Ptr; Value : S.Address); procedure CPP_Set_TSD (T : Vtable_Ptr; Value : S.Address);
-- Given a pointer T to a dispatch Table, stores the address of the -- Given a pointer T to a dispatch Table, stores the address of the
-- record containing the Type Specific Data generated by GNAT -- record containing the Type Specific Data generated by GNAT
...@@ -158,10 +147,6 @@ private ...@@ -158,10 +147,6 @@ private
-- Set the address of the string containing the expanded name -- Set the address of the string containing the expanded name
-- in the Dispatch table -- in the Dispatch table
function CPP_Get_Expanded_Name (T : Vtable_Ptr) return S.Address;
-- Retrieve the address of a null terminated string containing
-- the expanded name
procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean); procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean);
-- Since the notions of spec/body distinction and categorized packages -- Since the notions of spec/body distinction and categorized packages
-- do not exist in C, this procedure will do nothing -- do not exist in C, this procedure will do nothing
...@@ -204,8 +189,6 @@ private ...@@ -204,8 +189,6 @@ private
pragma Inline (CPP_Set_Prim_Op_Address); pragma Inline (CPP_Set_Prim_Op_Address);
pragma Inline (CPP_Get_Prim_Op_Address); pragma Inline (CPP_Get_Prim_Op_Address);
pragma Inline (CPP_Set_Inheritance_Depth);
pragma Inline (CPP_Get_Inheritance_Depth);
pragma Inline (CPP_Set_TSD); pragma Inline (CPP_Set_TSD);
pragma Inline (CPP_Get_TSD); pragma Inline (CPP_Get_TSD);
pragma Inline (CPP_Inherit_DT); pragma Inline (CPP_Inherit_DT);
...@@ -213,7 +196,6 @@ private ...@@ -213,7 +196,6 @@ private
pragma Inline (CPP_Set_External_Tag); pragma Inline (CPP_Set_External_Tag);
pragma Inline (CPP_Get_External_Tag); pragma Inline (CPP_Get_External_Tag);
pragma Inline (CPP_Set_Expanded_Name); pragma Inline (CPP_Set_Expanded_Name);
pragma Inline (CPP_Get_Expanded_Name);
pragma Inline (CPP_Set_Remotely_Callable); pragma Inline (CPP_Set_Remotely_Callable);
pragma Inline (CPP_Get_Remotely_Callable); pragma Inline (CPP_Get_Remotely_Callable);
pragma Inline (Displaced_This); pragma Inline (Displaced_This);
......
gcc/ada/rtsfind.ads
...@@ -488,7 +488,6 @@ package Rtsfind is ...@@ -488,7 +488,6 @@ package Rtsfind is
RE_DT_Entry_Size, -- Ada.Tags RE_DT_Entry_Size, -- Ada.Tags
RE_DT_Prologue_Size, -- Ada.Tags RE_DT_Prologue_Size, -- Ada.Tags
RE_External_Tag, -- Ada.Tags RE_External_Tag, -- Ada.Tags
RE_Get_Expanded_Name, -- Ada.Tags
RE_Get_External_Tag, -- Ada.Tags RE_Get_External_Tag, -- Ada.Tags
RE_Get_Prim_Op_Address, -- Ada.Tags RE_Get_Prim_Op_Address, -- Ada.Tags
RE_Get_RC_Offset, -- Ada.Tags RE_Get_RC_Offset, -- Ada.Tags
...@@ -536,7 +535,6 @@ package Rtsfind is ...@@ -536,7 +535,6 @@ package Rtsfind is
RE_CPP_CW_Membership, -- Interfaces.CPP RE_CPP_CW_Membership, -- Interfaces.CPP
RE_CPP_DT_Entry_Size, -- Interfaces.CPP RE_CPP_DT_Entry_Size, -- Interfaces.CPP
RE_CPP_DT_Prologue_Size, -- Interfaces.CPP RE_CPP_DT_Prologue_Size, -- Interfaces.CPP
RE_CPP_Get_Expanded_Name, -- Interfaces.CPP
RE_CPP_Get_External_Tag, -- Interfaces.CPP RE_CPP_Get_External_Tag, -- Interfaces.CPP
RE_CPP_Get_Prim_Op_Address, -- Interfaces.CPP RE_CPP_Get_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Get_RC_Offset, -- Interfaces.CPP RE_CPP_Get_RC_Offset, -- Interfaces.CPP
...@@ -1590,7 +1588,6 @@ package Rtsfind is ...@@ -1590,7 +1588,6 @@ package Rtsfind is
RE_DT_Entry_Size => Ada_Tags, RE_DT_Entry_Size => Ada_Tags,
RE_DT_Prologue_Size => Ada_Tags, RE_DT_Prologue_Size => Ada_Tags,
RE_External_Tag => Ada_Tags, RE_External_Tag => Ada_Tags,
RE_Get_Expanded_Name => Ada_Tags,
RE_Get_External_Tag => Ada_Tags, RE_Get_External_Tag => Ada_Tags,
RE_Get_Prim_Op_Address => Ada_Tags, RE_Get_Prim_Op_Address => Ada_Tags,
RE_Get_RC_Offset => Ada_Tags, RE_Get_RC_Offset => Ada_Tags,
...@@ -1636,7 +1633,6 @@ package Rtsfind is ...@@ -1636,7 +1633,6 @@ package Rtsfind is
RE_CPP_CW_Membership => Interfaces_CPP, RE_CPP_CW_Membership => Interfaces_CPP,
RE_CPP_DT_Entry_Size => Interfaces_CPP, RE_CPP_DT_Entry_Size => Interfaces_CPP,
RE_CPP_DT_Prologue_Size => Interfaces_CPP, RE_CPP_DT_Prologue_Size => Interfaces_CPP,
RE_CPP_Get_Expanded_Name => Interfaces_CPP,
RE_CPP_Get_External_Tag => Interfaces_CPP, RE_CPP_Get_External_Tag => Interfaces_CPP,
RE_CPP_Get_Prim_Op_Address => Interfaces_CPP, RE_CPP_Get_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Get_RC_Offset => Interfaces_CPP, RE_CPP_Get_RC_Offset => Interfaces_CPP,
......
gcc/ada/tbuild.adb
...@@ -178,35 +178,6 @@ package body Tbuild is ...@@ -178,35 +178,6 @@ package body Tbuild is
New_Reference_To (First_Tag_Component (Full_Type), Loc))); New_Reference_To (First_Tag_Component (Full_Type), Loc)));
end Make_DT_Access; end Make_DT_Access;
-----------------------
-- Make_DT_Component --
-----------------------
function Make_DT_Component
(Loc : Source_Ptr;
Typ : Entity_Id;
N : Positive) return Node_Id
is
X : Node_Id;
Full_Type : Entity_Id := Typ;
begin
if Is_Private_Type (Typ) then
Full_Type := Underlying_Type (Typ);
end if;
X :=
First_Component
(Designated_Type
(Etype (Node (First_Elmt (Access_Disp_Table (Full_Type))))));
for J in 2 .. N loop
X := Next_Component (X);
end loop;
return New_Reference_To (X, Loc);
end Make_DT_Component;
-------------------------------- --------------------------------
-- Make_Implicit_If_Statement -- -- Make_Implicit_If_Statement --
-------------------------------- --------------------------------
......
gcc/ada/tbuild.ads
...@@ -69,20 +69,6 @@ package Tbuild is ...@@ -69,20 +69,6 @@ package Tbuild is
-- Must_Be_Byte_Aligned is set in the attribute reference node. The -- Must_Be_Byte_Aligned is set in the attribute reference node. The
-- Attribute_Name must be Name_Address or Name_Unrestricted_Access. -- Attribute_Name must be Name_Address or Name_Unrestricted_Access.
function Make_DT_Component
(Loc : Source_Ptr;
Typ : Entity_Id;
N : Positive) return Node_Id;
-- Gives a reference to the Nth component of the Dispatch Table of
-- a given Tagged Type.
--
-- N = 1 --> Inheritance_Depth
-- N = 2 --> Tags (array of ancestors)
-- N = 3, 4 --> predefined primitive
-- function _Size (X : Typ) return Long_Long_Integer;
-- function _Equality (X : Typ; Y : Typ'Class) return Boolean;
-- N >= 5 --> User-Defined Primitive Operations
function Make_DT_Access function Make_DT_Access
(Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id; (Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id;
-- Create an access to the Dispatch Table by using the Tag field -- Create an access to the Dispatch Table by using the Tag field
......
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