exp_disp.ads, [...] (Expand_Dispatching_Call): If the controlling argument of the dispatching call is an abstract interface...

2006-02-13  Javier Miranda  <miranda@adacore.com>

	* exp_disp.ads, exp_disp.adb (Expand_Dispatching_Call): If the
	controlling argument of the dispatching call is an abstract interface
	class-wide type then we use it directly.
	Check No_Dispatching_Calls restriction.
	(Default_Prim_Op_Position): Remove the code that looks for the last
	entity in the list of aliased subprograms. This code was wrong in
	case of renamings.
	(Fill_DT_Entry): Add assertion to avoid the use of this subprogram
	when the source is compiled with the No_Dispatching_Calls restriction.
	(Init_Predefined_Interface_Primitives): No need to inherit primitives
	if we are compiling with restriction No_Dispatching_Calls.
	(Make_Disp_XXX): Addition of assertion to avoid the use of all these
	subprograms if we are compiling under No_Dispatching_Calls restriction.
	(Make_DT): Generate a dispatch table with a single dummy entry if
	we are compiling with the No_Dispatching_Calls restriction. In
	addition, in this case we don't generate code that calls to the
	following run-time subprograms: Set_Type_Kind, Inherit_DT.
	(Make_Select_Specific_Data_Table): Add assertion to avoid the use
	of this subprogram if compiling with the No_Dispatching_Calls
	restriction.
	(Expand_Type_Conversion): Instead of using the actual parameter,
	the argument passed as parameter to the conversion function was
	erroneously referenced by the expander.
	(Ada_Actions): Addition of Get_Predefined_Prim_Op_Address,
	Set_Predefined_Primitive_Op_Address and Set_Signature.
	(Expand_Dispatching_Call): Generate call to
	Get_Predefined_Prim_Op_Address for predefined primitives.
	(Fill_DT_Entry): Generate call to Set_Predefined_Prim_Op_Address for
	predefined primitives.
	(Make_DT, Make_Secondary_DT): If the tagged type has no user defined
	primitives we reserve one dummy entry to ensure that the tag does not
	point to some memory that is associated with some other object. In
	addition, remove all the old code that generated the assignments
	associated with the signature of the dispatch table and replace them
	by a call to the new subprogram Set_Signature.
	(Set_All_DT_Position): Change the algorithm because now we have a
	separate dispatch table associated with predefined primitive operations.
	(Expand_Interface_Conversion): In case of non-static offset_to_top
	add explicit dereference to get access to the object after the call
	to displace the pointer to the object.
	(Expand_Interface_Thunk): Modify the generation of the actual used
	in the calls to the run-time function Offset_To_Top to fulfil its
	new interface.
	(Make_DT): Add the new actuals required to call Set_Offset_To_Top.

From-SVN: r111064

2 files changed, 565 insertions, 441 deletions

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e3daf07..a29714e 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -40,6 +40,8 @@ with Nmake;    use Nmake;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Output;   use Output;
+with Restrict; use Restrict;
+with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Disp; use Sem_Disp;
@@ -302,113 +304,122 @@ package body Exp_Disp is
    package SEU renames Select_Expansion_Utilities;
 
    Ada_Actions : constant array (DT_Access_Action) of RE_Id :=
-      (CW_Membership           => RE_CW_Membership,
-       IW_Membership           => RE_IW_Membership,
-       DT_Entry_Size           => RE_DT_Entry_Size,
-       DT_Prologue_Size        => RE_DT_Prologue_Size,
-       Get_Access_Level        => RE_Get_Access_Level,
-       Get_Entry_Index         => RE_Get_Entry_Index,
-       Get_External_Tag        => RE_Get_External_Tag,
-       Get_Prim_Op_Address     => RE_Get_Prim_Op_Address,
-       Get_Prim_Op_Kind        => RE_Get_Prim_Op_Kind,
-       Get_RC_Offset           => RE_Get_RC_Offset,
-       Get_Remotely_Callable   => RE_Get_Remotely_Callable,
-       Get_Tagged_Kind         => RE_Get_Tagged_Kind,
-       Inherit_DT              => RE_Inherit_DT,
-       Inherit_TSD             => RE_Inherit_TSD,
-       Register_Interface_Tag  => RE_Register_Interface_Tag,
-       Register_Tag            => RE_Register_Tag,
-       Set_Access_Level        => RE_Set_Access_Level,
-       Set_Entry_Index         => RE_Set_Entry_Index,
-       Set_Expanded_Name       => RE_Set_Expanded_Name,
-       Set_External_Tag        => RE_Set_External_Tag,
-       Set_Interface_Table     => RE_Set_Interface_Table,
-       Set_Offset_Index        => RE_Set_Offset_Index,
-       Set_OSD                 => RE_Set_OSD,
-       Set_Prim_Op_Address     => RE_Set_Prim_Op_Address,
-       Set_Prim_Op_Kind        => RE_Set_Prim_Op_Kind,
-       Set_RC_Offset           => RE_Set_RC_Offset,
-       Set_Remotely_Callable   => RE_Set_Remotely_Callable,
-       Set_SSD                 => RE_Set_SSD,
-       Set_TSD                 => RE_Set_TSD,
-       Set_Tagged_Kind         => RE_Set_Tagged_Kind,
-       TSD_Entry_Size          => RE_TSD_Entry_Size,
-       TSD_Prologue_Size       => RE_TSD_Prologue_Size);
+      (CW_Membership                  => RE_CW_Membership,
+       IW_Membership                  => RE_IW_Membership,
+       DT_Entry_Size                  => RE_DT_Entry_Size,
+       DT_Prologue_Size               => RE_DT_Prologue_Size,
+       Get_Access_Level               => RE_Get_Access_Level,
+       Get_Entry_Index                => RE_Get_Entry_Index,
+       Get_External_Tag               => RE_Get_External_Tag,
+       Get_Predefined_Prim_Op_Address => RE_Get_Predefined_Prim_Op_Address,
+       Get_Prim_Op_Address            => RE_Get_Prim_Op_Address,
+       Get_Prim_Op_Kind               => RE_Get_Prim_Op_Kind,
+       Get_RC_Offset                  => RE_Get_RC_Offset,
+       Get_Remotely_Callable          => RE_Get_Remotely_Callable,
+       Get_Tagged_Kind                => RE_Get_Tagged_Kind,
+       Inherit_DT                     => RE_Inherit_DT,
+       Inherit_TSD                    => RE_Inherit_TSD,
+       Register_Interface_Tag         => RE_Register_Interface_Tag,
+       Register_Tag                   => RE_Register_Tag,
+       Set_Access_Level               => RE_Set_Access_Level,
+       Set_Entry_Index                => RE_Set_Entry_Index,
+       Set_Expanded_Name              => RE_Set_Expanded_Name,
+       Set_External_Tag               => RE_Set_External_Tag,
+       Set_Interface_Table            => RE_Set_Interface_Table,
+       Set_Offset_Index               => RE_Set_Offset_Index,
+       Set_OSD                        => RE_Set_OSD,
+       Set_Predefined_Prim_Op_Address => RE_Set_Predefined_Prim_Op_Address,
+       Set_Prim_Op_Address            => RE_Set_Prim_Op_Address,
+       Set_Prim_Op_Kind               => RE_Set_Prim_Op_Kind,
+       Set_RC_Offset                  => RE_Set_RC_Offset,
+       Set_Remotely_Callable          => RE_Set_Remotely_Callable,
+       Set_Signature                  => RE_Set_Signature,
+       Set_SSD                        => RE_Set_SSD,
+       Set_TSD                        => RE_Set_TSD,
+       Set_Tagged_Kind                => RE_Set_Tagged_Kind,
+       TSD_Entry_Size                 => RE_TSD_Entry_Size,
+       TSD_Prologue_Size              => RE_TSD_Prologue_Size);
 
    Action_Is_Proc : constant array (DT_Access_Action) of Boolean :=
