2007-04-06 Javier Miranda <miranda@adacore.com>

	* a-tags.ads, a-tags.adb (Object_Specific_Data): Remove
	component Num_Prim_Ops.
	(Set_Num_Prim_Ops): Removed.
	Remove all the assertions because all the routines of this
	package are inline always.
	(Get_Offset_Index): Add support to primary dispatch tables.
	Move the documentation about the dispatch table to a-tags.ads
	(Set_External_Tag): Removed
	(Inherit_TSD): Removed.
	(Interface_Data_Element, Interfaces_Array, Interface_Data): Declarations
	moved to a-tags.ads
	(Displace, IW_Membership, Inherit_TSD, Interface_Ancestor_Tags,
	Register_Interface_Tag, Set_Offset_To_Top): Update all the occurrences
	of the TSD field "Table" because this field has been renamed to
	"Ifaces_Table".
	(Inherit_CPP_DT): Removed.
	(K_Typeinfo, K_Offset_To_Top, K_Tagged_Kind, K_Signature,
	Cstring, Tag_Table, Type_Specific_Data, Dispatch_Table): These
	declarations have been moved to a-tags.ads
	(Check_Size): Removed.
	(Expanded_Name): Updated to get access to the new field of TSD
	containing the address of the expanded name.
	(Get_Access_Level/Set_Access_Level): Removed.
	(Get_Predefined_Prim_Op_Address): Removed.
	(Set_Predefined_Prim_Op_Address): Removed.
	(Get_Prim_Op_Address/Set_Prim_Op_Address): Removed.
	(Get_Remotely_Callable/Set_Remotely_Callable): Removed.
	(Set_Expanded_Name): Removed.
	(Inherit_DT): Removed.
	(Inherit_CPP_DT): Removed.
	(Set_RC_Offset): Removed.
	(Set_TSD): Removed.
	(Base_Address): New function that displaces "this" to point to the base
	of the object (that is, to point to the primary tag of the object).



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123550 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 307 insertions, 226 deletions

diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads
index 24fedab7ff8..bc39cd509e2 100644
--- a/gcc/ada/a-tags.ads
+++ b/gcc/ada/a-tags.ads
@@ -81,40 +81,213 @@ package Ada.Tags is
    Tag_Error : exception;
 
 private
