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

2 files changed, 339 insertions, 955 deletions

diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index a0697e818b9..556265ac2fa 100644
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -41,185 +41,11 @@ pragma Elaborate_All (System.HTable);
 
 package body Ada.Tags is
 
---  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 |
---                                          +---------------+
-
-   ----------------------------------
-   -- GNAT Dispatch Table Prologue --
-   ----------------------------------
-
-   --  GNAT's Dispatch Table prologue contains several fields which are hidden
-   --  in order to preserve compatibility with C++. These fields are accessed
-   --  by address calculations performed in the following manner:
-
-   --     Field : Field_Type :=
-   --               (To_Address (Tag) - Sum_Of_Preceding_Field_Sizes).all;
-
-   --  The bracketed subtraction shifts the pointer (Tag) from the table of
-   --  primitive operations (or thunks) to the field in question. Since the
-   --  result of the subtraction is an address, dereferencing it will obtain
-   --  the actual value of the field.
-
-   --  Guidelines for addition of new hidden fields
-
-   --     Define a Field_Type and Field_Type_Ptr (access to Field_Type) in
-   --     A-Tags.ads for the newly introduced field.
-
-   --     Defined the size of the new field as a constant Field_Name_Size
-
-   --     Introduce an Unchecked_Conversion from System.Address to
-   --     Field_Type_Ptr in A-Tags.ads.
-
-   --     Define the specifications of Get_<Field_Name> and Set_<Field_Name>
-   --     in a-tags.ads.
-
-   --     Update the GNAT Dispatch Table structure in a-tags.adb
-
-   --     Provide bodies to the Get_<Field_Name> and Set_<Field_Name> routines.
-   --     The profile of a Get_<Field_Name> routine should resemble:
-
-   --        function Get_<Field_Name> (T : Tag; ...) return Field_Type is
-   --           Field : constant System.Address :=
-   --                     To_Address (T) - <Sum_Of_Previous_Field_Sizes>;
-   --        begin
-   --           pragma Assert (Check_Signature (T, <Applicable_DT>));
-   --           <Additional_Assertions>
-
-   --           return To_Field_Type_Ptr (Field).all;
-   --        end Get_<Field_Name>;
-
-   --     The profile of a Set_<Field_Name> routine should resemble:
-
-   --        procedure Set_<Field_Name> (T : Tag; ..., Value : Field_Type) is
-   --           Field : constant System.Address :=
-   --                     To_Address (T) - <Sum_Of_Previous_Field_Sizes>;
-   --           begin
-   --           pragma Assert (Check_Signature (T, <Applicable_DT>));
-   --           <Additional_Assertions>
-
-   --           To_Field_Type_Ptr (Field).all := Value;
-   --        end Set_<Field_Name>;
-
-   --  NOTE: For each field in the prologue which precedes the newly added
-   --  one, find and update its respective Sum_Of_Previous_Field_Sizes by
-   --  subtractind Field_Name_Size from it. Falure to do so will clobber the
-   --  previous prologue field.
-
-   K_Typeinfo      : constant SSE.Storage_Count := DT_Typeinfo_Ptr_Size;
-
-   K_Offset_To_Top : constant SSE.Storage_Count :=
-                       K_Typeinfo + DT_Offset_To_Top_Size;
-
-   K_Tagged_Kind   : constant SSE.Storage_Count :=
-                       K_Offset_To_Top + DT_Tagged_Kind_Size;
-
-   K_Signature     : constant SSE.Storage_Count :=
-                       K_Tagged_Kind + DT_Signature_Size;
-
-   subtype Cstring is String (Positive);
-   type Cstring_Ptr is access all Cstring;
-
-   --  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);
-
-   --  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
-      Table : Interfaces_Array (1 .. Nb_Ifaces);
-   end record;
-
-   --  Object specific data types
+   --  Object specific data types (see description in a-tags.ads)
 
    type Object_Specific_Data_Array is array (Positive range <>) of Positive;
 
    type Object_Specific_Data (Nb_Prim : Positive) is record