-      (CW_Membership           => False,
-       IW_Membership           => False,
-       DT_Entry_Size           => False,
-       DT_Prologue_Size        => False,
-       Get_Access_Level        => False,
-       Get_Entry_Index         => False,
-       Get_External_Tag        => False,
-       Get_Prim_Op_Address     => False,
-       Get_Prim_Op_Kind        => False,
-       Get_RC_Offset           => False,
-       Get_Remotely_Callable   => False,
-       Get_Tagged_Kind         => False,
-       Inherit_DT              => True,
-       Inherit_TSD             => True,
-       Register_Interface_Tag  => True,
-       Register_Tag            => True,
-       Set_Access_Level        => True,
-       Set_Entry_Index         => True,
-       Set_Expanded_Name       => True,
-       Set_External_Tag        => True,
-       Set_Interface_Table     => True,
-       Set_Offset_Index        => True,
-       Set_OSD                 => True,
-       Set_Prim_Op_Address     => True,
-       Set_Prim_Op_Kind        => True,
-       Set_RC_Offset           => True,
-       Set_Remotely_Callable   => True,
-       Set_SSD                 => True,
-       Set_TSD                 => True,
-       Set_Tagged_Kind         => True,
-       TSD_Entry_Size          => False,
-       TSD_Prologue_Size       => False);
+      (CW_Membership                  => False,
+       IW_Membership                  => False,
+       DT_Entry_Size                  => False,
+       DT_Prologue_Size               => False,
+       Get_Access_Level               => False,
+       Get_Entry_Index                => False,
+       Get_External_Tag               => False,
+       Get_Predefined_Prim_Op_Address => False,
+       Get_Prim_Op_Address            => False,
+       Get_Prim_Op_Kind               => False,
+       Get_RC_Offset                  => False,
+       Get_Remotely_Callable          => False,
+       Get_Tagged_Kind                => False,
+       Inherit_DT                     => True,
+       Inherit_TSD                    => True,
+       Register_Interface_Tag         => True,
+       Register_Tag                   => True,
+       Set_Access_Level               => True,
+       Set_Entry_Index                => True,
+       Set_Expanded_Name              => True,
+       Set_External_Tag               => True,
+       Set_Interface_Table            => True,
+       Set_Offset_Index               => True,
+       Set_OSD                        => True,
+       Set_Predefined_Prim_Op_Address => True,
+       Set_Prim_Op_Address            => True,
+       Set_Prim_Op_Kind               => True,
+       Set_RC_Offset                  => True,
+       Set_Remotely_Callable          => True,
+       Set_Signature                  => True,
+       Set_SSD                        => True,
+       Set_TSD                        => True,
+       Set_Tagged_Kind                => True,
+       TSD_Entry_Size                 => False,
+       TSD_Prologue_Size              => False);
 
    Action_Nb_Arg : constant array (DT_Access_Action) of Int :=
-      (CW_Membership           => 2,
-       IW_Membership           => 2,
-       DT_Entry_Size           => 0,
-       DT_Prologue_Size        => 0,
-       Get_Access_Level        => 1,
-       Get_Entry_Index         => 2,
-       Get_External_Tag        => 1,
-       Get_Prim_Op_Address     => 2,
-       Get_Prim_Op_Kind        => 2,
-       Get_RC_Offset           => 1,
-       Get_Remotely_Callable   => 1,
-       Get_Tagged_Kind         => 1,
-       Inherit_DT              => 3,
-       Inherit_TSD             => 2,
-       Register_Interface_Tag  => 3,
-       Register_Tag            => 1,
-       Set_Access_Level        => 2,
-       Set_Entry_Index         => 3,
-       Set_Expanded_Name       => 2,
-       Set_External_Tag        => 2,
-       Set_Interface_Table     => 2,
-       Set_Offset_Index        => 3,
-       Set_OSD                 => 2,
-       Set_Prim_Op_Address     => 3,
-       Set_Prim_Op_Kind        => 3,
-       Set_RC_Offset           => 2,
-       Set_Remotely_Callable   => 2,
-       Set_SSD                 => 2,
-       Set_TSD                 => 2,
-       Set_Tagged_Kind         => 2,
-       TSD_Entry_Size          => 0,
-       TSD_Prologue_Size       => 0);
+      (CW_Membership                  => 2,
+       IW_Membership                  => 2,
+       DT_Entry_Size                  => 0,
+       DT_Prologue_Size               => 0,
+       Get_Access_Level               => 1,
+       Get_Entry_Index                => 2,
+       Get_External_Tag               => 1,
+       Get_Predefined_Prim_Op_Address => 2,
+       Get_Prim_Op_Address            => 2,
+       Get_Prim_Op_Kind               => 2,
+       Get_RC_Offset                  => 1,
+       Get_Remotely_Callable          => 1,
+       Get_Tagged_Kind                => 1,
+       Inherit_DT                     => 3,
+       Inherit_TSD                    => 2,
+       Register_Interface_Tag         => 3,
+       Register_Tag                   => 1,
+       Set_Access_Level               => 2,
+       Set_Entry_Index                => 3,
+       Set_Expanded_Name              => 2,
+       Set_External_Tag               => 2,
+       Set_Interface_Table            => 2,
+       Set_Offset_Index               => 3,
+       Set_OSD                        => 2,
+       Set_Predefined_Prim_Op_Address => 3,
+       Set_Prim_Op_Address            => 3,
+       Set_Prim_Op_Kind               => 3,
+       Set_RC_Offset                  => 2,
+       Set_Remotely_Callable          => 2,
+       Set_Signature                  => 2,
+       Set_SSD                        => 2,
+       Set_TSD                        => 2,
+       Set_Tagged_Kind                => 2,
+       TSD_Entry_Size                 => 0,
+       TSD_Prologue_Size              => 0);
 
    procedure Collect_All_Interfaces (T : Entity_Id);
    --  Ada 2005 (AI-251): Collect the whole list of interfaces that are
    --  directly or indirectly implemented by T. Used to compute the size
    --  of the table of interfaces.
 
-   function Default_Prim_Op_Position (Subp : Entity_Id) return Uint;
+   function Default_Prim_Op_Position (E : Entity_Id) return Uint;
    --  Ada 2005 (AI-251): Returns the fixed position in the dispatch table
    --  of the default primitive operations.
 
@@ -453,7 +464,7 @@ package body Exp_Disp is
             Next_Elmt (Elmt);
          end loop;
 
-         if not Present (Elmt) then
+         if No (Elmt) then
             Append_Elmt (Iface, Abstract_Interfaces (T));
          end if;
       end Add_Interface;
@@ -520,17 +531,10 @@ package body Exp_Disp is
    -- Default_Prim_Op_Position --
    ------------------------------
 
-   function Default_Prim_Op_Position (Subp : Entity_Id) return Uint is
+   function Default_Prim_Op_Position (E : Entity_Id) return Uint is
       TSS_Name : TSS_Name_Type;
-      E        : Entity_Id := Subp;
 
    begin
-      --  Handle overriden subprograms
-
-      while Present (Alias (E)) loop
-         E := Alias (E);
-      end loop;
-
       Get_Name_String (Chars (E));
       TSS_Name :=
         TSS_Name_Type
@@ -672,6 +676,8 @@ package body Exp_Disp is
    --  Start of processing for Expand_Dispatching_Call
 
    begin
+      Check_Restriction (No_Dispatching_Calls, Call_Node);
+
       --  If this is an inherited operation that was overridden, the body
       --  that is being called is its alias.
 
@@ -702,7 +708,8 @@ package body Exp_Disp is
       --  implementation of AI-260 (for the generic dispatching constructors).
 
       if Etype (Ctrl_Arg) = RTE (RE_Tag)
-        or else Etype (Ctrl_Arg) = RTE (RE_Interface_Tag)
+        or else (RTE_Available (RE_Interface_Tag)
+                  and then Etype (Ctrl_Arg) = RTE (RE_Interface_Tag))
       then
          CW_Typ := Class_Wide_Type (Controlling_Type (Subp));
 
@@ -739,7 +746,6 @@ package body Exp_Disp is
          --  Generate the Tag checks when appropriate
 
          New_Params := New_List;
-
          Param := First_Actual (Call_Node);
          while Present (Param) loop
 
@@ -825,7 +831,7 @@ package body Exp_Disp is
 
       --  Generate the appropriate subprogram pointer type
 
-      if  Etype (Subp) = Typ then
+      if Etype (Subp) = Typ then
          Res_Typ := CW_Typ;
       else
          Res_Typ := Etype (Subp);
@@ -909,12 +915,20 @@ package body Exp_Disp is
       Set_Etype (Subp_Ptr_Typ, Subp_Ptr_Typ);
       Set_Directly_Designated_Type (Subp_Ptr_Typ, Subp_Typ);
 