-   --  The following subprogram specifications are placed here instead of
-   --  the package body to see them from the frontend through rtsfind.
-
-   ---------------------------------------------------------------
-   -- Abstract Procedural Interface For The GNAT Dispatch Table --
-   ---------------------------------------------------------------
-
-   --  GNAT's Dispatch Table format is customizable in order to match the
-   --  format used in another language. GNAT supports programs that use two
-   --  different dispatch table formats at the same time: the native format
-   --  that supports Ada 95 tagged types and which is described in Ada.Tags,
-   --  and a foreign format for types that are imported from some other
-   --  language (typically C++) which is described in Interfaces.CPP. The
-   --  runtime information kept for each tagged type is separated into two
+   --  Structure of the GNAT Primary Dispatch Table
+
+   --           +--------------------+
+   --           |      table of      |
+   --           :predefined primitive:
+   --           |    ops pointers    |
+   --           +--------------------+
+   --           |      Signature     |
+   --           +--------------------+
+   --           |     Tagged_Kind    |
+   --           +--------------------+
+   --           |    Offset_To_Top   |
+   --           +--------------------+
+   --           |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data
+   --  Tag ---> +--------------------+   +-------------------+
+   --           |      table of      |   | inheritance depth |
+   --           :   primitive ops    :   +-------------------+
+   --           |      pointers      |   |   access level    |
+   --           +--------------------+   +-------------------+
+   --                                    |   expanded name   |
+   --                                    +-------------------+
+   --                                    |   external tag    |
+   --                                    +-------------------+
+   --                                    |   hash table link |
+   --                                    +-------------------+
+   --                                    | remotely callable |
+   --                                    +-------------------+
+   --                                    | rec ctrler offset |
+   --                                    +-------------------+
+   --                                    |   num prim ops    |
+   --                                    +-------------------+
+   --                                    |  Ifaces_Table_Ptr --> Interface Data
+   --                                    +-------------------+   +------------+
+   --         Select Specific Data  <----     SSD_Ptr        |   |  table     |
+   --         +------------------+       +-------------------+   :    of      :
+   --         |table of primitive|       | table of          |   | interfaces |
+   --         :   operation      :       :    ancestor       :   +------------+
+   --         |      kinds       |       |       tags        |
+   --         +------------------+       +-------------------+
+   --         |table of          |
+   --         :   entry          :
+   --         |      indices     |
+   --         +------------------+
+
+   --  Structure of the GNAT Secondary Dispatch Table
+
+   --           +-----------------------+
+   --           |       table of        |
+   --           :  predefined primitive :
+   --           |     ops pointers      |
+   --           +-----------------------+
+   --           |       Signature       |
+   --           +-----------------------+
+   --           |      Tagged_Kind      |
+   --           +-----------------------+
+   --           |     Offset_To_Top     |
+   --           +-----------------------+
+   --           |        OSD_Ptr        |---> Object Specific Data
+   --  Tag ---> +-----------------------+      +---------------+
+   --           |        table of       |      | num prim ops  |
+   --           :      primitive op     :      +---------------+
+   --           |     thunk pointers    |      | table of      |
+   --           +-----------------------+      +   primitive   |
+   --                                          |    op offsets |
+   --                                          +---------------+
+
+   --  The runtime information kept for each tagged type is separated into two
    --  objects: the Dispatch Table and the Type Specific Data record. These
    --  two objects are allocated statically using the constants:
 
    --      DT Size  = DT_Prologue_Size  + Nb_Prim * DT_Entry_Size
-   --      TSD Size = TSD_Prologue_Size + (1 + Idepth)  * TSD_Entry_Size
 
    --  where Nb_prim is the number of primitive operations of the given
    --  type and Idepth its inheritance depth.
 