-      Num_Prim_Ops : Natural;
-      --  Number of primitive operations of the dispatch table. This field is
-      --  used by the run-time check routines that are activated when the
-      --  run-time is compiled with assertions enabled.
-
       OSD_Table : Object_Specific_Data_Array (1 .. Nb_Prim);
       --  Table used in secondary DT to reference their counterpart in the
       --  select specific data (in the TSD of the primary DT). This construct
@@ -242,112 +68,6 @@ package body Ada.Tags is
       --  NOTE: Nb_Prim is the number of non-predefined primitive operations
    end record;
 
-   --  Type specific data types
-
-   type Type_Specific_Data is record
-      Idepth : Natural;
-      --  Inheritance Depth Level: Used to implement the membership test
-      --  associated with single inheritance of tagged types in constant-time.
-      --  In addition it also indicates the size of the first table stored in
-      --  the Tags_Table component (see comment below).
-
-      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 give support to the Ada.Tags subprograms described
-      --  in ARM 3.9
-
-      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)
-
-      Num_Prim_Ops : Natural;
-      --  Number of primitive operations of the dispatch table. This field is
-      --  used for additional run-time checks when the run-time is compiled
-      --  with assertions enabled.
-
-      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 .. 1);
-      --  The size of the Tags_Table array actually depends on the tagged type
-      --  to which it applies. The compiler ensures that has enough space to
-      --  store all the entries of the two tables phisically stored there: the
-      --  "table of ancestor tags" and the "table of interface tags". For this
-      --  purpose we are using the same mechanism as for the Prims_Ptr array in
-      --  the Dispatch_Table record. See comments below on Prims_Ptr for
-      --  further details.
-   end record;
-
-   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;
-
-   type Signature_Type is
-      (Must_Be_Primary_DT,
-       Must_Be_Secondary_DT,
-       Must_Be_Primary_Or_Secondary_DT,
-       Must_Be_Interface,
-       Must_Be_Primary_Or_Interface);
-   --  Type of signature accepted by primitives in this package that are called
-   --  during the elaboration of tagged types. This type is used by the routine
-   --  Check_Signature that is called only when the run-time is compiled with
-   --  assertions enabled.
-
    ---------------------------------------------
    -- Unchecked Conversions for String Fields --
    ---------------------------------------------
@@ -388,19 +108,6 @@ package body Ada.Tags is
    -- Local Subprograms --
    -----------------------
 
-   function Check_Signature (T : Tag; Kind : Signature_Type) return Boolean;
-   --  Check that the signature of T is valid and corresponds with the subset
-   --  specified by the signature Kind.
-
-   function Check_Size
-     (Old_T       : Tag;
-      New_T       : Tag;
-      Entry_Count : Natural) return Boolean;
-   --  Verify that Old_T and New_T have at least Entry_Count entries
-
-   function Get_Num_Prim_Ops (T : Tag) return Natural;
-   --  Retrieve the number of primitive operations in the dispatch table of T
-
    function Is_Primary_DT (T : Tag) return Boolean;
    pragma Inline_Always (Is_Primary_DT);
    --  Given a tag returns True if it has the signature of a primary dispatch
@@ -512,78 +219,6 @@ package body Ada.Tags is
 
    end HTable_Subprograms;
 