-      --  If the controlling argument is a value of type Ada.Tag then
-      --  use it directly.  Otherwise, the tag must be extracted from
-      --  the controlling object.
+      --  If the controlling argument is a value of type Ada.Tag or an abstract
+      --  interface class-wide type then use it directly. Otherwise, the tag
+      --  must be extracted from the controlling object.
 
       if Etype (Ctrl_Arg) = RTE (RE_Tag)
-        or else Etype (Ctrl_Arg) = RTE (RE_Interface_Tag)
+        or else (RTE_Available (RE_Interface_Tag)
+                  and then Etype (Ctrl_Arg) = RTE (RE_Interface_Tag))
+      then
+         Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
+
+      --  Ada 2005 (AI-251): Abstract interface class-wide type
+
+      elsif Is_Interface (Etype (Ctrl_Arg))
+         and then Is_Class_Wide_Type (Etype (Ctrl_Arg))
       then
          Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
 
@@ -928,19 +942,38 @@ package body Exp_Disp is
       --  Generate:
       --   Subp_Ptr_Typ!(Get_Prim_Op_Address (Ctrl._Tag, pos));
 
-      New_Call_Name :=
-        Unchecked_Convert_To (Subp_Ptr_Typ,
-          Make_DT_Access_Action (Typ,
-            Action => Get_Prim_Op_Address,
-            Args => New_List (
+      if Is_Predefined_Dispatching_Operation (Subp) then
+         New_Call_Name :=
+           Unchecked_Convert_To (Subp_Ptr_Typ,
+             Make_DT_Access_Action (Typ,
+               Action => Get_Predefined_Prim_Op_Address,
+               Args => New_List (
+
+               --  Vptr
 
-            --  Vptr
+                 Unchecked_Convert_To (RTE (RE_Tag),
+                   Controlling_Tag),
 
-              Controlling_Tag,
+               --  Position
 
-            --  Position
+                 Make_Integer_Literal (Loc, DT_Position (Subp)))));
+
+      else
+         New_Call_Name :=
+           Unchecked_Convert_To (Subp_Ptr_Typ,
+             Make_DT_Access_Action (Typ,
+               Action => Get_Prim_Op_Address,
+               Args => New_List (
 
-              Make_Integer_Literal (Loc, DT_Position (Subp)))));
+               --  Vptr
+
+                 Unchecked_Convert_To (RTE (RE_Tag),
+                   Controlling_Tag),
+
+               --  Position
+
+                 Make_Integer_Literal (Loc, DT_Position (Subp)))));
+      end if;
 
       if Nkind (Call_Node) = N_Function_Call then
 
@@ -1060,6 +1093,14 @@ package body Exp_Disp is
         and then Is_Interface (Iface_Typ));
 
       if not Is_Static then
+
+         --  Give error if configurable run time and Displace not available
+
+         if not RTE_Available (RE_Displace) then
+            Error_Msg_CRT ("abstract interface types", N);
+            return;
+         end if;
+
          Rewrite (N,
            Make_Function_Call (Loc,
              Name => New_Reference_To (RTE (RE_Displace), Loc),
@@ -1086,8 +1127,10 @@ package body Exp_Disp is
             Set_Directly_Designated_Type (New_Itype,
               Class_Wide_Type (Iface_Typ));
 
-            Rewrite (N, Unchecked_Convert_To (New_Itype,
-                          Relocate_Node (N)));
+            Rewrite (N, Make_Explicit_Dereference (Loc,
+                          Unchecked_Convert_To (New_Itype,
+                            Relocate_Node (N))));
+            Analyze (N);
          end;
 
          return;
@@ -1166,7 +1209,7 @@ package body Exp_Disp is
                             Make_Attribute_Reference (Loc,
                               Prefix =>
                                 Make_Selected_Component (Loc,
-                                  Prefix => Relocate_Node (Expression (N)),
+                                  Prefix => Make_Identifier (Loc, Name_uO),
                                   Selector_Name =>
                                     New_Occurrence_Of (Iface_Tag, Loc)),
                               Attribute_Name => Name_Address))))))));
@@ -1455,6 +1498,13 @@ package body Exp_Disp is
          Next_Formal (E);
       end loop;
 
+      --  Give message if configurable run-time and Offset_To_Top unavailable
+
+      if not RTE_Available (RE_Offset_To_Top) then
+         Error_Msg_CRT ("abstract interface types", N);
+         return Empty;
+      end if;
+
       if Ekind (First_Formal (Target)) = E_In_Parameter
         and then Ekind (Etype (First_Formal (Target)))
                   = E_Anonymous_Access_Type
@@ -1501,12 +1551,10 @@ package body Exp_Disp is
                     Make_Function_Call (Loc,
                       Name => New_Reference_To (RTE (RE_Offset_To_Top), Loc),
                       Parameter_Associations => New_List (
-                        Make_Selected_Component (Loc,
-                          Prefix => New_Reference_To
-                                      (Defining_Identifier (First (Formals)),
-                                       Loc),
-                          Selector_Name => Make_Identifier (Loc,
-                                             Name_uTag))))));
+                        Unchecked_Convert_To
+                          (RTE (RE_Address),
+                           New_Reference_To
+                             (Defining_Identifier (First (Formals)), Loc))))));
 
          Append_To (Decl, Decl_2);
          Append_To (Decl, Decl_1);
@@ -1546,12 +1594,11 @@ package body Exp_Disp is
                     Make_Function_Call (Loc,
                       Name => New_Reference_To (RTE (RE_Offset_To_Top), Loc),
                       Parameter_Associations => New_List (
-                        Make_Selected_Component (Loc,
+                        Make_Attribute_Reference (Loc,
                           Prefix => New_Reference_To
                                       (Defining_Identifier (First (Formals)),
                                        Loc),
-                          Selector_Name => Make_Identifier (Loc,
-                                             Name_uTag))))));
+                          Attribute_Name => Name_Address)))));
 
          Decl_2 :=
            Make_Object_Declaration (Loc,
@@ -1637,22 +1684,37 @@ package body Exp_Disp is
       Tag     : constant Entity_Id := First_Tag_Component (Typ);
 
    begin
-      if Pos = Uint_0 or else Pos > DT_Entry_Count (Tag) then
-         raise Program_Error;
-      end if;
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
 
-      return
-        Make_DT_Access_Action (Typ,
-          Action => Set_Prim_Op_Address,
-          Args   => New_List (
-            Unchecked_Convert_To (RTE (RE_Tag),
-              New_Reference_To (DT_Ptr, Loc)),                  -- DTptr
+      if Is_Predefined_Dispatching_Operation (Prim) then
+         return
+           Make_DT_Access_Action (Typ,
+             Action => Set_Predefined_Prim_Op_Address,
+             Args   => New_List (
+               Unchecked_Convert_To (RTE (RE_Tag),
+                 New_Reference_To (DT_Ptr, Loc)),                  -- DTptr
+
+               Make_Integer_Literal (Loc, Pos),                    -- Position
+
+               Make_Attribute_Reference (Loc,                      -- Value
+                 Prefix          => New_Reference_To (Prim, Loc),
+                 Attribute_Name  => Name_Address)));
+      else
+         pragma Assert (Pos /= Uint_0 and then Pos <= DT_Entry_Count (Tag));
+
+         return
+           Make_DT_Access_Action (Typ,
+             Action => Set_Prim_Op_Address,
+             Args   => New_List (
+               Unchecked_Convert_To (RTE (RE_Tag),
+                 New_Reference_To (DT_Ptr, Loc)),                  -- DTptr
 
-            Make_Integer_Literal (Loc, Pos),                    -- Position
+               Make_Integer_Literal (Loc, Pos),                    -- Position
 
-            Make_Attribute_Reference (Loc,                      -- Value
-              Prefix          => New_Reference_To (Prim, Loc),
-              Attribute_Name  => Name_Address)));
+               Make_Attribute_Reference (Loc,                      -- Value
+                 Prefix          => New_Reference_To (Prim, Loc),
+                 Attribute_Name  => Name_Address)));
+      end if;
    end Fill_DT_Entry;
 
    -----------------------------
@@ -1672,22 +1734,35 @@ package body Exp_Disp is
                      First_Tag_Component (Scope (DTC_Entity (Iface_Prim)));
 
    begin
-      if Pos = Uint_0 or else Pos > DT_Entry_Count (Tag) then
-         raise Program_Error;
-      end if;
+      if Is_Predefined_Dispatching_Operation (Prim) then
+         return
+           Make_DT_Access_Action (Typ,
+             Action => Set_Predefined_Prim_Op_Address,
+             Args   => New_List (
+               Unchecked_Convert_To (RTE (RE_Tag),
+                 New_Reference_To (Iface_DT_Ptr, Loc)),            -- DTptr
 
-      return
-        Make_DT_Access_Action (Typ,
-          Action => Set_Prim_Op_Address,
-          Args   => New_List (
-            Unchecked_Convert_To (RTE (RE_Tag),
-              New_Reference_To (Iface_DT_Ptr, Loc)),            -- DTptr
+               Make_Integer_Literal (Loc, Pos),                    -- Position
 
-            Make_Integer_Literal (Loc, Pos),                    -- Position
+               Make_Attribute_Reference (Loc,                      -- Value
+                 Prefix          => New_Reference_To (Thunk_Id, Loc),
+                 Attribute_Name  => Name_Address)));
+      else
+         pragma Assert (Pos /= Uint_0 and then Pos <= DT_Entry_Count (Tag));
 
-            Make_Attribute_Reference (Loc,                      -- Value
-              Prefix          => New_Reference_To (Thunk_Id, Loc),
-              Attribute_Name  => Name_Address)));
+         return
+           Make_DT_Access_Action (Typ,
+             Action => Set_Prim_Op_Address,
+             Args   => New_List (
+               Unchecked_Convert_To (RTE (RE_Tag),
+                 New_Reference_To (Iface_DT_Ptr, Loc)),            -- DTptr
+
+               Make_Integer_Literal (Loc, Pos),                    -- Position
+
+               Make_Attribute_Reference (Loc,                      -- Value
+                 Prefix          => New_Reference_To (Thunk_Id, Loc),
+                 Attribute_Name  => Name_Address)));
+      end if;
    end Fill_Secondary_DT_Entry;
 
    ---------------------------
@@ -1723,7 +1798,10 @@ package body Exp_Disp is
       --  No need to inherit primitives if we have an abstract interface
       --  type or a concurrent type.
 
-      if Is_Interface (Typ) or else Is_Concurrent_Record_Type (Typ) then
+      if Is_Interface (Typ)
+        or else Is_Concurrent_Record_Type (Typ)
+        or else Restriction_Active (No_Dispatching_Calls)
+      then
          return Result;
       end if;
 
@@ -1734,7 +1812,7 @@ package body Exp_Disp is
          --  associated with predefined primitives.
 
          --  Generate:
-         --    Inherit_DT (T'Tag, Iface'Tag, Default_Prim_Op_Count);
+         --    Inherit_DT (T'Tag, Iface'Tag, 0);
 
          Append_To (Result,
            Make_DT_Access_Action (Typ,
@@ -1743,7 +1821,7 @@ package body Exp_Disp is
                Node1 => New_Reference_To (DT_Ptr, Loc),
                Node2 => Unchecked_Convert_To (RTE (RE_Tag),
                           New_Reference_To (Node (AI), Loc)),
-               Node3 => Make_Integer_Literal (Loc, Default_Prim_Op_Count))));
+               Node3 => Make_Integer_Literal (Loc, Uint_0))));
 
          Next_Elmt (AI);
       end loop;