-   --  In order to set or retrieve information from the Dispatch Table or
-   --  the Type Specific Data record, GNAT generates calls to Set_XXX or
-   --  Get_XXX routines, where XXX is the name of the field of interest.
+   type Address_Array is array (Natural range <>) of System.Address;
+   pragma Suppress (Index_Check, On => Address_Array);
+   --  The reason we suppress index checks is that in the dispatch table,
+   --  the component of this type is declared with a dummy size of 1, the
+   --  actual size depending on the number of primitive operations.
+
+   type Dispatch_Table is record
+
+      --  According to the C++ ABI the components Offset_To_Top and
+      --  Typeinfo_Ptr are stored just "before" the dispatch table (that is,
+      --  the Prims_Ptr table), and they are referenced with negative offsets
+      --  referring to the base of the dispatch table. The _Tag (or the
+      --  VTable_Ptr in C++ terminology) must point to the base of the virtual
+      --  table, just after these components, to point to the Prims_Ptr table.
+      --  For this purpose the expander generates a Prims_Ptr table that has
+      --  enough space for these additional components, and generates code that
+      --  displaces the _Tag to point after these components.
+
+      --  Signature     : Signature_Kind;
+      --  Tagged_Kind   : Tagged_Kind;
+      --  Offset_To_Top : Natural;
+      --  Typeinfo_Ptr  : System.Address;
+
+      Prims_Ptr : Address_Array (1 .. 1);
+      --  The size of the Prims_Ptr array actually depends on the tagged type
+      --  to which it applies. For each tagged type, the expander computes the
+      --  actual array size, allocates the Dispatch_Table record accordingly,
+      --  and generates code that displaces the base of the record after the
+      --  Typeinfo_Ptr component. For this reason the first two components have
+      --  been commented in the previous declaration. The access to these
+      --  components is done by means of local functions.
+      --
+      --  To avoid the use of discriminants to define the actual size of the
+      --  dispatch table, we used to declare the tag as a pointer to a record
+      --  that contains an arbitrary array of addresses, using Positive as its
+      --  index. This ensures that there are never range checks when accessing
+      --  the dispatch table, but it prevents GDB from displaying tagged types
+      --  properly. A better approach is to declare this record type as holding
+      --  small number of addresses, and to explicitly suppress checks on it.
+      --
+      --  Note that in both cases, this type is never allocated, and serves
+      --  only to declare the corresponding access type.
+   end record;
+
+   subtype Cstring is String (Positive);
+   type Cstring_Ptr is access all Cstring;
+   pragma No_Strict_Aliasing (Cstring_Ptr);
+
+   --  We suppress index checks because the declared size in the record below
+   --  is a dummy size of one (see below).
+
+   type Tag_Table is array (Natural range <>) of Tag;
+   pragma Suppress_Initialization (Tag_Table);
+   pragma Suppress (Index_Check, On => Tag_Table);
+
+   package SSE renames System.Storage_Elements;
+
+   --  Type specific data types
+
+   type Type_Specific_Data (Idepth : Natural) is record
+      --  Inheritance Depth Level: Used to implement the membership test
+      --  associated with single inheritance of tagged types in constant-time.
+      --  It also indicates the size of the Tags_Table component.
+
+      Access_Level : Natural;
+      --  Accessibility level required to give support to Ada 2005 nested type
+      --  extensions. This feature allows safe nested type extensions by
+      --  shifting the accessibility checks to certain operations, rather than
+      --  being enforced at the type declaration. In particular, by performing
+      --  run-time accessibility checks on class-wide allocators, class-wide
+      --  function return, and class-wide stream I/O, the danger of objects
+      --  outliving their type declaration can be eliminated (Ada 2005: AI-344)
+
+      Expanded_Name : Cstring_Ptr;
+      External_Tag  : Cstring_Ptr;
+      HT_Link       : Tag;
+      --  Components used to support to the Ada.Tags subprograms in RM 3.9.
+      --  Note: Expanded_Name is referenced by GDB ???
+
+      Remotely_Callable : Boolean;
+      --  Used to check ARM E.4 (18)
+
+      RC_Offset : SSE.Storage_Offset;
+      --  Controller Offset: Used to give support to tagged controlled objects
+      --  (see Get_Deep_Controller at s-finimp)
+
+      Ifaces_Table_Ptr : System.Address;
+      --  Pointer to the table of interface tags. It is used to implement the
+      --  membership test associated with interfaces and also for backward
+      --  abstract interface type conversions (Ada 2005:AI-251)
+
+      SSD_Ptr : System.Address;
+      --  Pointer to a table of records used in dispatching selects. This
+      --  field has a meaningful value for all tagged types that implement
+      --  a limited, protected, synchronized or task interfaces and have
+      --  non-predefined primitive operations.
+
+      Tags_Table : Tag_Table (0 .. Idepth);
+      --  Table of ancestor tags. Its size actually depends on the inheritance
+      --  depth level of the tagged type.
+   end record;
+
+   --  Declarations for the table of interfaces
+
+   type Interface_Data_Element is record
+      Iface_Tag            : Tag;
+      Static_Offset_To_Top : Boolean;
+      Offset_To_Top_Value  : System.Storage_Elements.Storage_Offset;
+      Offset_To_Top_Func   : System.Address;
+   end record;
+   --  If some ancestor of the tagged type has discriminants the field
+   --  Static_Offset_To_Top is False and the field Offset_To_Top_Func
+   --  is used to store the address of the function generated by the
+   --  expander which provides this value; otherwise Static_Offset_To_Top
+   --  is True and such value is stored in the Offset_To_Top_Value field.
+
+   type Interfaces_Array is
+     array (Natural range <>) of Interface_Data_Element;
+
+   type Interface_Data (Nb_Ifaces : Positive) is record
+      Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
+   end record;
+
+   --  Declaration of tag types
 