-   ---------------------
-   -- Check_Signature --
-   ---------------------
-
-   function Check_Signature (T : Tag; Kind : Signature_Type) return Boolean is
-      Signature : constant Storage_Offset_Ptr :=
-                    To_Storage_Offset_Ptr (To_Address (T) - K_Signature);
-
-      Sig_Values : constant Signature_Values :=
-                     To_Signature_Values (Signature.all);
-
-      Signature_Id : Signature_Kind;
-
-   begin
-      if Sig_Values (1) /= Valid_Signature then
-         Signature_Id := Unknown;
-
-      elsif Sig_Values (2) in Primary_DT .. Abstract_Interface then
-         Signature_Id := Sig_Values (2);
-
-      else
-         Signature_Id := Unknown;
-      end if;
-
-      case Signature_Id is
-         when Primary_DT         =>
-            if Kind = Must_Be_Secondary_DT
-              or else Kind = Must_Be_Interface
-            then
-               return False;
-            end if;
-
-         when Secondary_DT       =>
-            if Kind = Must_Be_Primary_DT
-              or else Kind = Must_Be_Interface
-            then
-               return False;
-            end if;
-
-         when Abstract_Interface =>
-            if Kind = Must_Be_Primary_DT
-              or else Kind = Must_Be_Secondary_DT
-              or else Kind = Must_Be_Primary_Or_Secondary_DT
-            then
-               return False;
-            end if;
-
-         when others =>
-            return False;
-
-      end case;
-
-      return True;
-   end Check_Signature;
-
-   ----------------
-   -- Check_Size --
-   ----------------
-
-   function Check_Size
-     (Old_T       : Tag;
-      New_T       : Tag;
-      Entry_Count : Natural) return Boolean
-   is
-      Max_Entries_Old : constant Natural := Get_Num_Prim_Ops (Old_T);
-      Max_Entries_New : constant Natural := Get_Num_Prim_Ops (New_T);
-
-   begin
-      return Entry_Count <= Max_Entries_Old
-        and then Entry_Count <= Max_Entries_New;
-   end Check_Size;
-
    -------------------
    -- CW_Membership --
    -------------------
@@ -607,12 +242,19 @@ package body Ada.Tags is
    function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
       Pos : Integer;
    begin
-      pragma Assert (Check_Signature (Obj_Tag, Must_Be_Primary_DT));
-      pragma Assert (Check_Signature (Typ_Tag, Must_Be_Primary_DT));
       Pos := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
       return Pos >= 0 and then TSD (Obj_Tag).Tags_Table (Pos) = Typ_Tag;
    end CW_Membership;
 
+   ------------------
+   -- Base_Address --
+   ------------------
+
+   function Base_Address (This : System.Address) return System.Address is
+   begin
+      return This - Offset_To_Top (This);
+   end Base_Address;
+
    --------------
    -- Displace --
    --------------
@@ -621,36 +263,26 @@ package body Ada.Tags is
      (This : System.Address;
       T    : Tag) return System.Address
    is
-      Curr_DT     : constant Tag := To_Tag_Ptr (This).all;
       Iface_Table : Interface_Data_Ptr;
       Obj_Base    : System.Address;
       Obj_DT      : Tag;
       Obj_TSD     : Type_Specific_Data_Ptr;
 
    begin