@@ -1765,6 +1843,8 @@ package body Exp_Disp is
       Stmts    : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  Null body is generated for interface types
 
       if Is_Interface (Typ) then
@@ -1911,6 +1991,8 @@ package body Exp_Disp is
       Params : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  "T" - Object parameter
       --  "S" - Primitive operation slot
       --  "P" - Wrapped parameters
@@ -1946,6 +2028,8 @@ package body Exp_Disp is
       Stmts    : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  Null body is generated for interface types
 
       if Is_Interface (Typ) then
@@ -2152,6 +2236,8 @@ package body Exp_Disp is
       Params : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  "T" - Object parameter
       --  "S" - Primitive operation slot
       --  "P" - Wrapped parameters
@@ -2183,6 +2269,8 @@ package body Exp_Disp is
       DT_Ptr : Entity_Id;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       if Is_Interface (Typ) then
          return
            Make_Subprogram_Body (Loc,
@@ -2240,6 +2328,8 @@ package body Exp_Disp is
       Params : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  "T" - Object parameter
       --  "S" - Primitive operation slot
       --  "C" - Call kind
@@ -2267,6 +2357,8 @@ package body Exp_Disp is
       Ret : Node_Id;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       if Is_Concurrent_Record_Type (Typ)
         and then Ekind (Corresponding_Concurrent_Type (Typ)) = E_Task_Type
       then
@@ -2312,6 +2404,8 @@ package body Exp_Disp is
                    Name_uDisp_Get_Task_Id);
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       Set_Is_Internal (Def_Id);
 
       return
@@ -2341,6 +2435,8 @@ package body Exp_Disp is
       Stmts    : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  Null body is generated for interface types
 
       if Is_Interface (Typ) then
@@ -2515,6 +2611,8 @@ package body Exp_Disp is
       Params : constant List_Id    := New_List;
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       --  "T" - Object parameter
       --  "S" - Primitive operation slot
       --  "P" - Wrapped parameters
@@ -2590,6 +2688,7 @@ package body Exp_Disp is
       TSD_Num_Entries   : Int;
 
       Ancestor_Copy     : Entity_Id;
+      Empty_DT          : Boolean := False;
       Typ_Copy          : Entity_Id;
 
    begin
@@ -2601,11 +2700,13 @@ package body Exp_Disp is
       --  Calculate the size of the DT and the TSD
 
       if Is_Interface (Typ) then
+
          --  Abstract interfaces need neither the DT nor the ancestors table.
          --  We reserve a single entry for its DT because at run-time the
          --  pointer to this dummy DT will be used as the tag of this abstract
          --  interface type.
 
+         Empty_DT        := True;
          Nb_Prim         := 1;
          TSD_Num_Entries := 0;
          Num_Ifaces      := 0;
@@ -2669,12 +2770,14 @@ package body Exp_Disp is
          TSD_Num_Entries := I_Depth + 1;
          Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ)));
 
-         --  If the number of primitives of Typ is less that the number of
-         --  predefined primitives, we must reserve at least enough space
-         --  for the predefined primitives.
+         --  If the number of primitives of Typ is 0 (or we are compiling with
+         --  the No_Dispatching_Calls restriction) we reserve a dummy single
+         --  entry for its DT because at run-time the pointer to this dummy DT
+         --  will be used as the tag of this tagged type.
 
-         if Nb_Prim < Default_Prim_Op_Count then
-            Nb_Prim := Default_Prim_Op_Count;
+         if Nb_Prim = 0 or else Restriction_Active (No_Dispatching_Calls) then
+            Empty_DT := True;
+            Nb_Prim  := 1;
          end if;
       end if;
 
@@ -2746,52 +2849,6 @@ package body Exp_Disp is
               Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
               Attribute_Name => Name_Alignment)));
 
-      --  Initialize the signature of the interface tag. It is a sequence
-      --  two bytes located in the header of the dispatch table.
-
-      Append_To (Result,
-        Make_Assignment_Statement (Loc,
-          Name =>
-            Make_Indexed_Component (Loc,
-              Prefix => New_Occurrence_Of (DT, Loc),
-              Expressions => New_List (
-                Make_Integer_Literal (Loc, Uint_1))),
-          Expression =>
-            Unchecked_Convert_To (RTE (RE_Storage_Element),
-              New_Reference_To (RTE (RE_Valid_Signature), Loc))));
-
-      if not Is_Interface (Typ) then
-
-         --  The signature of a Primary Dispatch table is:
-         --    (Valid_Signature, Primary_DT)
-
-         Append_To (Result,
-           Make_Assignment_Statement (Loc,
-             Name =>
-               Make_Indexed_Component (Loc,
-                 Prefix => New_Occurrence_Of (DT, Loc),
-                 Expressions => New_List (
-                   Make_Integer_Literal (Loc, Uint_2))),
-             Expression =>
-               Unchecked_Convert_To (RTE (RE_Storage_Element),
-                 New_Reference_To (RTE (RE_Primary_DT), Loc))));
-
-      else
-         --  The signature of an abstract interface is:
-         --    (Valid_Signature, Abstract_Interface)
-
-         Append_To (Result,
-           Make_Assignment_Statement (Loc,
-             Name =>
-               Make_Indexed_Component (Loc,
-                 Prefix => New_Occurrence_Of (DT, Loc),
-                 Expressions => New_List (
-                   Make_Integer_Literal (Loc, Uint_2))),
-             Expression =>
-               Unchecked_Convert_To (RTE (RE_Storage_Element),
-                 New_Reference_To (RTE (RE_Abstract_Interface), Loc))));
-      end if;
-
       --  Generate code to create the pointer to the dispatch table
 
       --    DT_Ptr : Tag := Tag!(DT'Address);
@@ -2829,7 +2886,7 @@ package body Exp_Disp is
 
       --  Set Access_Disp_Table field to be the dispatch table pointer
 
-      if not Present (Access_Disp_Table (Typ)) then
+      if No (Access_Disp_Table (Typ)) then
          Set_Access_Disp_Table (Typ, New_Elmt_List);
       end if;
 
@@ -2876,6 +2933,26 @@ package body Exp_Disp is
               Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
               Attribute_Name => Name_Alignment)));
 
