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

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

gcc/ada/a-tags.adb

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

gcc/ada/a-tags.ads

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

gcc/ada/exp_disp.adb

@@ -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_TSD :=
-           Unchecked_Convert_To (RTE (RE_Address),
+         Old_Tag2 :=
+           Unchecked_Convert_To (Generalized_Tag,
              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);

gcc/ada/exp_disp.ads

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

gcc/ada/i-cpp.adb

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

gcc/ada/i-cpp.ads

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

gcc/ada/rtsfind.ads

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