-      pragma Assert
-        (Check_Signature (Curr_DT, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert
-        (Check_Signature (T, Must_Be_Interface));
-
       Obj_Base    := This - Offset_To_Top (This);
       Obj_DT      := To_Tag_Ptr (Obj_Base).all;
-
-      pragma Assert
-        (Check_Signature (Obj_DT, Must_Be_Primary_DT));
-
       Obj_TSD     := TSD (Obj_DT);
       Iface_Table := To_Interface_Data_Ptr (Obj_TSD.Ifaces_Table_Ptr);
 
       if Iface_Table /= null then
          for Id in 1 .. Iface_Table.Nb_Ifaces loop
-            if Iface_Table.Table (Id).Iface_Tag = T then
+            if Iface_Table.Ifaces_Table (Id).Iface_Tag = T then
 
                --  Case of Static value of Offset_To_Top
 
-               if Iface_Table.Table (Id).Static_Offset_To_Top then
-                  Obj_Base :=
-                    Obj_Base + Iface_Table.Table (Id).Offset_To_Top_Value;
+               if Iface_Table.Ifaces_Table (Id).Static_Offset_To_Top then
+                  Obj_Base := Obj_Base +
+                    Iface_Table.Ifaces_Table (Id).Offset_To_Top_Value;
 
                --  Otherwise we call the function generated by the expander
                --  to provide us with this value
@@ -659,15 +291,11 @@ package body Ada.Tags is
                   Obj_Base :=
                     Obj_Base +
                       To_Offset_To_Top_Function_Ptr
-                        (Iface_Table.Table (Id).Offset_To_Top_Func).all
+                        (Iface_Table.Ifaces_Table (Id).Offset_To_Top_Func).all
                           (Obj_Base);
                end if;
 
                Obj_DT := To_Tag_Ptr (Obj_Base).all;
-
-               pragma Assert
-                 (Check_Signature (Obj_DT, Must_Be_Secondary_DT));
-
                return Obj_Base;
             end if;
          end loop;
@@ -700,7 +328,6 @@ package body Ada.Tags is
    --  that are contained in the dispatch table referenced by Obj'Tag.
 
    function IW_Membership (This : System.Address; T : Tag) return Boolean is
-      Curr_DT     : constant Tag := To_Tag_Ptr (This).all;
       Iface_Table : Interface_Data_Ptr;
       Last_Id     : Natural;
       Obj_Base    : System.Address;
@@ -708,19 +335,10 @@ package body Ada.Tags is
       Obj_TSD     : Type_Specific_Data_Ptr;
 
    begin
-      pragma Assert
-        (Check_Signature (Curr_DT, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert
-        (Check_Signature (T, Must_Be_Primary_Or_Interface));
-
       Obj_Base := This - Offset_To_Top (This);
       Obj_DT   := To_Tag_Ptr (Obj_Base).all;
-
-      pragma Assert
-        (Check_Signature (Obj_DT, Must_Be_Primary_DT));
-
-      Obj_TSD := TSD (Obj_DT);
-      Last_Id := Obj_TSD.Idepth;
+      Obj_TSD  := TSD (Obj_DT);
+      Last_Id  := Obj_TSD.Idepth;
 
       --  Look for the tag in the table of interfaces
 
@@ -728,7 +346,7 @@ package body Ada.Tags is
 
       if Iface_Table /= null then
          for Id in 1 .. Iface_Table.Nb_Ifaces loop
-            if Iface_Table.Table (Id).Iface_Tag = T then
+            if Iface_Table.Ifaces_Table (Id).Iface_Tag = T then
                return True;
             end if;
          end loop;
@@ -751,13 +369,9 @@ package body Ada.Tags is
    --------------------
 
    function Descendant_Tag (External : String; Ancestor : Tag) return Tag is
-      Int_Tag : Tag;
+      Int_Tag : constant Tag := Internal_Tag (External);
 
    begin
-      pragma Assert (Check_Signature (Ancestor, Must_Be_Primary_DT));
-      Int_Tag := Internal_Tag (External);
-      pragma Assert (Check_Signature (Int_Tag, Must_Be_Primary_DT));
-
       if not Is_Descendant_At_Same_Level (Int_Tag, Ancestor) then
          raise Tag_Error;
       end if;
@@ -777,7 +391,6 @@ package body Ada.Tags is
          raise Tag_Error;
       end if;
 
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       Result := TSD (T).Expanded_Name;
       return Result (1 .. Length (Result));
    end Expanded_Name;
@@ -794,30 +407,16 @@ package body Ada.Tags is
          raise Tag_Error;
       end if;
 
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       Result := TSD (T).External_Tag;
-
       return Result (1 .. Length (Result));
    end External_Tag;
 
-   ----------------------
-   -- Get_Access_Level --
-   ----------------------
-
-   function Get_Access_Level (T : Tag) return Natural is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      return TSD (T).Access_Level;
-   end Get_Access_Level;
-
    ---------------------
    -- Get_Entry_Index --
    ---------------------
 
    function Get_Entry_Index (T : Tag; Position : Positive) return Positive is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
       return SSD (T).SSD_Table (Position).Index;
    end Get_Entry_Index;
 
@@ -827,54 +426,10 @@ package body Ada.Tags is
 
    function Get_External_Tag (T : Tag) return System.Address is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return To_Address (TSD (T).External_Tag);
    end Get_External_Tag;
 
    ----------------------
-   -- Get_Num_Prim_Ops --
-   ----------------------
-
-   function Get_Num_Prim_Ops (T : Tag) return Natural is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
-
-      if Is_Primary_DT (T) then
-         return TSD (T).Num_Prim_Ops;
-      else
-         return OSD (T).Num_Prim_Ops;
-      end if;
-   end Get_Num_Prim_Ops;
-
-   --------------------------------
-   -- Get_Predef_Prim_Op_Address --
-   --------------------------------
-
-   function Get_Predefined_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive) return System.Address
-   is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert (Position <= Default_Prim_Op_Count);
-      return Predefined_DT (T).Prims_Ptr (Position);
-   end Get_Predefined_Prim_Op_Address;
-
-   -------------------------
-   -- Get_Prim_Op_Address --
-   -------------------------
-
-   function Get_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive) return System.Address
-   is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
-      return T.Prims_Ptr (Position);
-   end Get_Prim_Op_Address;
-
-   ----------------------
    -- Get_Prim_Op_Kind --
    ----------------------
 
@@ -883,8 +438,6 @@ package body Ada.Tags is
       Position : Positive) return Prim_Op_Kind
    is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
       return SSD (T).SSD_Table (Position).Kind;
    end Get_Prim_Op_Kind;
 
@@ -897,9 +450,11 @@ package body Ada.Tags is
       Position : Positive) return Positive
    is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Secondary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