+      --  Generate:
+      --    Set_Signature (DT_Ptr, Value);
+
+      if Is_Interface (Typ) then
+         Append_To (Elab_Code,
+           Make_DT_Access_Action (Typ,
+             Action => Set_Signature,
+             Args   => New_List (
+               New_Reference_To (DT_Ptr, Loc),                  -- DTptr
+               New_Reference_To (RTE (RE_Abstract_Interface), Loc))));
+
+      elsif RTE_Available (RE_Set_Signature) then
+         Append_To (Elab_Code,
+           Make_DT_Access_Action (Typ,
+             Action => Set_Signature,
+             Args   => New_List (
+               New_Reference_To (DT_Ptr, Loc),                  -- DTptr
+               New_Reference_To (RTE (RE_Primary_DT), Loc))));
+      end if;
+
       --  Generate code to put the Address of the TSD in the dispatch table
       --    Set_TSD (DT_Ptr, TSD);
 
@@ -2895,17 +2972,19 @@ package body Exp_Disp is
          null;
 
       elsif Num_Ifaces = 0 then
-         Append_To (Elab_Code,
-           Make_DT_Access_Action (Typ,
-             Action => Set_Interface_Table,
-             Args   => New_List (
-               New_Reference_To (DT_Ptr, Loc),                    -- DTptr
-               New_Reference_To (RTE (RE_Null_Address), Loc))));  -- null
+         if RTE_Available (RE_Set_Interface_Table) then
+            Append_To (Elab_Code,
+              Make_DT_Access_Action (Typ,
+                Action => Set_Interface_Table,
+                Args   => New_List (
+                  New_Reference_To (DT_Ptr, Loc),                    -- DTptr
+                  New_Reference_To (RTE (RE_Null_Address), Loc))));  -- null
+         end if;
 
       --  Generate the Interface_Table object and set the access
       --  component if the TSD to it.
 
-      else
+      elsif RTE_Available (RE_Set_Interface_Table) then
          Append_To (Result,
            Make_Object_Declaration (Loc,
              Defining_Identifier => ITable,
@@ -2932,65 +3011,77 @@ package body Exp_Disp is
       --  Generate:
       --    Set_Num_Prim_Ops (T'Tag, Nb_Prim)
 
-      if not Is_Interface (Typ) then
-         Append_To (Elab_Code,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
-             Parameter_Associations => New_List (
-               New_Reference_To (DT_Ptr, Loc),
-               Make_Integer_Literal (Loc, Nb_Prim))));
-      end if;
-
-      if Ada_Version >= Ada_05
-        and then not Is_Interface  (Typ)
-        and then not Is_Abstract   (Typ)
-        and then not Is_Controlled (Typ)
-      then
-         --  Generate:
-         --    Set_Type_Kind (T'Tag, Type_Kind (Typ));
-
-         Append_To (Elab_Code,
-           Make_DT_Access_Action (Typ,
-             Action => Set_Tagged_Kind,
-             Args   => New_List (
-               New_Reference_To (DT_Ptr, Loc),               -- DTptr
-               Tagged_Kind (Typ))));                         -- Value
-
-         --  Generate the Select Specific Data table for synchronized
-         --  types that implement a synchronized interface. The size
-         --  of the table is constrained by the number of non-predefined
-         --  primitive operations.
+      if RTE_Available (RE_Set_Num_Prim_Ops) then
+         if not Is_Interface (Typ) then
+            if Empty_DT then
+               Append_To (Elab_Code,
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
+                   Parameter_Associations => New_List (
+                     New_Reference_To (DT_Ptr, Loc),
+                     Make_Integer_Literal (Loc, Uint_0))));
+            else
+               Append_To (Elab_Code,
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
+                   Parameter_Associations => New_List (
+                     New_Reference_To (DT_Ptr, Loc),
+                     Make_Integer_Literal (Loc, Nb_Prim))));
+            end if;
+         end if;
 
-         if Is_Concurrent_Record_Type (Typ)
-           and then Implements_Interface (
-                      Typ          => Typ,
-                      Kind         => Any_Limited_Interface,
-                      Check_Parent => True)
-           and then (Nb_Prim - Default_Prim_Op_Count) > 0
+         if Ada_Version >= Ada_05
+           and then not Is_Interface  (Typ)
+           and then not Is_Abstract   (Typ)
+           and then not Is_Controlled (Typ)
+           and then not Restriction_Active (No_Dispatching_Calls)
          then
-            Append_To (Result,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => SSD,
-                Aliased_Present     => True,
-                Object_Definition   =>
-                  Make_Subtype_Indication (Loc,
-                    Subtype_Mark => New_Reference_To (
-                      RTE (RE_Select_Specific_Data), Loc),
-                    Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
-                      Constraints => New_List (
-                        Make_Integer_Literal (Loc,
-                          Nb_Prim - Default_Prim_Op_Count))))));
-
-            --  Set the pointer to the Select Specific Data table in the TSD
+            --  Generate:
+            --    Set_Type_Kind (T'Tag, Type_Kind (Typ));
 
             Append_To (Elab_Code,
               Make_DT_Access_Action (Typ,
-                Action => Set_SSD,
+                Action => Set_Tagged_Kind,
                 Args   => New_List (
-                  New_Reference_To (DT_Ptr, Loc),            -- DTptr
-                  Make_Attribute_Reference (Loc,             -- Value
-                    Prefix         => New_Reference_To (SSD, Loc),
-                    Attribute_Name => Name_Address))));
+                  New_Reference_To (DT_Ptr, Loc),               -- DTptr
+                  Tagged_Kind (Typ))));                         -- Value
+
+            --  Generate the Select Specific Data table for synchronized
+            --  types that implement a synchronized interface. The size
+            --  of the table is constrained by the number of non-predefined
+            --  primitive operations.
+
+            if not Empty_DT
+              and then Is_Concurrent_Record_Type (Typ)
+              and then Implements_Interface (
+                         Typ          => Typ,
+                         Kind         => Any_Limited_Interface,
+                         Check_Parent => True)
+            then
+               Append_To (Result,
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => SSD,
+                   Aliased_Present     => True,
+                   Object_Definition   =>
+                     Make_Subtype_Indication (Loc,
+                       Subtype_Mark => New_Reference_To (
+                         RTE (RE_Select_Specific_Data), Loc),
+                       Constraint   =>
+                         Make_Index_Or_Discriminant_Constraint (Loc,
+                           Constraints => New_List (
+                             Make_Integer_Literal (Loc, Nb_Prim))))));
+
+               --  Set the pointer to the Select Specific Data table in the TSD
+
+               Append_To (Elab_Code,
+                 Make_DT_Access_Action (Typ,
+                   Action => Set_SSD,
+                   Args   => New_List (
+                     New_Reference_To (DT_Ptr, Loc),            -- DTptr
+                     Make_Attribute_Reference (Loc,             -- Value
+                       Prefix         => New_Reference_To (SSD, Loc),
+                       Attribute_Name => Name_Address))));
+            end if;
          end if;
       end if;
 
@@ -3052,24 +3143,37 @@ package body Exp_Disp is
 
       if Typ /= Etype (Typ)
         and then not Is_Interface (Typ)
+        and then not Restriction_Active (No_Dispatching_Calls)
       then
          --  Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
 
          if not Is_Interface (Etype (Typ)) then