-   type Dispatch_Table;
    type Tag is access all Dispatch_Table;
+   type Tag_Ptr is access Tag;
    type Interface_Tag is access all Dispatch_Table;
+   type Type_Specific_Data_Ptr is access all Type_Specific_Data;
 
    No_Tag : constant Tag := null;
 
-   type Interface_Data (Nb_Ifaces : Positive);
    type Interface_Data_Ptr is access all Interface_Data;
    --  Table of abstract interfaces used to give support to backward interface
    --  conversions and also to IW_Membership.
@@ -132,9 +305,6 @@ private
    --  type. This construct is used in the handling of dispatching triggers
    --  in select statements.
 
-   type Type_Specific_Data;
-   type Type_Specific_Data_Ptr is access all Type_Specific_Data;
-
    --  Primitive operation kinds. These values differentiate the kinds of
    --  callable entities stored in the dispatch table. Certain kinds may
    --  not be used, but are added for completeness.
@@ -162,8 +332,7 @@ private
    type Tagged_Kind_Ptr is access all Tagged_Kind;
 
    Default_Prim_Op_Count : constant Positive := 15;
-   --  Number of predefined primitive operations added by the Expander for a
-   --  tagged type (must match Exp_Disp.Default_Prim_Op_Count).
+   --  Maximum number of predefined primitive operations of a tagged type.
 
    type Signature_Kind is
       (Unknown,
@@ -183,68 +352,101 @@ private
    --  range Primary_DT .. Abstract_Interface. The Unknown value is used by
    --  the Check_XXX routines to indicate that the signature is wrong.
 
-   package SSE renames System.Storage_Elements;
+   DT_Min_Prologue_Size : constant SSE.Storage_Count :=
+                            SSE.Storage_Count
+                              (2 * (Standard'Address_Size /
+                                      System.Storage_Unit));
+   --  Size of the hidden part of the dispatch table used when the program
+   --  is compiled under restriction No_Dispatching_Calls. It contains the
+   --  pointer to the TSD record plus a dummy entry whose address is used
+   --  at run-time as the Tag.
+
+   DT_Prologue_Size : constant SSE.Storage_Count :=
+                        SSE.Storage_Count
+                          ((Default_Prim_Op_Count + 4) *
+                            (Standard'Address_Size / System.Storage_Unit));
+   --  Size of the hidden part of the dispatch table. It contains the table of
+   --  predefined primitive operations plus the C++ ABI header.
+
+   DT_Signature_Size : constant SSE.Storage_Count :=
+                         SSE.Storage_Count
+                           (1 * (Standard'Address_Size / System.Storage_Unit));
+   --  Size of the Signature field of the dispatch table
+
+   DT_Tagged_Kind_Size : constant SSE.Storage_Count :=
+     SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit));
+   --  Size of the Tagged_Type_Kind field of the dispatch table
+
+   DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
+                             SSE.Storage_Count
+                               (1 * (Standard'Address_Size /
+                                       System.Storage_Unit));
+   --  Size of the Offset_To_Top field of the Dispatch Table
+
+   DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
+                            SSE.Storage_Count
+                              (1 * (Standard'Address_Size /
+                                      System.Storage_Unit));
+   --  Size of the Typeinfo_Ptr field of the Dispatch Table
+
+   DT_Entry_Size : constant SSE.Storage_Count :=
+                     SSE.Storage_Count
+                       (1 * (Standard'Address_Size / System.Storage_Unit));
+   --  Size of each primitive operation entry in the Dispatch Table
+
+   Tag_Size : constant SSE.Storage_Count :=
+     SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit));
+   --  Size of each tag
+
+   --  Constants used by the code generated by the frontend to get access
+   --  to the header of the dispatch table.
+
+   K_Typeinfo      : constant SSE.Storage_Count := DT_Typeinfo_Ptr_Size;
+   K_Offset_To_Top : constant SSE.Storage_Count :=
+                       System.Storage_Elements."+"
+                         (K_Typeinfo, DT_Offset_To_Top_Size);
+   K_Tagged_Kind   : constant SSE.Storage_Count :=
+                       System.Storage_Elements."+"
+                         (K_Offset_To_Top, DT_Tagged_Kind_Size);
+   K_Signature     : constant SSE.Storage_Count :=
+                       System.Storage_Elements."+"
+                         (K_Tagged_Kind, DT_Signature_Size);
+
+   --  The following subprogram specifications are placed here instead of
+   --  the package body to see them from the frontend through rtsfind.
+
+   function Base_Address (This : System.Address) return System.Address;
+   --  Ada 2005 (AI-251): Displace "This" to point to the base address of
+   --  the object (that is, the address of the primary tag of the object).
 
    function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean;
    --  Given the tag of an object and the tag associated to a type, return
    --  true if Obj is in Typ'Class.
 
-   function IW_Membership (This : System.Address; T : Tag) return Boolean;
-   --  Ada 2005 (AI-251): General routine that checks if a given object
-   --  implements a tagged type. Its common usage is to check if Obj is in
-   --  Iface'Class, but it is also used to check if a class-wide interface
-   --  implements a given type (Iface_CW_Typ in T'Class). For example:
-   --
-   --      type I is interface;
-   --      type T is tagged ...
-   --
-   --      function Test (O : I'Class) is
-   --      begin
-   --         return O in T'Class.
-   --      end Test;
-
    function Displace (This : System.Address; T : Tag) return System.Address;
-   --  (Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
+   --  Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
    --  table of T.
 
-   function Get_Access_Level (T : Tag) return Natural;
-   --  Given the tag associated with a type, returns the accessibility level
-   --  of the type.
-
    function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
-   --  Return a primitive operation's entry index (if entry) given a dispatch
-   --  table T and a position of a primitive operation in T.
+   --  Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
+   --  given a dispatch table T and a position of a primitive operation in T.
 
    function Get_External_Tag (T : Tag) return System.Address;
-   --  Retrieve the address of a null terminated string containing
-   --  the external name.
+   --  Returns address of a null terminated string containing the external name
 
    function Get_Offset_Index
      (T        : Tag;
       Position : Positive) return Positive;
-   --  Given a pointer to a secondary dispatch table (T) and a position of an
-   --  operation in the DT, retrieve the corresponding operation's position in
-   --  the primary dispatch table from the Offset Specific Data table of T.
-
-   function Get_Predefined_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive) return System.Address;
-   --  Given a pointer to a dispatch table (T) and a position in the DT
-   --  this function returns the address of the virtual function stored
-   --  in it (used for dispatching calls).
-
-   function Get_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive) return System.Address;
-   --  Given a pointer to a dispatch table (T) and a position in the DT
-   --  this function returns the address of the virtual function stored
-   --  in it (used for dispatching calls).
+   --  Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and
+   --  a position of an operation in the DT, retrieve the corresponding
+   --  operation's position in the primary dispatch table from the Offset
+   --  Specific Data table of T.
 
    function Get_Prim_Op_Kind
      (T        : Tag;
       Position : Positive) return Prim_Op_Kind;
-   --  Return a primitive operation's kind given a dispatch table T and a
-   --  position of a primitive operation in T.
+   --  Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
+   --  table T and a position of a primitive operation in T.
 
    function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
    --  Return the Offset of the implicit record controller when the object
@@ -255,37 +457,35 @@ private
    --  it is exported manually in order to avoid changing completely the
    --  organization of the run time.
 
-   function Get_Remotely_Callable (T : Tag) return Boolean;
-   --  Return the value previously set by Set_Remotely_Callable
-
    function Get_Tagged_Kind (T : Tag) return Tagged_Kind;
-   --  Given a pointer to either a primary or a secondary dispatch table,
-   --  return the tagged kind of a type in the context of concurrency and
-   --  limitedness.
-
-   procedure Inherit_CPP_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural);
-   --  Entry point used to initialize the DT of a type knowing the tag
-   --  of the direct CPP ancestor and the number of primitive ops that
-   --  are inherited (Entry_Count).
-
-   procedure Inherit_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural);
-   --  Entry point used to initialize the DT of a type knowing the tag
-   --  of the direct ancestor and the number of primitive ops that are
-   --  inherited (Entry_Count).
+   --  Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
+   --  dispatch table, return the tagged kind of a type in the context of
+   --  concurrency and limitedness.
 
-   procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag);
-   --  Initialize the TSD of a type knowing the tag of the direct ancestor
+   function IW_Membership (This : System.Address; T : Tag) return Boolean;
+   --  Ada 2005 (AI-251): General routine that checks if a given object
+   --  implements a tagged type. Its common usage is to check if Obj is in
+   --  Iface'Class, but it is also used to check if a class-wide interface
+   --  implements a given type (Iface_CW_Typ in T'Class). For example:
+   --
+   --      type I is interface;
+   --      type T is tagged ...
+   --
+   --      function Test (O : I'Class) is
+   --      begin
+   --         return O in T'Class.
+   --      end Test;
 
    function Offset_To_Top
      (This : System.Address) return System.Storage_Elements.Storage_Offset;
-   --  Returns the current value of the offset_to_top component available in
-   --  the prologue of the dispatch table. If the parent of the tagged type
-   --  has discriminants this value is stored in a record component just
-   --  immediately after the tag component.
+   --  Ada 2005 (AI-251): Returns the current value of the offset_to_top
+   --  component available in the prologue of the dispatch table. If the parent
+   --  of the tagged type has discriminants this value is stored in a record
+   --  component just immediately after the tag component.
 
    function OSD (T : Tag) return Object_Specific_Data_Ptr;
    --  Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table,
-   --  retrieve the address of the record containing the Objet Specific
+   --  retrieve the address of the record containing the Object Specific
    --  Data table.
 
    function Parent_Size
@@ -311,36 +511,20 @@ private
    --  Insert the Tag and its associated external_tag in a table for the
    --  sake of Internal_Tag
 
-   procedure Set_Access_Level (T : Tag; Value : Natural);
-   --  Sets the accessibility level of the tagged type associated with T
-   --  in its TSD.
-
    procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
-   --  Set the entry index of a primitive operation in T's TSD table indexed
-   --  by Position.
-
-   procedure Set_Expanded_Name (T : Tag; Value : System.Address);
-   --  Set the address of the string containing the expanded name
-   --  in the Dispatch table.
-
-   procedure Set_External_Tag (T : Tag; Value : System.Address);
-   --  Set the address of the string containing the external tag
-   --  in the Dispatch table.
+   --  Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
+   --  TSD table indexed by Position.
 
    procedure Set_Interface_Table (T : Tag; Value : System.Address);
    --  Ada 2005 (AI-251): Given a pointer T to a dispatch Table, stores the
    --  pointer to the table of interfaces.
 
-   procedure Set_Num_Prim_Ops (T : Tag; Value : Natural);
-   --  Set the number of primitive operations in the dispatch table of T. This
-   --  is used for debugging purposes.
-
    procedure Set_Offset_Index
      (T        : Tag;
       Position : Positive;
       Value    : Positive);
-   --  Set the offset value of a primitive operation in a secondary dispatch
-   --  table denoted by T, indexed by Position.
+   --  Ada 2005 (AI-345): Set the offset value of a primitive operation in a
+   --  secondary dispatch table denoted by T, indexed by Position.
 
    procedure Set_Offset_To_Top
      (This         : System.Address;
@@ -358,121 +542,40 @@ private
    --  secondary dispatch table.
 
    procedure Set_OSD (T : Tag; Value : System.Address);
-   --  Given a pointer T to a secondary dispatch table, store the pointer to
-   --  the record containing the Object Specific Data generated by GNAT.
-
-   procedure Set_Predefined_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive;
-      Value    : System.Address);
-   --  Given a pointer to a dispatch Table (T) and a position in the dispatch
-   --  table associated with a predefined primitive operation, put the address
-   --  of the virtual function in it (used for overriding).
-
-   procedure Set_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive;
-      Value    : System.Address);
-   --  Given a pointer to a dispatch Table (T) and a position in the dispatch
-   --  Table put the address of the virtual function in it (used for
-   --  overriding).
+   --  Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table,
+   --  store the pointer to the record containing the Object Specific Data
+   --  generated by GNAT.
 
    procedure Set_Prim_Op_Kind
      (T        : Tag;
       Position : Positive;
       Value    : Prim_Op_Kind);
-   --  Set the kind of a primitive operation in T's TSD table indexed by
-   --  Position.
-
-   procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset);
-   --  Sets the Offset of the implicit record controller when the object
-   --  has controlled components. Set to O otherwise.
-
-   procedure Set_Remotely_Callable (T : Tag; Value : Boolean);
-   --  Set to true if the type has been declared in a context described
-   --  in E.4 (18).
+   --  Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
+   --  table indexed by Position.
 
    procedure Set_Signature (T : Tag; Value : Signature_Kind);
    --  Given a pointer T to a dispatch table, store the signature id
 
    procedure Set_SSD (T : Tag; Value : System.Address);
-   --  Given a pointer T to a dispatch Table, stores the pointer to the record
-   --  containing the Select Specific Data generated by GNAT.
+   --  Ada 2005 (AI-345): Given a pointer T to a dispatch Table, stores the
+   --  pointer to the record containing the Select Specific Data generated by
+   --  GNAT.
 
    procedure Set_Tagged_Kind (T : Tag; Value : Tagged_Kind);
-   --  Set the tagged kind of a type in either a primary or a secondary
-   --  dispatch table denoted by T.
-
-   procedure Set_TSD (T : Tag; Value : System.Address);
-   --  Given a pointer T to a dispatch Table, stores the address of the record
-   --  containing the Type Specific Data generated by GNAT.
+   --  Ada 2005 (AI-345): Set the tagged kind of a type in either a primary or
+   --  a secondary dispatch table denoted by T.
 
    function SSD (T : Tag) return Select_Specific_Data_Ptr;
-   --  Given a pointer T to a dispatch Table, retrieves the address of the
-   --  record containing the Select Specific Data in T's TSD.
+   --  Ada 2005 (AI-251): Given a pointer T to a dispatch Table, retrieves the
+   --  address of the record containing the Select Specific Data in T's TSD.
 
    function TSD (T : Tag) return Type_Specific_Data_Ptr;
    --  Given a pointer T to a dispatch Table, retrieves the address of the
    --  record containing the Type Specific Data generated by GNAT.
 
-   DT_Prologue_Size : constant SSE.Storage_Count :=
-                        SSE.Storage_Count
-                          ((Default_Prim_Op_Count + 4) *
-                            (Standard'Address_Size / System.Storage_Unit));
-   --  Size of the hidden part of the dispatch table. It contains the table of
-   --  predefined primitive operations plus the C++ ABI header.
-
-   DT_Signature_Size : constant SSE.Storage_Count :=
-                         SSE.Storage_Count
-                           (1 * (Standard'Address_Size / System.Storage_Unit));
-   --  Size of the Signature field of the dispatch table
-
-   DT_Tagged_Kind_Size : constant SSE.Storage_Count :=
-     SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit));
-   --  Size of the Tagged_Type_Kind field of the dispatch table
-
-   DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
-                             SSE.Storage_Count
-                               (1 * (Standard'Address_Size /
-                                       System.Storage_Unit));
-   --  Size of the Offset_To_Top field of the Dispatch Table
-
-   DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
-                            SSE.Storage_Count
-                              (1 * (Standard'Address_Size /
-                                      System.Storage_Unit));
-   --  Size of the Typeinfo_Ptr field of the Dispatch Table
-
-   DT_Entry_Size : constant SSE.Storage_Count :=
-                     SSE.Storage_Count
-                       (1 * (Standard'Address_Size / System.Storage_Unit));
-   --  Size of each primitive operation entry in the Dispatch Table
-
-   Tag_Size : constant SSE.Storage_Count :=
-     SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit));
-   --  Size of each tag
-
-   TSD_Prologue_Size : constant SSE.Storage_Count :=
-                         SSE.Storage_Count
-                           (10 * (Standard'Address_Size /
-                                   System.Storage_Unit));
-   --  Size of the first part of the type specific data
-
-   TSD_Entry_Size : constant SSE.Storage_Count :=
-                      SSE.Storage_Count
-                        (1 * (Standard'Address_Size / System.Storage_Unit));
-   --  Size of each ancestor tag entry in the TSD
-
-   type Address_Array is array (Natural range <>) of System.Address;
-   pragma Suppress (Index_Check, On => Address_Array);
-   --  The reason we suppress index checks is that in the body, objects
-   --  of this type are declared with a dummy size of 1, the actual size
-   --  depending on the number of primitive operations.
-
    --  Unchecked Conversions
 
    type Addr_Ptr is access System.Address;
-   type Tag_Ptr  is access Tag;
 
    type Signature_Values is
       array (1 .. DT_Signature_Size) of Signature_Kind;
@@ -487,14 +590,8 @@ private
      new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
 
    function To_Address is
-     new Unchecked_Conversion (Interface_Tag, System.Address);
-
-   function To_Address is
      new Unchecked_Conversion (Tag, System.Address);
 
-   function To_Address is
-     new Unchecked_Conversion (Type_Specific_Data_Ptr, System.Address);
-
    function To_Interface_Data_Ptr is
      new Unchecked_Conversion (System.Address, Interface_Data_Ptr);
 
@@ -527,37 +624,21 @@ private
    pragma Inline_Always (CW_Membership);
    pragma Inline_Always (Displace);
    pragma Inline_Always (IW_Membership);
-   pragma Inline_Always (Get_Access_Level);
    pragma Inline_Always (Get_Entry_Index);
    pragma Inline_Always (Get_Offset_Index);
-   pragma Inline_Always (Get_Predefined_Prim_Op_Address);
-   pragma Inline_Always (Get_Prim_Op_Address);
    pragma Inline_Always (Get_Prim_Op_Kind);
-   pragma Inline_Always (Get_RC_Offset);
-   pragma Inline_Always (Get_Remotely_Callable);
    pragma Inline_Always (Get_Tagged_Kind);
-   pragma Inline_Always (Inherit_DT);
-   pragma Inline_Always (Inherit_TSD);
    pragma Inline_Always (OSD);
    pragma Inline_Always (Register_Interface_Tag);
    pragma Inline_Always (Register_Tag);
-   pragma Inline_Always (Set_Access_Level);
    pragma Inline_Always (Set_Entry_Index);
-   pragma Inline_Always (Set_Expanded_Name);
-   pragma Inline_Always (Set_External_Tag);
    pragma Inline_Always (Set_Interface_Table);
-   pragma Inline_Always (Set_Num_Prim_Ops);
    pragma Inline_Always (Set_Offset_Index);
    pragma Inline_Always (Set_Offset_To_Top);
-   pragma Inline_Always (Set_Predefined_Prim_Op_Address);
-   pragma Inline_Always (Set_Prim_Op_Address);
    pragma Inline_Always (Set_Prim_Op_Kind);
-   pragma Inline_Always (Set_RC_Offset);
-   pragma Inline_Always (Set_Remotely_Callable);
    pragma Inline_Always (Set_Signature);
    pragma Inline_Always (Set_OSD);
    pragma Inline_Always (Set_SSD);
-   pragma Inline_Always (Set_TSD);
    pragma Inline_Always (Set_Tagged_Kind);
    pragma Inline_Always (SSD);
    pragma Inline_Always (TSD);