-      return OSD (T).OSD_Table (Position);
+      if Is_Primary_DT (T) then
+         return Position;
+      else
+         return OSD (T).OSD_Table (Position);
+      end if;
    end Get_Offset_Index;
 
    -------------------
@@ -908,20 +463,9 @@ package body Ada.Tags is
 
    function Get_RC_Offset (T : Tag) return SSE.Storage_Offset is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return TSD (T).RC_Offset;
    end Get_RC_Offset;
 
-   ---------------------------
-   -- Get_Remotely_Callable --
-   ---------------------------
-
-   function Get_Remotely_Callable (T : Tag) return Boolean is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      return TSD (T).Remotely_Callable;
-   end Get_Remotely_Callable;
-
    ---------------------
    -- Get_Tagged_Kind --
    ---------------------
@@ -930,113 +474,9 @@ package body Ada.Tags is
       Tagged_Kind_Ptr : constant System.Address :=
                           To_Address (T) - K_Tagged_Kind;
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
       return To_Tagged_Kind_Ptr (Tagged_Kind_Ptr).all;
    end Get_Tagged_Kind;
 
-   --------------------
-   -- Inherit_CPP_DT --
-   --------------------
-
-   procedure Inherit_CPP_DT
-     (Old_T       : Tag;
-      New_T       : Tag;
-      Entry_Count : Natural)
-   is
-   begin
-      New_T.Prims_Ptr (1 .. Entry_Count) := Old_T.Prims_Ptr (1 .. Entry_Count);
-   end Inherit_CPP_DT;
-
-   ----------------
-   -- Inherit_DT --
-   ----------------
-
-   procedure Inherit_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural) is
-      subtype All_Predefined_Prims is
-        Positive range 1 .. Default_Prim_Op_Count;
-
-   begin
-      pragma Assert (Check_Signature (Old_T, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert (Check_Signature (New_T, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert (Check_Size (Old_T, New_T, Entry_Count));
-
-      if Old_T /= null then
-
-         --  Inherit the primitives of the parent
-
-         New_T.Prims_Ptr (1 .. Entry_Count) :=
-           Old_T.Prims_Ptr (1 .. Entry_Count);
-
-         --  Inherit the predefined primitives of the parent
-
-         --  NOTE: In the following assignment we have to unactivate a warning
-         --  generated by the compiler because of the following declaration of
-         --  the Dispatch_Table:
-
-         --      Prims_Ptr : Address_Array (1 .. 1);
-
-         --  This is a dummy declaration that is expanded by the frontend to
-         --  the correct size of the dispatch table corresponding with each
-         --  tagged type. As a consequence, if we try to use a constant to
-         --  copy the predefined elements (ie.  Prims_Ptr (1 .. 15) := ...)
-         --  the compiler generates a warning indicating that Constraint_Error
-         --  will be raised at run-time (which is not true in this specific
-         --  case).
-
-         pragma Warnings (Off);
-         Predefined_DT (New_T).Prims_Ptr (All_Predefined_Prims) :=
-           Predefined_DT (Old_T).Prims_Ptr (All_Predefined_Prims);
-         pragma Warnings (On);
-      end if;
-   end Inherit_DT;
-
-   -----------------
-   -- Inherit_TSD --
-   -----------------
-
-   procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag) is
-      New_TSD_Ptr         : Type_Specific_Data_Ptr;
-      New_Iface_Table_Ptr : Interface_Data_Ptr;
-      Old_TSD_Ptr         : Type_Specific_Data_Ptr;
-      Old_Iface_Table_Ptr : Interface_Data_Ptr;
-
-   begin
-      pragma Assert (Check_Signature (New_Tag, Must_Be_Primary_Or_Interface));
-      New_TSD_Ptr := TSD (New_Tag);
-
-      if Old_Tag /= null then
-         pragma Assert
-           (Check_Signature (Old_Tag, Must_Be_Primary_Or_Interface));
-         Old_TSD_Ptr := TSD (Old_Tag);
-         New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
-
-         --  Copy the "table of ancestor tags" plus the "table of interfaces"
-         --  of the parent.
-
-         New_TSD_Ptr.Tags_Table (1 .. New_TSD_Ptr.Idepth) :=
-           Old_TSD_Ptr.Tags_Table (0 .. Old_TSD_Ptr.Idepth);
-
-         --  Copy the table of interfaces of the parent
-
-         if not System."=" (Old_TSD_Ptr.Ifaces_Table_Ptr,
-                            System.Null_Address)
-         then
-            Old_Iface_Table_Ptr :=
-              To_Interface_Data_Ptr (Old_TSD_Ptr.Ifaces_Table_Ptr);
-            New_Iface_Table_Ptr :=
-              To_Interface_Data_Ptr (New_TSD_Ptr.Ifaces_Table_Ptr);
-
-            New_Iface_Table_Ptr.Table (1 .. Old_Iface_Table_Ptr.Nb_Ifaces) :=
-              Old_Iface_Table_Ptr.Table (1 .. Old_Iface_Table_Ptr.Nb_Ifaces);
-         end if;
-
-      else
-         New_TSD_Ptr.Idepth := 0;
-      end if;
-
-      New_TSD_Ptr.Tags_Table (0) := New_Tag;
-   end Inherit_TSD;
-
    -----------------------------
    -- Interface_Ancestor_Tags --
    -----------------------------
@@ -1058,7 +498,7 @@ package body Ada.Tags is
             Table : Tag_Array (1 .. Iface_Table.Nb_Ifaces);
          begin
             for J in 1 .. Iface_Table.Nb_Ifaces loop
-               Table (J) := Iface_Table.Table (J).Iface_Tag;
+               Table (J) := Iface_Table.Ifaces_Table (J).Iface_Tag;
             end loop;
 
             return Table;
@@ -1167,7 +607,6 @@ package body Ada.Tags is
       OSD_Ptr : constant Addr_Ptr :=
                   To_Addr_Ptr (To_Address (T) - K_Typeinfo);
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Secondary_DT));
       return To_Object_Specific_Data_Ptr (OSD_Ptr.all);
    end OSD;
 
@@ -1194,7 +633,6 @@ package body Ada.Tags is
       --  Access to the _size primitive of the parent
 
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       Parent_Tag := TSD (T).Tags_Table (Parent_Slot);
       F := To_Acc_Size (Predefined_DT (Parent_Tag).Prims_Ptr (Size_Slot));
 
@@ -1213,8 +651,6 @@ package body Ada.Tags is
          raise Tag_Error;
       end if;
 
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-
       --  The Parent_Tag of a root-level tagged type is defined to be No_Tag.
       --  The first entry in the Ancestors_Tags array will be null for such
       --  a type, but it's better to be explicit about returning No_Tag in
@@ -1249,14 +685,9 @@ package body Ada.Tags is
       Iface_Table : Interface_Data_Ptr;
 
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
-      pragma Assert (Check_Signature (Interface_T, Must_Be_Interface));
-
       New_T_TSD   := TSD (T);
       Iface_Table := To_Interface_Data_Ptr (New_T_TSD.Ifaces_Table_Ptr);
-
-      pragma Assert (Position <= Iface_Table.Nb_Ifaces);
-      Iface_Table.Table (Position).Iface_Tag := Interface_T;
+      Iface_Table.Ifaces_Table (Position).Iface_Tag := Interface_T;
    end Register_Interface_Tag;
 
    ------------------
@@ -1268,16 +699,6 @@ package body Ada.Tags is
       External_Tag_HTable.Set (T);
    end Register_Tag;
 
-   ----------------------
-   -- Set_Access_Level --
-   ----------------------
-
-   procedure Set_Access_Level (T : Tag; Value : Natural) is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      TSD (T).Access_Level := Value;
-   end Set_Access_Level;
-
    ---------------------
    -- Set_Entry_Index --
    ---------------------
@@ -1288,58 +709,19 @@ package body Ada.Tags is
       Value    : Positive)
    is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
       SSD (T).SSD_Table (Position).Index := Value;
    end Set_Entry_Index;
 