-            Append_To (Elab_Code,
-              Make_DT_Access_Action (Typ,
-                Action => Inherit_DT,
-                Args   => New_List (
-                  Node1 => Old_Tag1,
-                  Node2 => New_Reference_To (DT_Ptr, Loc),
-                  Node3 =>
-                    Make_Integer_Literal (Loc,
-                      DT_Entry_Count (First_Tag_Component (Etype (Typ)))))));
+            if Restriction_Active (No_Dispatching_Calls) then
+               Append_To (Elab_Code,
+                 Make_DT_Access_Action (Typ,
+                   Action => Inherit_DT,
+                   Args   => New_List (
+                     Node1 => Old_Tag1,
+                     Node2 => New_Reference_To (DT_Ptr, Loc),
+                     Node3 => Make_Integer_Literal (Loc, Uint_0))));
+            else
+               Append_To (Elab_Code,
+                 Make_DT_Access_Action (Typ,
+                   Action => Inherit_DT,
+                   Args   => New_List (
+                     Node1 => Old_Tag1,
+                     Node2 => New_Reference_To (DT_Ptr, Loc),
+                     Node3 => Make_Integer_Literal (Loc,
+                                DT_Entry_Count
+                                  (First_Tag_Component (Etype (Typ)))))));
+            end if;
          end if;
 
          --  Inherit the secondary dispatch tables of the ancestor
 
-         if not Is_CPP_Class (Etype (Typ)) then
+         if not Restriction_Active (No_Dispatching_Calls)
+           and then not Is_CPP_Class (Etype (Typ))
+         then
             declare
                Sec_DT_Ancestor : Elmt_Id :=
                                    Next_Elmt
@@ -3089,8 +3193,8 @@ package body Exp_Disp is
                ------------------------
 
                procedure Copy_Secondary_DTs (Typ : Entity_Id) is
-                  E              : Entity_Id;
-                  Iface          : Elmt_Id;
+                  E     : Entity_Id;
+                  Iface : Elmt_Id;
 
                begin
                   --  Climb to the ancestor (if any) handling private types
@@ -3110,7 +3214,6 @@ package body Exp_Disp is
                   then
                      Iface := First_Elmt (Abstract_Interfaces (Typ));
                      E     := First_Entity (Typ);
-
                      while Present (E)
                        and then Present (Node (Sec_DT_Ancestor))
                      loop
@@ -3168,23 +3271,24 @@ package body Exp_Disp is
             Node1 => Old_Tag2,
             Node2 => New_Reference_To (DT_Ptr, Loc))));
 
-      --  For types with no controlled components, generate:
-      --    Set_RC_Offset (DT_Ptr, 0);
+      if not Is_Interface (Typ) then
 
-      --  For simple types with controlled components, generate:
-      --    Set_RC_Offset (DT_Ptr, type._record_controller'position);
+         --  For types with no controlled components, generate:
+         --    Set_RC_Offset (DT_Ptr, 0);
 
-      --  For complex types with controlled components where the position
-      --  of the record controller is not statically computable, if there are
-      --  controlled components at this level, generate:
-      --    Set_RC_Offset (DT_Ptr, -1);
-      --  to indicate that the _controller field is right after the _parent
+         --  For simple types with controlled components, generate:
+         --    Set_RC_Offset (DT_Ptr, type._record_controller'position);
 
-      --  Or if there are no controlled components at this level, generate:
-      --    Set_RC_Offset (DT_Ptr, -2);
-      --  to indicate that we need to get the position from the parent.
+         --  For complex types with controlled components where the position
+         --  of the record controller is not statically computable, if there
+         --  are controlled components at this level, generate:
+         --    Set_RC_Offset (DT_Ptr, -1);
+         --  to indicate that the _controller field is right after the _parent
+
+         --  Or if there are no controlled components at this level, generate:
+         --    Set_RC_Offset (DT_Ptr, -2);
+         --  to indicate that we need to get the position from the parent.
 
-      if not Is_Interface (Typ) then
          declare
             Position : Node_Id;
 
@@ -3258,16 +3362,20 @@ package body Exp_Disp is
                   New_Occurrence_Of (Status, Loc))));
          end;
 
-         --  Generate:
-         --    Set_Offset_To_Top (0, DT_Ptr, 0);
+         if RTE_Available (RE_Set_Offset_To_Top) then
+            --  Generate:
+            --    Set_Offset_To_Top (0, DT_Ptr, True, 0, null);
 
-         Append_To (Elab_Code,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Set_Offset_To_Top), Loc),
-             Parameter_Associations => New_List (
-               New_Reference_To (RTE (RE_Null_Address), Loc),
-               New_Reference_To (DT_Ptr, Loc),
-               Make_Integer_Literal (Loc, Uint_0))));
+            Append_To (Elab_Code,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (RTE (RE_Set_Offset_To_Top), Loc),
+                Parameter_Associations => New_List (
+                  New_Reference_To (RTE (RE_Null_Address), Loc),
+                  New_Reference_To (DT_Ptr, Loc),
+                  New_Occurrence_Of (Standard_True, Loc),
+                  Make_Integer_Literal (Loc, Uint_0),
+                  New_Reference_To (RTE (RE_Null_Address), Loc))));
+         end if;
       end if;
 
       --  Generate: Set_External_Tag (DT_Ptr, exname'Address);
@@ -3284,15 +3392,15 @@ package body Exp_Disp is
                    Prefix => New_Reference_To (Exname, Loc),
                    Attribute_Name => Name_Address))));
 
-      --  Generate code to register the Tag in the External_Tag hash
-      --  table for the pure Ada type only.
+         --  Generate code to register the Tag in the External_Tag hash
+         --  table for the pure Ada type only.
 
-      --        Register_Tag (Dt_Ptr);
+         --        Register_Tag (Dt_Ptr);
 
-      --  Skip this if routine not available, or in No_Run_Time mode
-      --  or Typ is an abstract interface type (because the table to
-      --  register it is not available in the abstract type but in
-      --  types implementing this interface)
+         --  Skip this if routine not available, or in No_Run_Time mode
+         --  or Typ is an abstract interface type (because the table to
+         --  register it is not available in the abstract type but in
+         --  types implementing this interface)
 
          if not No_Run_Time_Mode
            and then RTE_Available (RE_Register_Tag)
@@ -3459,6 +3567,7 @@ package body Exp_Disp is
       Loc             : constant Source_Ptr := Sloc (AI_Tag);
       Generalized_Tag : constant Entity_Id := RTE (RE_Interface_Tag);
       Name_DT         : constant Name_Id := New_Internal_Name ('T');
+      Empty_DT        : Boolean := False;
       Iface_DT        : Node_Id;
       Iface_DT_Ptr    : Node_Id;
       Name_DT_Ptr     : Name_Id;
@@ -3493,14 +3602,15 @@ package body Exp_Disp is
       Set_Is_Statically_Allocated (Iface_DT_Ptr);
 
       --  Generate code to create the storage for the Dispatch_Table object.
-      --  If the number of primitives of Typ is less that the number of
-      --  predefined primitives, we must reserve at least enough space
-      --  for the predefined primitives.
+      --  If the number of primitives of Typ is 0 we reserve a dummy single
+      --  entry for its DT because at run-time the pointer to this dummy entry
+      --  will be used as the tag.
 
       Nb_Prim := UI_To_Int (DT_Entry_Count (AI_Tag));
 
-      if Nb_Prim < Default_Prim_Op_Count then
-         Nb_Prim := Default_Prim_Op_Count;
+      if Nb_Prim = 0 then
+         Empty_DT := True;
+         Nb_Prim  := 1;
       end if;
 
       --    DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
@@ -3542,32 +3652,6 @@ package body Exp_Disp is
               Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
               Attribute_Name => Name_Alignment)));
 
-      --  Initialize the signature of the interface tag. It is a sequence of
-      --  two bytes located in the header of the dispatch table. The signature
-      --  of a Secondary Dispatch Table is (Valid_Signature, Secondary_DT).
-
-      Append_To (Result,
-        Make_Assignment_Statement (Loc,
-          Name =>
-            Make_Indexed_Component (Loc,
-              Prefix => New_Occurrence_Of (Iface_DT, Loc),
-              Expressions => New_List (
-                Make_Integer_Literal (Loc, Uint_1))),
-          Expression =>
-            Unchecked_Convert_To (RTE (RE_Storage_Element),
-              New_Reference_To (RTE (RE_Valid_Signature), Loc))));
-
-      Append_To (Result,
-        Make_Assignment_Statement (Loc,
-          Name =>
-            Make_Indexed_Component (Loc,
-              Prefix => New_Occurrence_Of (Iface_DT, Loc),
-              Expressions => New_List (
-                Make_Integer_Literal (Loc, Uint_2))),
-          Expression =>
-            Unchecked_Convert_To (RTE (RE_Storage_Element),
-              New_Reference_To (RTE (RE_Secondary_DT), Loc))));
-
       --  Generate code to create the pointer to the dispatch table
 
       --    Iface_DT_Ptr : Tag := Tag!(DT'Address);
@@ -3607,9 +3691,16 @@ package body Exp_Disp is
 
       OSD := Make_Defining_Identifier (Loc, New_Internal_Name ('I'));
 
+      --  Nothing to do if configurable run time does not support the
+      --  Object_Specific_Data entity.
+
+      if not RTE_Available (RE_Object_Specific_Data) then
+         Error_Msg_CRT ("abstract interface types", Typ);
+         return;
+      end if;
+
       --  Generate:
-      --    OSD : Ada.Tags.Object_Specific_Data
-      --            (Nb_Prims - Default_Prim_Op_Count);
+      --    OSD : Ada.Tags.Object_Specific_Data (Nb_Prims);
       --  where the constraint is used to allocate space for the
       --  non-predefined primitive operations only.
 
@@ -3623,8 +3714,15 @@ package body Exp_Disp is
               Constraint =>
                 Make_Index_Or_Discriminant_Constraint (Loc,
                   Constraints => New_List (
-                    Make_Integer_Literal (Loc,
-                      Nb_Prim - Default_Prim_Op_Count + 1))))));
+                    Make_Integer_Literal (Loc, Nb_Prim))))));
+
+      Append_To (Result,
+        Make_DT_Access_Action (Typ,
+          Action => Set_Signature,
+          Args   => New_List (
+            Unchecked_Convert_To (RTE (RE_Tag),
+              New_Reference_To (Iface_DT_Ptr, Loc)),
+            New_Reference_To (RTE (RE_Secondary_DT), Loc))));
 
       --  Generate:
       --    Ada.Tags.Set_OSD (Iface_DT_Ptr, OSD);
@@ -3642,18 +3740,32 @@ package body Exp_Disp is
       --  Generate:
       --    Set_Num_Prim_Ops (T'Tag, Nb_Prim)
 
-      Append_To (Result,
-        Make_Procedure_Call_Statement (Loc,
-          Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
-          Parameter_Associations => New_List (
-            Unchecked_Convert_To (RTE (RE_Tag),
-              New_Reference_To (Iface_DT_Ptr, Loc)),
-            Make_Integer_Literal (Loc, Nb_Prim))));
+      if RTE_Available (RE_Set_Num_Prim_Ops) then
+         if Empty_DT then
+            Append_To (Result,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
+                Parameter_Associations => New_List (
+                  Unchecked_Convert_To (RTE (RE_Tag),
+                    New_Reference_To (Iface_DT_Ptr, Loc)),
+                  Make_Integer_Literal (Loc, Uint_0))));
+         else
+            Append_To (Result,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
+                Parameter_Associations => New_List (
+                  Unchecked_Convert_To (RTE (RE_Tag),
+                    New_Reference_To (Iface_DT_Ptr, Loc)),
+                  Make_Integer_Literal (Loc, Nb_Prim))));
+         end if;
+      end if;
 
       if Ada_Version >= Ada_05
         and then not Is_Interface  (Typ)
         and then not Is_Abstract   (Typ)
         and then not Is_Controlled (Typ)
+        and then RTE_Available (RE_Set_Tagged_Kind)
+        and then not Restriction_Active (No_Dispatching_Calls)
       then
          --  Generate:
          --    Set_Tagged_Kind (Iface'Tag, Tagged_Kind (Iface));
@@ -3666,12 +3778,12 @@ package body Exp_Disp is
                  New_Reference_To (Iface_DT_Ptr, Loc)),
                Tagged_Kind (Typ))));                            -- Value
 
-         if Is_Concurrent_Record_Type (Typ)
+         if not Empty_DT
+           and then Is_Concurrent_Record_Type (Typ)
            and then Implements_Interface (
                       Typ          => Typ,
                       Kind         => Any_Limited_Interface,
                       Check_Parent => True)
-           and then (Nb_Prim - Default_Prim_Op_Count) > 0
          then
             declare
                Prim       : Entity_Id;
@@ -3729,14 +3841,14 @@ package body Exp_Disp is
       Assignments : constant List_Id    := New_List;
       Loc         : constant Source_Ptr := Sloc (Typ);
 
-      Conc_Typ    : Entity_Id;
-      Decls       : List_Id;
-      DT_Ptr      : Entity_Id;
-      Prim        : Entity_Id;
-      Prim_Als    : Entity_Id;
-      Prim_Elmt   : Elmt_Id;
-      Prim_Pos    : Uint;
-      Nb_Prim     : Int := 0;
+      Conc_Typ  : Entity_Id;
+      Decls     : List_Id;
+      DT_Ptr    : Entity_Id;
+      Prim      : Entity_Id;
+      Prim_Als  : Entity_Id;
+      Prim_Elmt : Elmt_Id;
+      Prim_Pos  : Uint;
+      Nb_Prim   : Int := 0;
 
       type Examined_Array is array (Int range <>) of Boolean;
 
@@ -3776,6 +3888,8 @@ package body Exp_Disp is
    --  Start of processing for Make_Select_Specific_Data_Table
 
    begin
+      pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+
       DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
 
       if Present (Corresponding_Concurrent_Type (Typ)) then
@@ -3803,8 +3917,7 @@ package body Exp_Disp is
       end loop;
 
       declare
-         Examined_Size : constant Int := Nb_Prim + Default_Prim_Op_Count;
-         Examined : Examined_Array (1 .. Examined_Size) := (others => False);
+         Examined : Examined_Array (1 .. Nb_Prim) := (others => False);
 
       begin
          Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
@@ -3812,64 +3925,69 @@ package body Exp_Disp is
             Prim := Node (Prim_Elmt);
             Prim_Pos := DT_Position (Prim);
 
-            pragma Assert (UI_To_Int (Prim_Pos) <= Examined_Size);
-
-            if Examined (UI_To_Int (Prim_Pos)) then
-               goto Continue;
-            else
-               Examined (UI_To_Int (Prim_Pos)) := True;
-            end if;
-
-            --  The current primitive overrides an interface-level subprogram
-
-            if Present (Abstract_Interface_Alias (Prim)) then
-
-               --  Set the primitive operation kind regardless of subprogram
-               --  type. Generate:
-               --    Ada.Tags.Set_Prim_Op_Kind (DT_Ptr, <position>, <kind>);
+            if not Is_Predefined_Dispatching_Operation (Prim) then
+               pragma Assert (UI_To_Int (Prim_Pos) <= Nb_Prim);
 
-               Append_To (Assignments,
-                 Make_DT_Access_Action (Typ,
-                   Action =>
-                     Set_Prim_Op_Kind,
-                   Args =>
-                     New_List (
-                       New_Reference_To (DT_Ptr, Loc),
-                       Make_Integer_Literal (Loc, Prim_Pos),
-                       Prim_Op_Kind (Prim, Typ))));
-
-               --  Retrieve the root of the alias chain if one is present
-
-               if Present (Alias (Prim)) then
-                  Prim_Als := Prim;
-                  while Present (Alias (Prim_Als)) loop
-                     Prim_Als := Alias (Prim_Als);
-                  end loop;
+               if Examined (UI_To_Int (Prim_Pos)) then
+                  goto Continue;
                else
-                  Prim_Als := Empty;
+                  Examined (UI_To_Int (Prim_Pos)) := True;
                end if;
 
-               --  In the case of an entry wrapper, set the entry index
+               --  The current primitive overrides an interface-level
+               --  subprogram
 
-               if Ekind (Prim) = E_Procedure
-                 and then Present (Prim_Als)
-                 and then Is_Primitive_Wrapper (Prim_Als)
-                 and then Ekind (Wrapped_Entity (Prim_Als)) = E_Entry
-               then
+               if Present (Abstract_Interface_Alias (Prim)) then
 