-   -----------------------
-   -- Set_Expanded_Name --
-   -----------------------
-
-   procedure Set_Expanded_Name (T : Tag; Value : System.Address) is
-   begin
-      pragma Assert
-        (Check_Signature (T, Must_Be_Primary_Or_Interface));
-      TSD (T).Expanded_Name := To_Cstring_Ptr (Value);
-   end Set_Expanded_Name;
-
-   ----------------------
-   -- Set_External_Tag --
-   ----------------------
-
-   procedure Set_External_Tag (T : Tag; Value : System.Address) is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
-      TSD (T).External_Tag := To_Cstring_Ptr (Value);
-   end Set_External_Tag;
-
    -------------------------
    -- Set_Interface_Table --
    -------------------------
 
    procedure Set_Interface_Table (T : Tag; Value : System.Address) is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       TSD (T).Ifaces_Table_Ptr := Value;
    end Set_Interface_Table;
 
    ----------------------
-   -- Set_Num_Prim_Ops --
-   ----------------------
-
-   procedure Set_Num_Prim_Ops (T : Tag; Value : Natural) is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
-
-      if Is_Primary_DT (T) then
-         TSD (T).Num_Prim_Ops := Value;
-      else
-         OSD (T).Num_Prim_Ops := Value;
-      end if;
-   end Set_Num_Prim_Ops;
-
-   ----------------------
    -- Set_Offset_Index --
    ----------------------
 