-                  --  Generate:
-                  --    Ada.Tags.Set_Entry_Index (DT_Ptr, <position>, <index>);
+                  --  Set the primitive operation kind regardless of subprogram
+                  --  type. Generate:
+                  --    Ada.Tags.Set_Prim_Op_Kind (DT_Ptr, <position>, <kind>);
 
                   Append_To (Assignments,
                     Make_DT_Access_Action (Typ,
                       Action =>
-                        Set_Entry_Index,
+                        Set_Prim_Op_Kind,
                       Args =>
                         New_List (
                           New_Reference_To (DT_Ptr, Loc),
                           Make_Integer_Literal (Loc, Prim_Pos),
-                          Make_Integer_Literal (Loc,
-                            Find_Entry_Index (Wrapped_Entity (Prim_Als))))));
+                          Prim_Op_Kind (Prim, Typ))));
+
+                  --  Retrieve the root of the alias chain if one is present
+
+                  if Present (Alias (Prim)) then
+                     Prim_Als := Prim;
+                     while Present (Alias (Prim_Als)) loop
+                        Prim_Als := Alias (Prim_Als);
+                     end loop;
+                  else
+                     Prim_Als := Empty;
+                  end if;
+
+                  --  In the case of an entry wrapper, set the entry index
+
+                  if Ekind (Prim) = E_Procedure
+                    and then Present (Prim_Als)
+                    and then Is_Primitive_Wrapper (Prim_Als)
+                    and then Ekind (Wrapped_Entity (Prim_Als)) = E_Entry
+                  then
+
+                     --  Generate:
+                     --    Ada.Tags.Set_Entry_Index
+                     --      (DT_Ptr, <position>, <index>);
+
+                     Append_To (Assignments,
+                       Make_DT_Access_Action (Typ,
+                         Action =>
+                           Set_Entry_Index,
+                         Args =>
+                           New_List (
+                             New_Reference_To (DT_Ptr, Loc),
+                             Make_Integer_Literal (Loc, Prim_Pos),
+                             Make_Integer_Literal (Loc,
+                               Find_Entry_Index
+                                 (Wrapped_Entity (Prim_Als))))));
+                  end if;
                end if;
             end if;
 
@@ -3919,11 +4037,12 @@ package body Exp_Disp is
    is
       Full_Typ : Entity_Id := Typ;
       Loc      : constant Source_Ptr := Sloc (Prim);
-      Prim_Op  : Entity_Id := Prim;
+      Prim_Op  : Entity_Id;
 
    begin
       --  Retrieve the original primitive operation
 
+      Prim_Op := Prim;
       while Present (Alias (Prim_Op)) loop
          Prim_Op := Alias (Prim_Op);
       end loop;
@@ -4037,8 +4156,8 @@ package body Exp_Disp is
             if Present (Abstract_Interface_Alias (Node (Prim_Elmt))) then
                null;
 
-            --  Predefined dispatching operations are completely safe.
-            --  They are allocated at fixed positions.
+            --  Predefined dispatching operations are completely safe. They
+            --  are allocated at fixed positions in a separate table.
 
             elsif Is_Predefined_Dispatching_Operation (Node (Prim_Elmt)) then
                null;
@@ -4266,8 +4385,7 @@ package body Exp_Disp is
          end loop;
 
          declare
-            Fixed_Prim : array (Int range 0 .. Default_Prim_Op_Count +
-                                  Parent_EC + Count_Prim)
+            Fixed_Prim : array (Int range 0 .. Parent_EC + Count_Prim)
                            of Boolean := (others => False);
 
             E : Entity_Id;
@@ -4275,17 +4393,16 @@ package body Exp_Disp is
          begin
             --  Second stage: Register fixed entries
 
-            Nb_Prim   := Default_Prim_Op_Count;
+            Nb_Prim   := 0;
             Prim_Elmt := First_Prim;
             while Present (Prim_Elmt) loop
                Prim := Node (Prim_Elmt);
 
-               --  Predefined primitives have a fixed position in all the
-               --  dispatch tables
+               --  Predefined primitives have a separate table and all its
+               --  entries are at predefined fixed positions
 
                if Is_Predefined_Dispatching_Operation (Prim) then
                   Set_DT_Position (Prim, Default_Prim_Op_Position (Prim));
-                  Fixed_Prim (UI_To_Int (DT_Position (Prim))) := True;
 
                --  Overriding interface primitives of an ancestor
 
@@ -4355,7 +4472,10 @@ package body Exp_Disp is
 
                --  Skip primitives previously set entries
 
-               if DT_Position (Prim) /= No_Uint then
+               if Is_Predefined_Dispatching_Operation (Prim) then
+                  null;
+
+               elsif DT_Position (Prim) /= No_Uint then
                   null;
 
                elsif Etype (DTC_Entity (Prim)) /= RTE (RE_Tag) then
@@ -4442,14 +4562,18 @@ package body Exp_Disp is
 
             --  Calculate real size of the dispatch table
 
-            if UI_To_Int (DT_Position (Prim)) > DT_Length then
+            if not Is_Predefined_Dispatching_Operation (Prim)
+              and then UI_To_Int (DT_Position (Prim)) > DT_Length
+            then
                DT_Length := UI_To_Int (DT_Position (Prim));
             end if;
 
-            --  Ensure that the asignated position in the dispatch
-            --  table is correct
+            --  Ensure that the asignated position to non-predefined
+            --  dispatching operations in the dispatch table is correct.
 
-            Validate_Position (Prim);
+            if not Is_Predefined_Dispatching_Operation (Prim) then
+               Validate_Position (Prim);
+            end if;
 
             if Chars (Prim) = Name_Finalize then
                Finalized := True;
@@ -4591,7 +4715,8 @@ package body Exp_Disp is
       Loc      : constant Source_Ptr := Sloc (T);
 
    begin
-      pragma Assert (Is_Tagged_Type (T));
+      pragma Assert
+        (Is_Tagged_Type (T) and then RTE_Available (RE_Tagged_Kind));
 
       --  Abstract kinds
 
@@ -4676,6 +4801,11 @@ package body Exp_Disp is
 
          Write_Int  (Int (Prim));
          Write_Str  (": ");
+
+         if Is_Predefined_Dispatching_Operation (Prim) then
+            Write_Str ("(predefined) ");
+         end if;
+
          Write_Name (Chars (Prim));
 
          --  Indicate if this primitive has an aliased primitive
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index a0f6b18..50f1a6b 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -136,12 +136,8 @@ package Exp_Disp is
 
    --  Guidelines for addition of new predefined primitive operations
 
-   --      Update the value of constant Default_Prim_Op_Count in Exp_Disp.ads
-   --      to reflect the new number of PPOs.
-
    --      Update the value of constant Default_Prim_Op_Count in A-Tags.ads
-   --      to reflect the new number of PPOs. This value should be the same
-   --      as the one in Exp_Disp.ads.
+   --      to reflect the new number of PPOs.
 
    --      Introduce a new predefined name for the new PPO in Snames.ads and
    --      Snames.adb.
@@ -149,9 +145,6 @@ package Exp_Disp is
    --      Categorize the new PPO name as predefined by adding an entry in
    --      Is_Predefined_Dispatching_Operation in Exp_Util.adb.
 
-   --      Reserve a dispatch table position for the new PPO by adding an entry
-   --      in Default_Prim_Op_Position in Exp_Disp.adb.
-
    --      Generate the specification of the new PPO in Make_Predefined_
    --      Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
    --      identifier of the specification must be set to True.
@@ -174,8 +167,6 @@ package Exp_Disp is
    --    Exp_Disp.Default_Prim_Op_Position - indirect use
    --    Exp_Disp.Set_All_DT_Position      - direct   use
 
-   Default_Prim_Op_Count : constant Int := 15;
-
    type DT_Access_Action is
       (CW_Membership,
        IW_Membership,
@@ -184,6 +175,7 @@ package Exp_Disp is
        Get_Access_Level,
        Get_Entry_Index,
        Get_External_Tag,
+       Get_Predefined_Prim_Op_Address,
        Get_Prim_Op_Address,
        Get_Prim_Op_Kind,
        Get_RC_Offset,
@@ -200,10 +192,12 @@ package Exp_Disp is
        Set_Interface_Table,
        Set_Offset_Index,
        Set_OSD,
+       Set_Predefined_Prim_Op_Address,
        Set_Prim_Op_Address,
        Set_Prim_Op_Kind,
        Set_RC_Offset,
        Set_Remotely_Callable,
+       Set_Signature,
        Set_SSD,
        Set_TSD,
        Set_Tagged_Kind,