@@ -1349,8 +731,6 @@ package body Ada.Tags is
       Value    : Positive)
    is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Secondary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
       OSD (T).OSD_Table (Position) := Value;
    end Set_Offset_Index;
 
@@ -1373,10 +753,6 @@ package body Ada.Tags is
       Obj_TSD       : Type_Specific_Data_Ptr;
    begin
       if System."=" (This, System.Null_Address) then
-         pragma Assert
-           (Check_Signature (Interface_T, Must_Be_Primary_DT));
-         pragma Assert (Offset_Value = 0);
-
          Offset_To_Top :=
            To_Storage_Offset_Ptr (To_Address (Interface_T) - K_Offset_To_Top);
          Offset_To_Top.all := Offset_Value;
@@ -1388,9 +764,6 @@ package body Ada.Tags is
 
       Prim_DT  := To_Tag_Ptr (This).all;
 
-      pragma Assert
-        (Check_Signature (Prim_DT, Must_Be_Primary_DT));
-
       --  Save the offset to top field in the secondary dispatch table.
 
       if Offset_Value /= 0 then
@@ -1399,9 +772,6 @@ package body Ada.Tags is
          Offset_To_Top :=
            To_Storage_Offset_Ptr (To_Address (Sec_DT) - K_Offset_To_Top);
 
-         pragma Assert
-           (Check_Signature (Sec_DT, Must_Be_Secondary_DT));
-
          if Is_Static then
             Offset_To_Top.all := Offset_Value;
          else
@@ -1420,13 +790,15 @@ package body Ada.Tags is
 
       if Iface_Table /= null then
          for Id in 1 .. Iface_Table.Nb_Ifaces loop
-            if Iface_Table.Table (Id).Iface_Tag = Interface_T then
-               Iface_Table.Table (Id).Static_Offset_To_Top := Is_Static;
+            if Iface_Table.Ifaces_Table (Id).Iface_Tag = Interface_T then
+               Iface_Table.Ifaces_Table (Id).Static_Offset_To_Top := Is_Static;
 
                if Is_Static then
-                  Iface_Table.Table (Id).Offset_To_Top_Value := Offset_Value;
+                  Iface_Table.Ifaces_Table (Id).Offset_To_Top_Value
+                    := Offset_Value;
                else
-                  Iface_Table.Table (Id).Offset_To_Top_Func := Offset_Func;
+                  Iface_Table.Ifaces_Table (Id).Offset_To_Top_Func
+                    := Offset_Func;
                end if;
 
                return;
@@ -1447,40 +819,9 @@ package body Ada.Tags is
       OSD_Ptr : constant Addr_Ptr :=
                   To_Addr_Ptr (To_Address (T) - K_Typeinfo);
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Secondary_DT));
       OSD_Ptr.all := Value;
    end Set_OSD;
 
-   ------------------------------------
-   -- Set_Predefined_Prim_Op_Address --
-   ------------------------------------
-
-   procedure Set_Predefined_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive;
-      Value    : System.Address)
-   is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert (Position >= 1 and then Position <= Default_Prim_Op_Count);
-      Predefined_DT (T).Prims_Ptr (Position) := Value;
-   end Set_Predefined_Prim_Op_Address;
-
-   -------------------------
-   -- Set_Prim_Op_Address --
-   -------------------------
-
-   procedure Set_Prim_Op_Address
-     (T        : Tag;
-      Position : Positive;
-      Value    : System.Address)
-   is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
-      T.Prims_Ptr (Position) := Value;
-   end Set_Prim_Op_Address;
-
    ----------------------
    -- Set_Prim_Op_Kind --
    ----------------------
@@ -1491,32 +832,10 @@ package body Ada.Tags is
       Value    : Prim_Op_Kind)
    is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      pragma Assert (Position <= Get_Num_Prim_Ops (T));
       SSD (T).SSD_Table (Position).Kind := Value;
    end Set_Prim_Op_Kind;
 
    -------------------
-   -- Set_RC_Offset --
-   -------------------
-
-   procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset) is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      TSD (T).RC_Offset := Value;
-   end Set_RC_Offset;
-
-   ---------------------------
-   -- Set_Remotely_Callable --
-   ---------------------------
-
-   procedure Set_Remotely_Callable (T : Tag; Value : Boolean) is
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
-      TSD (T).Remotely_Callable := Value;
-   end Set_Remotely_Callable;
-
-   -------------------
    -- Set_Signature --
    -------------------
 
@@ -1535,7 +854,6 @@ package body Ada.Tags is
 
    procedure Set_SSD (T : Tag; Value : System.Address) is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       TSD (T).SSD_Ptr := Value;
    end Set_SSD;
 
@@ -1547,29 +865,15 @@ package body Ada.Tags is
       Tagged_Kind_Ptr : constant System.Address :=
                           To_Address (T) - K_Tagged_Kind;
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
       To_Tagged_Kind_Ptr (Tagged_Kind_Ptr).all := Value;
    end Set_Tagged_Kind;
 
-   -------------
-   -- Set_TSD --
-   -------------
-
-   procedure Set_TSD (T : Tag; Value : System.Address) is
-      TSD_Ptr : Addr_Ptr;
-   begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
-      TSD_Ptr := To_Addr_Ptr (To_Address (T) - K_Typeinfo);
-      TSD_Ptr.all := Value;
-   end Set_TSD;
-
    ---------
    -- SSD --
    ---------
 
    function SSD (T : Tag) return Select_Specific_Data_Ptr is
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return To_Select_Specific_Data_Ptr (TSD (T).SSD_Ptr);
    end SSD;
 
@@ -1592,7 +896,6 @@ package body Ada.Tags is
       TSD_Ptr : constant Addr_Ptr :=
                   To_Addr_Ptr (To_Address (T) - K_Typeinfo);
    begin
-      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       return To_Type_Specific_Data_Ptr (TSD_Ptr.all);
    end TSD;
 
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);