2008-03-26 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r133612 (in particular gcc/Makefile.in with auto dependencies)



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@133613 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 577 insertions, 306 deletions

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index de26ec249fa..c14c7348dea 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -46,6 +46,7 @@ with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch6;  use Sem_Ch6;
+with Sem_Ch7;  use Sem_Ch7;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Disp; use Sem_Disp;
 with Sem_Eval; use Sem_Eval;
@@ -175,14 +176,14 @@ package body Exp_Disp is
                           /= E_Record_Subtype
             then
                declare
-                  E1, E2 : Entity_Id;
+                  E1 : constant Entity_Id := Defining_Entity (D);
+                  E2 : constant Entity_Id := Full_View (Defining_Entity (D));
+
                begin
-                  E1 := Defining_Entity (D);
-                  E2 := Full_View (Defining_Entity (D));
-                  Exchange_Entities (E1, E2);
+                  Exchange_Declarations (E1);
                   Insert_List_After_And_Analyze (Last (Target_List),
                     Make_DT (E1));
-                  Exchange_Entities (E1, E2);
+                  Exchange_Declarations (E2);
                end;
             end if;
 
@@ -612,6 +613,7 @@ package body Exp_Disp is
 
       Set_Etype (Subp_Ptr_Typ, Subp_Ptr_Typ);
       Set_Directly_Designated_Type (Subp_Ptr_Typ, Subp_Typ);
+      Set_Convention (Subp_Ptr_Typ, Convention (Subp_Typ));
 
       --  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
@@ -1531,6 +1533,7 @@ package body Exp_Disp is
       Decls     : constant List_Id    := New_List;
       DT_Ptr    : Entity_Id;
       Loc       : constant Source_Ptr := Sloc (Typ);
+      Obj_Ref   : Node_Id;
       Stmts     : constant List_Id    := New_List;
 
    begin
@@ -1593,46 +1596,78 @@ package body Exp_Disp is
                 Object_Definition =>
                   New_Reference_To (RTE (RE_Communication_Block), Loc)));
 
-            --  Generate:
-            --    Protected_Entry_Call
-            --      (T._object'Access,            --  Object
-            --       Protected_Entry_Index! (I),  --  E
-            --       P,                           --  Uninterpreted_Data
-            --       Asynchronous_Call,           --  Mode
-            --       Bnn);                        --  Communication_Block
+            --  Build T._object'Access for calls below
 
-            --  where T is the protected object, I is the entry index, P are
-            --  the wrapped parameters and B is the name of the communication
-            --  block.
+            Obj_Ref :=
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name => Name_Unchecked_Access,
+                 Prefix         =>
+                   Make_Selected_Component (Loc,
+                     Prefix        => Make_Identifier (Loc, Name_uT),
+                     Selector_Name => Make_Identifier (Loc, Name_uObject)));
 
-            Append_To (Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name =>
-                  New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),
-                Parameter_Associations =>
-                  New_List (
+            case Corresponding_Runtime_Package (Conc_Typ) is
+               when System_Tasking_Protected_Objects_Entries =>
 
-                    Make_Attribute_Reference (Loc,        -- T._object'Access
-                      Attribute_Name =>
-                        Name_Unchecked_Access,
-                      Prefix =>
-                        Make_Selected_Component (Loc,
-                          Prefix =>
-                            Make_Identifier (Loc, Name_uT),
-                          Selector_Name =>
-                            Make_Identifier (Loc, Name_uObject))),
+                  --  Generate:
+                  --    Protected_Entry_Call
+                  --      (T._object'Access,            --  Object
+                  --       Protected_Entry_Index! (I),  --  E
+                  --       P,                           --  Uninterpreted_Data
+                  --       Asynchronous_Call,           --  Mode
+                  --       Bnn);                        --  Communication_Block
+
+                  --  where T is the protected object, I is the entry index, P
+                  --  is the wrapped parameters and B is the name of the
+                  --  communication block.
+
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),
+                      Parameter_Associations =>
+                        New_List (
+                          Obj_Ref,
 
-                    Make_Unchecked_Type_Conversion (Loc,  --  entry index
-                      Subtype_Mark =>
-                        New_Reference_To (RTE (RE_Protected_Entry_Index), Loc),
-                      Expression =>
-                        Make_Identifier (Loc, Name_uI)),
+                          Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                            Subtype_Mark =>
+                              New_Reference_To
+                                 (RTE (RE_Protected_Entry_Index), Loc),
+                            Expression => Make_Identifier (Loc, Name_uI)),
 
-                    Make_Identifier (Loc, Name_uP),       --  parameter block
-                    New_Reference_To (                    --  Asynchronous_Call
-                      RTE (RE_Asynchronous_Call), Loc),
+                          Make_Identifier (Loc, Name_uP), --  parameter block
+                          New_Reference_To (              --  Asynchronous_Call
+                            RTE (RE_Asynchronous_Call), Loc),
+
+                          New_Reference_To (Com_Block, Loc)))); -- comm block
+
+               when System_Tasking_Protected_Objects_Single_Entry =>
+
+                  --  Generate:
+                  --    procedure Protected_Single_Entry_Call
+                  --      (Object              : Protection_Entry_Access;
+                  --       Uninterpreted_Data  : System.Address;
+                  --       Mode                : Call_Modes);
 
-                    New_Reference_To (Com_Block, Loc)))); -- comm block
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To
+                          (RTE (RE_Protected_Single_Entry_Call), Loc),
+                      Parameter_Associations =>
+                        New_List (
+                          Obj_Ref,
+
+                          Make_Attribute_Reference (Loc,
+                            Prefix => Make_Identifier (Loc, Name_uP),
+                            Attribute_Name => Name_Address),
+
+                            New_Reference_To
+                             (RTE (RE_Asynchronous_Call), Loc))));
+
+               when others =>
+                  raise Program_Error;
+            end case;
 
             --  Generate:
             --    B := Dummy_Communication_Block (Bnn);
@@ -1660,7 +1695,7 @@ package body Exp_Disp is
             --       Asynchronous_Call,      --  Mode
             --       F);                     --  Rendezvous_Successful
 
-            --  where T is the task object, I is the entry index, P are the
+            --  where T is the task object, I is the entry index, P is the
             --  wrapped parameters and F is the status flag.
 
             Append_To (Stmts,
@@ -1669,7 +1704,6 @@ package body Exp_Disp is
                   New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
                 Parameter_Associations =>
                   New_List (
-
                     Make_Selected_Component (Loc,         -- T._task_id
                       Prefix =>
                         Make_Identifier (Loc, Name_uT),
@@ -1843,6 +1877,7 @@ package body Exp_Disp is
       Conc_Typ : Entity_Id           := Empty;
       Decls    : constant List_Id    := New_List;
       DT_Ptr   : Entity_Id;
+      Obj_Ref  : Node_Id;
       Stmts    : constant List_Id    := New_List;
 
    begin
@@ -1929,46 +1964,73 @@ package body Exp_Disp is
 
          if Ekind (Conc_Typ) = E_Protected_Type then
 
-            --  Generate:
-            --    Protected_Entry_Call
-            --      (T._object'Access,            --  Object
-            --       Protected_Entry_Index! (I),  --  E
-            --       P,                           --  Uninterpreted_Data
-            --       Conditional_Call,            --  Mode
-            --       Bnn);                        --  Block
+            Obj_Ref :=                                  -- T._object'Access
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name => Name_Unchecked_Access,
+                 Prefix         =>
+                   Make_Selected_Component (Loc,
+                     Prefix        => Make_Identifier (Loc, Name_uT),
+                     Selector_Name => Make_Identifier (Loc, Name_uObject)));
 
-            --  where T is the protected object, I is the entry index, P are
-            --  the wrapped parameters and Bnn is the name of the communication
-            --  block.
+            case Corresponding_Runtime_Package (Conc_Typ) is
+               when System_Tasking_Protected_Objects_Entries =>
+                  --  Generate:
 
-            Append_To (Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name =>
-                  New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),
-                Parameter_Associations =>
-                  New_List (
+                  --    Protected_Entry_Call
+                  --      (T._object'Access,            --  Object
+                  --       Protected_Entry_Index! (I),  --  E
+                  --       P,                           --  Uninterpreted_Data
+                  --       Conditional_Call,            --  Mode
+                  --       Bnn);                        --  Block
 
-                    Make_Attribute_Reference (Loc,        -- T._object'Access
-                      Attribute_Name =>
-                        Name_Unchecked_Access,
-                      Prefix =>
-                        Make_Selected_Component (Loc,
-                          Prefix =>
-                            Make_Identifier (Loc, Name_uT),
-                          Selector_Name =>
-                            Make_Identifier (Loc, Name_uObject))),
+                  --  where T is the protected object, I is the entry index, P
+                  --  are the wrapped parameters and Bnn is the name of the
+                  --  communication block.
 
-                    Make_Unchecked_Type_Conversion (Loc,  --  entry index
-                      Subtype_Mark =>
-                        New_Reference_To (RTE (RE_Protected_Entry_Index), Loc),
-                      Expression =>
-                        Make_Identifier (Loc, Name_uI)),
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),
+                      Parameter_Associations =>
+                        New_List (
+                          Obj_Ref,
 
-                    Make_Identifier (Loc, Name_uP),       --  parameter block
-                    New_Reference_To (                    --  Conditional_Call
-                      RTE (RE_Conditional_Call), Loc),
-                    New_Reference_To (                    --  Bnn
-                      Blk_Nam, Loc))));
+                          Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                            Subtype_Mark =>
+                              New_Reference_To
+                                 (RTE (RE_Protected_Entry_Index), Loc),
+                            Expression => Make_Identifier (Loc, Name_uI)),
+
+                          Make_Identifier (Loc, Name_uP),  --  parameter block
+
+                          New_Reference_To (               --  Conditional_Call
+                            RTE (RE_Conditional_Call), Loc),
+                          New_Reference_To (               --  Bnn
+                            Blk_Nam, Loc))));
+
+               when System_Tasking_Protected_Objects_Single_Entry =>
+
+                  --    If we are compiling for a restricted run-time, the call
+                  --    uses the simpler form.
+
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To
+                          (RTE (RE_Protected_Single_Entry_Call), Loc),
+                      Parameter_Associations =>
+                        New_List (
+                          Obj_Ref,
+
+                          Make_Attribute_Reference (Loc,
+                            Prefix => Make_Identifier (Loc, Name_uP),
+                            Attribute_Name => Name_Address),
+
+                            New_Reference_To
+                             (RTE (RE_Conditional_Call), Loc))));
+               when others =>
+                  raise Program_Error;
+            end case;
 
             --  Generate:
             --    F := not Cancelled (Bnn);
@@ -2339,79 +2401,83 @@ package body Exp_Disp is
          --            A);
          --    end if;
 
-         Append_To (Stmts,
-           Make_If_Statement (Loc,
-             Condition =>
-               Make_Identifier (Loc, Name_uF),
-
-             Then_Statements =>
-               New_List (
-
-                  --  Call to Requeue_Protected_Entry
-
-                 Make_Procedure_Call_Statement (Loc,
-                   Name =>
-                     New_Reference_To (
-                       RTE (RE_Requeue_Protected_Entry), Loc),
-                   Parameter_Associations =>
-                     New_List (
-
-                       Make_Unchecked_Type_Conversion (Loc,  -- PEA (P)
-                         Subtype_Mark =>
-                           New_Reference_To (
-                             RTE (RE_Protection_Entries_Access), Loc),
-                         Expression =>
-                           Make_Identifier (Loc, Name_uP)),
-
-                       Make_Attribute_Reference (Loc,        -- O._object'Acc
-                         Attribute_Name =>
-                           Name_Unchecked_Access,
-                         Prefix =>
-                           Make_Selected_Component (Loc,
-                             Prefix =>
-                               Make_Identifier (Loc, Name_uO),
-                             Selector_Name =>
-                               Make_Identifier (Loc, Name_uObject))),
+         if Restriction_Active (No_Entry_Queue) then
+            Append_To (Stmts, Make_Null_Statement (Loc));
+         else
+            Append_To (Stmts,
+              Make_If_Statement (Loc,
+                Condition =>
+                  Make_Identifier (Loc, Name_uF),
 
-                       Make_Unchecked_Type_Conversion (Loc,  -- entry index
-                         Subtype_Mark =>
-                           New_Reference_To (
-                             RTE (RE_Protected_Entry_Index), Loc),
-                         Expression =>
-                           Make_Identifier (Loc, Name_uI)),
+                Then_Statements =>
+                  New_List (
 
-                       Make_Identifier (Loc, Name_uA)))),    -- abort status
+                     --  Call to Requeue_Protected_Entry
 
-             Else_Statements =>
-               New_List (
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (
+                          RTE (RE_Requeue_Protected_Entry), Loc),
+                      Parameter_Associations =>
+                        New_List (
+
+                          Make_Unchecked_Type_Conversion (Loc,  -- PEA (P)
+                            Subtype_Mark =>
+                              New_Reference_To (
+                                RTE (RE_Protection_Entries_Access), Loc),
+                            Expression =>
+                              Make_Identifier (Loc, Name_uP)),
+
+                          Make_Attribute_Reference (Loc,      -- O._object'Acc
+                            Attribute_Name =>
+                              Name_Unchecked_Access,
+                            Prefix =>
+                              Make_Selected_Component (Loc,
+                                Prefix =>
+                                  Make_Identifier (Loc, Name_uO),
+                                Selector_Name =>
+                                  Make_Identifier (Loc, Name_uObject))),
+
+                          Make_Unchecked_Type_Conversion (Loc,  -- entry index
+                            Subtype_Mark =>
+                              New_Reference_To (
+                                RTE (RE_Protected_Entry_Index), Loc),
+                            Expression =>
+                              Make_Identifier (Loc, Name_uI)),
 
-                  --  Call to Requeue_Task_To_Protected_Entry
+                          Make_Identifier (Loc, Name_uA)))),   -- abort status
 
-                 Make_Procedure_Call_Statement (Loc,
-                   Name =>
-                     New_Reference_To (
-                       RTE (RE_Requeue_Task_To_Protected_Entry), Loc),
-                   Parameter_Associations =>
-                     New_List (
+                Else_Statements =>
+                  New_List (
 
-                       Make_Attribute_Reference (Loc,        -- O._object'Acc
-                         Attribute_Name =>
-                           Name_Unchecked_Access,
-                         Prefix =>
-                           Make_Selected_Component (Loc,
-                             Prefix =>
-                               Make_Identifier (Loc, Name_uO),
-                             Selector_Name =>
-                               Make_Identifier (Loc, Name_uObject))),
+                     --  Call to Requeue_Task_To_Protected_Entry
 
-                       Make_Unchecked_Type_Conversion (Loc,  -- entry index
-                         Subtype_Mark =>
-                           New_Reference_To (
-                             RTE (RE_Protected_Entry_Index), Loc),
-                         Expression =>
-                           Make_Identifier (Loc, Name_uI)),
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (
+                          RTE (RE_Requeue_Task_To_Protected_Entry), Loc),
+                      Parameter_Associations =>
+                        New_List (
+
+                          Make_Attribute_Reference (Loc,     -- O._object'Acc
+                            Attribute_Name =>
+                              Name_Unchecked_Access,
+                            Prefix =>
+                              Make_Selected_Component (Loc,
+                                Prefix =>
+                                  Make_Identifier (Loc, Name_uO),
+                                Selector_Name =>
+                                  Make_Identifier (Loc, Name_uObject))),
+
+                          Make_Unchecked_Type_Conversion (Loc, -- entry index
+                            Subtype_Mark =>
+                              New_Reference_To (
+                                RTE (RE_Protected_Entry_Index), Loc),
+                            Expression =>
+                              Make_Identifier (Loc, Name_uI)),
 
-                       Make_Identifier (Loc, Name_uA))))));  -- abort status
+                          Make_Identifier (Loc, Name_uA)))))); -- abort status
+         end if;
       else
          pragma Assert (Is_Task_Type (Conc_Typ));
 
@@ -2658,6 +2724,7 @@ package body Exp_Disp is
       Conc_Typ : Entity_Id           := Empty;
       Decls    : constant List_Id    := New_List;
       DT_Ptr   : Entity_Id;
+      Obj_Ref  : Node_Id;
       Stmts    : constant List_Id    := New_List;
 
    begin
@@ -2727,48 +2794,83 @@ package body Exp_Disp is
                        New_Reference_To (DT_Ptr, Loc)),
                      Make_Identifier (Loc, Name_uS)))));
 
+         --  Protected case
+
          if Ekind (Conc_Typ) = E_Protected_Type then
 
-            --  Generate:
-            --    Timed_Protected_Entry_Call (
-            --      T._object'access,
+            --  Build T._object'Access
+
+            Obj_Ref :=
+               Make_Attribute_Reference (Loc,
+                  Attribute_Name => Name_Unchecked_Access,
+                  Prefix         =>
+                    Make_Selected_Component (Loc,
+                      Prefix        => Make_Identifier (Loc, Name_uT),
+                      Selector_Name => Make_Identifier (Loc, Name_uObject)));
+
+            --  Normal case, No_Entry_Queue restriction not active. In this
+            --  case we generate:
+
+            --   Timed_Protected_Entry_Call
+            --     (T._object'access,
             --      Protected_Entry_Index! (I),
-            --      P,
-            --      D,
-            --      M,
-            --      F);
+            --      P, D, M, F);
 
             --  where T is the protected object, I is the entry index, P are
             --  the wrapped parameters, D is the delay amount, M is the delay
             --  mode and F is the status flag.
 
-            Append_To (Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name =>
-                  New_Reference_To (RTE (RE_Timed_Protected_Entry_Call), Loc),
-                Parameter_Associations =>
-                  New_List (
+            case Corresponding_Runtime_Package (Conc_Typ) is
+               when System_Tasking_Protected_Objects_Entries =>
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To
+                          (RTE (RE_Timed_Protected_Entry_Call), Loc),
+                      Parameter_Associations =>
+                        New_List (
+                          Obj_Ref,
+
+                          Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                            Subtype_Mark =>
+                              New_Reference_To
+                                (RTE (RE_Protected_Entry_Index), Loc),
+                            Expression =>
+                              Make_Identifier (Loc, Name_uI)),
 
-                    Make_Attribute_Reference (Loc,        -- T._object'access
-                      Attribute_Name =>
-                        Name_Unchecked_Access,
-                      Prefix =>
-                        Make_Selected_Component (Loc,
-                          Prefix =>
-                            Make_Identifier (Loc, Name_uT),
-                          Selector_Name =>
-                            Make_Identifier (Loc, Name_uObject))),
+                          Make_Identifier (Loc, Name_uP),   --  parameter block
+                          Make_Identifier (Loc, Name_uD),   --  delay
+                          Make_Identifier (Loc, Name_uM),   --  delay mode
+                          Make_Identifier (Loc, Name_uF)))); --  status flag
 
-                    Make_Unchecked_Type_Conversion (Loc,  --  entry index
-                      Subtype_Mark =>
-                        New_Reference_To (RTE (RE_Protected_Entry_Index), Loc),
-                      Expression =>
-                        Make_Identifier (Loc, Name_uI)),
+               when System_Tasking_Protected_Objects_Single_Entry =>
+                  --  Generate:
 
-                    Make_Identifier (Loc, Name_uP),       --  parameter block
-                    Make_Identifier (Loc, Name_uD),       --  delay
-                    Make_Identifier (Loc, Name_uM),       --  delay mode
-                    Make_Identifier (Loc, Name_uF))));    --  status flag
+                  --   Timed_Protected_Single_Entry_Call
+                  --     (T._object'access, P, D, M, F);
+
+                  --  where T is the protected object, P is the wrapped
+                  --  parameters, D is the delay amount, M is the delay mode, F
+                  --  is the status flag.
+
+                  Append_To (Stmts,
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To
+                          (RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
+                      Parameter_Associations =>
+                        New_List (
+                          Obj_Ref,
+                          Make_Identifier (Loc, Name_uP),   --  parameter block
+                          Make_Identifier (Loc, Name_uD),   --  delay
+                          Make_Identifier (Loc, Name_uM),   --  delay mode
+                          Make_Identifier (Loc, Name_uF)))); --  status flag
+
+               when others =>
+                  raise Program_Error;
+            end case;
+
+         --  Task case
 
          else
             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
@@ -2957,12 +3059,13 @@ package body Exp_Disp is
       --  generate forward references and statically allocate the table.
 
       procedure Make_Secondary_DT
-        (Typ             : Entity_Id;
-         Iface           : Entity_Id;
-         Num_Iface_Prims : Nat;
-         Iface_DT_Ptr    : Entity_Id;
-         Build_Thunks    : Boolean;
-         Result          : List_Id);
+        (Typ              : Entity_Id;
+         Iface            : Entity_Id;
+         Num_Iface_Prims  : Nat;
+         Iface_DT_Ptr     : Entity_Id;
+         Predef_Prims_Ptr : Entity_Id;
+         Build_Thunks     : Boolean;
+         Result           : List_Id);
       --  Ada 2005 (AI-251): Expand the declarations for a Secondary Dispatch
       --  Table of Typ associated with Iface. Each abstract interface of Typ
       --  has two secondary dispatch tables: one containing pointers to thunks
@@ -3024,12 +3127,13 @@ package body Exp_Disp is
       -----------------------
 
       procedure Make_Secondary_DT
-        (Typ             : Entity_Id;
-         Iface           : Entity_Id;
-         Num_Iface_Prims : Nat;
-         Iface_DT_Ptr    : Entity_Id;
-         Build_Thunks    : Boolean;
-         Result          : List_Id)
+        (Typ              : Entity_Id;
+         Iface            : Entity_Id;
+         Num_Iface_Prims  : Nat;
+         Iface_DT_Ptr     : Entity_Id;
+         Predef_Prims_Ptr : Entity_Id;
+         Build_Thunks     : Boolean;
+         Result           : List_Id)
       is
          Loc                : constant Source_Ptr := Sloc (Typ);
          Name_DT            : constant Name_Id := New_Internal_Name ('T');
@@ -3168,9 +3272,10 @@ package body Exp_Disp is
             for J in Prim_Table'Range loop
                if Present (Prim_Table (J)) then
                   New_Node :=
-                    Make_Attribute_Reference (Loc,
-                      Prefix => New_Reference_To (Prim_Table (J), Loc),
-                      Attribute_Name => Name_Address);
+                    Unchecked_Convert_To (RTE (RE_Address),
+                      Make_Attribute_Reference (Loc,
+                        Prefix => New_Reference_To (Prim_Table (J), Loc),
+                        Attribute_Name => Name_Unrestricted_Access));
                else
                   New_Node :=
                     New_Reference_To (RTE (RE_Null_Address), Loc);
@@ -3451,9 +3556,10 @@ package body Exp_Disp is
                for J in Prim_Table'Range loop
                   if Present (Prim_Table (J)) then
                      New_Node :=
-                       Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Prim_Table (J), Loc),
-                         Attribute_Name => Name_Address);
+                       Unchecked_Convert_To (RTE (RE_Address),
+                         Make_Attribute_Reference (Loc,
+                           Prefix => New_Reference_To (Prim_Table (J), Loc),
+                           Attribute_Name => Name_Unrestricted_Access));
                   else
                      New_Node :=
                        New_Reference_To (RTE (RE_Null_Address), Loc);
@@ -3513,6 +3619,30 @@ package body Exp_Disp is
                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
                    Attribute_Name => Name_Address))));
 
+         Append_To (Result,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Predef_Prims_Ptr,
+             Constant_Present    => True,
+             Object_Definition =>
+               New_Reference_To (RTE (RE_Address), Loc),
+             Expression =>
+               Make_Attribute_Reference (Loc,
+                 Prefix =>
+                   Make_Selected_Component (Loc,
+                     Prefix => New_Reference_To (Iface_DT, Loc),
+                   Selector_Name =>
+                     New_Occurrence_Of
+                       (RTE_Record_Component (RE_Predef_Prims), Loc)),
+                 Attribute_Name => Name_Address)));
+
+         --  Mark entities containing library level static dispatch tables.
+         --  This attribute is later propagated to all the access-to-subprogram
+         --  itypes generated to fill the dispatch table slots (see exp_attr).
+
+         if Building_Static_DT (Typ) then
+            Set_Is_Static_Dispatch_Table_Entity (Predef_Prims);
+            Set_Is_Static_Dispatch_Table_Entity (Iface_DT);
+         end if;
       end Make_Secondary_DT;
 
       --  Local variables
@@ -3535,10 +3665,7 @@ package body Exp_Disp is
       Nb_Prim            : Nat := 0;
       New_Node           : Node_Id;
       No_Reg             : Node_Id;
-      Null_Parent_Tag    : Boolean := False;
       Num_Ifaces         : Nat := 0;
-      Old_Tag1           : Node_Id;
-      Old_Tag2           : Node_Id;
       Prim               : Entity_Id;
       Prim_Elmt          : Elmt_Id;
       Prim_Ops_Aggr_List : List_Id;
@@ -3686,7 +3813,8 @@ package body Exp_Disp is
          Collect_Interface_Components (Typ, Typ_Comps);
 
          Suffix_Index := 0;
-         AI_Tag_Elmt  := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
+         AI_Tag_Elmt  :=
+           Next_Elmt (Next_Elmt (First_Elmt (Access_Disp_Table (Typ))));
 
          AI_Tag_Comp := First_Elmt (Typ_Comps);
          while Present (AI_Tag_Comp) loop
@@ -3699,10 +3827,15 @@ package body Exp_Disp is
               Num_Iface_Prims => UI_To_Int
                                    (DT_Entry_Count (Node (AI_Tag_Comp))),
               Iface_DT_Ptr    => Node (AI_Tag_Elmt),
+              Predef_Prims_Ptr => Node (Next_Elmt (AI_Tag_Elmt)),
               Build_Thunks    => True,
               Result          => Result);
             Next_Elmt (AI_Tag_Elmt);
 
+            --  Skip the secondary dispatch table of predefined primitives
+
+            Next_Elmt (AI_Tag_Elmt);
+
             --  Build the secondary table containing pointers to primitives
             --  (used to give support to Generic Dispatching Constructors).
 
@@ -3712,10 +3845,15 @@ package body Exp_Disp is
               Num_Iface_Prims =>  UI_To_Int
                                    (DT_Entry_Count (Node (AI_Tag_Comp))),
               Iface_DT_Ptr    => Node (AI_Tag_Elmt),
+              Predef_Prims_Ptr => Node (Next_Elmt (AI_Tag_Elmt)),
               Build_Thunks    => False,
               Result          => Result);
             Next_Elmt (AI_Tag_Elmt);
 
+            --  Skip the secondary dispatch table of predefined primitives
+
+            Next_Elmt (AI_Tag_Elmt);
+
             Suffix_Index := Suffix_Index + 1;
             Next_Elmt (AI_Tag_Comp);
          end loop;
@@ -3850,6 +3988,23 @@ package body Exp_Disp is
                           New_Occurrence_Of
                             (RTE_Record_Component (RE_Prims_Ptr), Loc)),
                       Attribute_Name => Name_Address))));
+
+            Append_To (Result,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier =>
+                  Node (Next_Elmt (First_Elmt (Access_Disp_Table (Typ)))),
+                Constant_Present    => True,
+                Object_Definition   => New_Reference_To
+                                            (RTE (RE_Address), Loc),
+                Expression =>
+                  Make_Attribute_Reference (Loc,
+                    Prefix =>
+                      Make_Selected_Component (Loc,
+                        Prefix => New_Reference_To (DT, Loc),
+                      Selector_Name =>
+                        New_Occurrence_Of
+                          (RTE_Record_Component (RE_Predef_Prims), Loc)),
+                    Attribute_Name => Name_Address)));
          end if;
       end if;
 
@@ -4245,7 +4400,9 @@ package body Exp_Disp is
                      Sec_DT_Tag :=
                        New_Reference_To (DT_Ptr, Loc);
                   else
-                     Elmt := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
+                     Elmt :=
+                       Next_Elmt
+                        (Next_Elmt (First_Elmt (Access_Disp_Table (Typ))));
                      pragma Assert (Has_Thunks (Node (Elmt)));
 
                      while Ekind (Node (Elmt)) = E_Constant
@@ -4254,14 +4411,20 @@ package body Exp_Disp is
                      loop
                         pragma Assert (Has_Thunks (Node (Elmt)));
                         Next_Elmt (Elmt);
+                        pragma Assert (Has_Thunks (Node (Elmt)));
+                        Next_Elmt (Elmt);
+                        pragma Assert (not Has_Thunks (Node (Elmt)));
+                        Next_Elmt (Elmt);
                         pragma Assert (not Has_Thunks (Node (Elmt)));
                         Next_Elmt (Elmt);
                      end loop;
 
                      pragma Assert (Ekind (Node (Elmt)) = E_Constant
-                       and then not Has_Thunks (Node (Next_Elmt (Elmt))));
+                       and then not
+                         Has_Thunks (Node (Next_Elmt (Next_Elmt (Elmt)))));
                      Sec_DT_Tag :=
-                       New_Reference_To (Node (Next_Elmt (Elmt)), Loc);
+                       New_Reference_To (Node (Next_Elmt (Next_Elmt (Elmt))),
+                                         Loc);
                   end if;
 
                   Append_To (TSD_Ifaces_List,
@@ -4645,9 +4808,10 @@ package body Exp_Disp is
                for J in Prim_Table'Range loop
                   if Present (Prim_Table (J)) then
                      New_Node :=
-                       Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Prim_Table (J), Loc),
-                         Attribute_Name => Name_Address);
+                       Unchecked_Convert_To (RTE (RE_Address),
+                         Make_Attribute_Reference (Loc,
+                           Prefix => New_Reference_To (Prim_Table (J), Loc),
+                           Attribute_Name => Name_Unrestricted_Access));
                   else
                      New_Node := New_Reference_To (RTE (RE_Null_Address), Loc);
                   end if;
@@ -4787,9 +4951,10 @@ package body Exp_Disp is
                for J in Prim_Table'Range loop
                   if Present (Prim_Table (J)) then
                      New_Node :=
-                       Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Prim_Table (J), Loc),
-                         Attribute_Name => Name_Address);
+                       Unchecked_Convert_To (RTE (RE_Address),
+                         Make_Attribute_Reference (Loc,
+                           Prefix => New_Reference_To (Prim_Table (J), Loc),
+                           Attribute_Name => Name_Unrestricted_Access));
                   else
                      New_Node := New_Reference_To (RTE (RE_Null_Address), Loc);
                   end if;
@@ -4871,6 +5036,12 @@ package body Exp_Disp is
                  (Node (First_Elmt (Access_Disp_Table (Typ))), Loc)));
       end if;
 
+      --  Inherit the dispatch tables of the parent
+
+      --  There is no need to inherit anything from the parent when building
+      --  static dispatch tables because the whole dispatch table (including
+      --  inherited primitives) has been already built.
+
       if Building_Static_DT (Typ) then
          null;
 
@@ -4880,60 +5051,52 @@ package body Exp_Disp is
       elsif Is_CPP_Class (Etype (Typ)) then
          null;
 
-         --  Otherwise we fill in the dispatch tables here
+      --  Otherwise we fill in the dispatch tables here
 
       else
-         if Typ = Etype (Typ)
-           or else Is_CPP_Class (Etype (Typ))
-           or else Is_Interface (Typ)
-         then
-            Null_Parent_Tag := True;
-
-            Old_Tag1 :=
-              Unchecked_Convert_To (RTE (RE_Tag),
-                Make_Integer_Literal (Loc, 0));
-            Old_Tag2 :=
-              Unchecked_Convert_To (RTE (RE_Tag),
-                Make_Integer_Literal (Loc, 0));
-
-         else
-            Old_Tag1 :=
-              New_Reference_To
-                (Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
-            Old_Tag2 :=
-              New_Reference_To
-                (Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
-         end if;
-
          if Typ /= Etype (Typ)
            and then not Is_Interface (Typ)
            and then not Restriction_Active (No_Dispatching_Calls)
          then
             --  Inherit the dispatch table
 
-            if not Is_Interface (Etype (Typ)) then
-               if not Null_Parent_Tag then
-                  declare
-                     Nb_Prims : constant Int :=
-                                  UI_To_Int (DT_Entry_Count
-                                    (First_Tag_Component (Etype (Typ))));
-                  begin
+            if not Is_Interface (Typ)
+              and then not Is_Interface (Etype (Typ))
+              and then not Is_CPP_Class (Etype (Typ))
+            then
+               declare
+                  Nb_Prims : constant Int :=
+                               UI_To_Int (DT_Entry_Count
+                                 (First_Tag_Component (Etype (Typ))));
+               begin
+                  Append_To (Elab_Code,
+                    Build_Inherit_Predefined_Prims (Loc,
+                      Old_Tag_Node =>
+                        New_Reference_To
+                          (Node
+                           (Next_Elmt
+                            (First_Elmt
+                             (Access_Disp_Table (Etype (Typ))))), Loc),
+                      New_Tag_Node =>
+                        New_Reference_To
+                          (Node
+                           (Next_Elmt
+                            (First_Elmt
+                             (Access_Disp_Table (Typ)))), Loc)));
+
+                  if Nb_Prims /= 0 then
                      Append_To (Elab_Code,
-                       Build_Inherit_Predefined_Prims (Loc,
-                         Old_Tag_Node => Old_Tag1,
-                         New_Tag_Node =>
-                           New_Reference_To (DT_Ptr, Loc)));
-
-                     if Nb_Prims /= 0 then
-                        Append_To (Elab_Code,
-                          Build_Inherit_Prims (Loc,
-                            Typ          => Typ,
-                            Old_Tag_Node => Old_Tag2,
-                            New_Tag_Node => New_Reference_To (DT_Ptr, Loc),
-                            Num_Prims    => Nb_Prims));
-                     end if;
-                  end;
-               end if;
+                       Build_Inherit_Prims (Loc,
+                         Typ          => Typ,
+                         Old_Tag_Node =>
+                           New_Reference_To
+                             (Node
+                              (First_Elmt
+                               (Access_Disp_Table (Etype (Typ)))), Loc),
+                         New_Tag_Node => New_Reference_To (DT_Ptr, Loc),
+                         Num_Prims    => Nb_Prims));
+                  end if;
+               end;
             end if;
 
             --  Inherit the secondary dispatch tables of the ancestor
@@ -4942,12 +5105,14 @@ package body Exp_Disp is
                declare
                   Sec_DT_Ancestor : Elmt_Id :=
                                       Next_Elmt
+                                       (Next_Elmt
                                         (First_Elmt
-                                           (Access_Disp_Table (Etype (Typ))));
+                                          (Access_Disp_Table (Etype (Typ)))));
                   Sec_DT_Typ      : Elmt_Id :=
                                       Next_Elmt
-                                        (First_Elmt
-                                           (Access_Disp_Table (Typ)));
+                                       (Next_Elmt
+                                         (First_Elmt
+                                           (Access_Disp_Table (Typ))));
 
                   procedure Copy_Secondary_DTs (Typ : Entity_Id);
                   --  Local procedure required to climb through the ancestors
@@ -4998,12 +5163,15 @@ package body Exp_Disp is
                                       Build_Inherit_Predefined_Prims (Loc,
                                         Old_Tag_Node =>
                                           Unchecked_Convert_To (RTE (RE_Tag),
-                                             New_Reference_To
-                                               (Node (Sec_DT_Ancestor), Loc)),
+                                            New_Reference_To
+                                              (Node
+                                                (Next_Elmt (Sec_DT_Ancestor)),
+                                               Loc)),
                                         New_Tag_Node =>
                                           Unchecked_Convert_To (RTE (RE_Tag),
                                             New_Reference_To
-                                              (Node (Sec_DT_Typ), Loc))));
+                                              (Node (Next_Elmt (Sec_DT_Typ)),
+                                               Loc))));
 
                                     if Num_Prims /= 0 then
                                        Append_To (Elab_Code,
@@ -5027,6 +5195,12 @@ package body Exp_Disp is
                                  Next_Elmt (Sec_DT_Ancestor);
                                  Next_Elmt (Sec_DT_Typ);
 
+                                 --  Skip the secondary dispatch table of
+                                 --  predefined primitives
+
+                                 Next_Elmt (Sec_DT_Ancestor);
+                                 Next_Elmt (Sec_DT_Typ);
+
                                  if not Is_Interface (Etype (Typ)) then
 
                                     --  Inherit second secondary dispatch table
@@ -5036,11 +5210,14 @@ package body Exp_Disp is
                                         Old_Tag_Node =>
                                           Unchecked_Convert_To (RTE (RE_Tag),
                                              New_Reference_To
-                                               (Node (Sec_DT_Ancestor), Loc)),
+                                               (Node
+                                                 (Next_Elmt (Sec_DT_Ancestor)),
+                                                Loc)),
                                         New_Tag_Node =>
                                           Unchecked_Convert_To (RTE (RE_Tag),
                                             New_Reference_To
-                                              (Node (Sec_DT_Typ), Loc))));
+                                              (Node (Next_Elmt (Sec_DT_Typ)),
+                                               Loc))));
 
                                     if Num_Prims /= 0 then
                                        Append_To (Elab_Code,
@@ -5064,6 +5241,13 @@ package body Exp_Disp is
 
                               Next_Elmt (Sec_DT_Ancestor);
                               Next_Elmt (Sec_DT_Typ);
+
+                              --  Skip the secondary dispatch table of
+                              --  predefined primitives
+
+                              Next_Elmt (Sec_DT_Ancestor);
+                              Next_Elmt (Sec_DT_Typ);
+
                               Next_Elmt (Iface);
                            end if;
 
@@ -5143,6 +5327,15 @@ package body Exp_Disp is
            Make_Select_Specific_Data_Table (Typ));
       end if;
 
+      --  Mark entities containing library level static dispatch tables. This
+      --  attribute is later propagated to all the access-to-subprogram itypes
+      --  generated to fill the dispatch table slots (see exp_attr).
+
+      if Building_Static_DT (Typ) then
+         Set_Is_Static_Dispatch_Table_Entity (Predef_Prims);
+         Set_Is_Static_Dispatch_Table_Entity (DT);
+      end if;
+
       Analyze_List (Result, Suppress => All_Checks);
       Set_Has_Dispatch_Table (Typ);
 
@@ -5312,18 +5505,19 @@ package body Exp_Disp is
    ---------------
 
    function Make_Tags (Typ : Entity_Id) return List_Id is
-      Loc             : constant Source_Ptr := Sloc (Typ);
-      Tname           : constant Name_Id := Chars (Typ);
-      Result          : constant List_Id := New_List;
-      AI_Tag_Comp     : Elmt_Id;
-      DT              : Node_Id;
-      DT_Constr_List  : List_Id;
-      DT_Ptr          : Node_Id;
-      Iface_DT_Ptr    : Node_Id;
-      Nb_Prim         : Nat;
-      Suffix_Index    : Int;
-      Typ_Name        : Name_Id;
-      Typ_Comps       : Elist_Id;
+      Loc              : constant Source_Ptr := Sloc (Typ);
+      Tname            : constant Name_Id := Chars (Typ);
+      Result           : constant List_Id := New_List;
+      AI_Tag_Comp      : Elmt_Id;
+      DT               : Node_Id;
+      DT_Constr_List   : List_Id;
+      DT_Ptr           : Node_Id;
+      Predef_Prims_Ptr : Node_Id;
+      Iface_DT_Ptr     : Node_Id;
+      Nb_Prim          : Nat;
+      Suffix_Index     : Int;
+      Typ_Name         : Name_Id;
+      Typ_Comps        : Elist_Id;
 
    begin
       --  1) Generate the primary and secondary tag entities
@@ -5334,18 +5528,28 @@ package body Exp_Disp is
          Collect_Interface_Components (Typ, Typ_Comps);
       end if;
 
-      --  1) Generate the primary tag entity
+      --  1) Generate the primary tag entities
+
+      --  Primary dispatch table containing user-defined primitives
 
       DT_Ptr := Make_Defining_Identifier (Loc,
                   New_External_Name (Tname, 'P'));
       Set_Etype (DT_Ptr, RTE (RE_Tag));
 
+      --  Primary dispatch table containing predefined primitives
+
+      Predef_Prims_Ptr :=
+        Make_Defining_Identifier (Loc,
+          Chars => New_External_Name (Tname, 'Y'));
+      Set_Etype (Predef_Prims_Ptr, RTE (RE_Address));
+
       --  Import the forward declaration of the Dispatch Table wrapper record
       --  (Make_DT will take care of its exportation)
 
       if Building_Static_DT (Typ) then
-         DT := Make_Defining_Identifier (Loc,
-                 New_External_Name (Tname, 'T'));
+         DT :=
+           Make_Defining_Identifier (Loc,
+             Chars => New_External_Name (Tname, 'T'));
 
          --  Generate:
          --    DT : static aliased constant Dispatch_Table_Wrapper (Nb_Prim);
@@ -5371,6 +5575,7 @@ package body Exp_Disp is
          Set_Dispatch_Table_Wrapper (Typ, DT);
 
          if Has_DT (Typ) then
+
             --  Calculate the number of primitives of the dispatch table and
             --  the size of the Type_Specific_Data record.
 
@@ -5415,6 +5620,22 @@ package body Exp_Disp is
                             (RTE_Record_Component (RE_Prims_Ptr), Loc)),
                       Attribute_Name => Name_Address))));
 
+            Append_To (Result,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Predef_Prims_Ptr,
+                Constant_Present    => True,
+                Object_Definition   => New_Reference_To
+                                            (RTE (RE_Address), Loc),
+                Expression =>
+                  Make_Attribute_Reference (Loc,
+                    Prefix =>
+                      Make_Selected_Component (Loc,
+                        Prefix => New_Reference_To (DT, Loc),
+                      Selector_Name =>
+                        New_Occurrence_Of
+                          (RTE_Record_Component (RE_Predef_Prims), Loc)),
+                    Attribute_Name => Name_Address)));
+
          --  No dispatch table required
 
          else
@@ -5450,6 +5671,7 @@ package body Exp_Disp is
       pragma Assert (No (Access_Disp_Table (Typ)));
       Set_Access_Disp_Table (Typ, New_Elmt_List);
       Append_Elmt (DT_Ptr, Access_Disp_Table (Typ));
+      Append_Elmt (Predef_Prims_Ptr, Access_Disp_Table (Typ));
 
       --  2) Generate the secondary tag entities
 
@@ -5471,6 +5693,9 @@ package body Exp_Disp is
 
             Typ_Name := Name_Find;
 
+            --  Secondary dispatch table referencing thunks to user-defined
+            --  primitives covered by this interface.
+
             Iface_DT_Ptr :=
               Make_Defining_Identifier (Loc,
                 Chars => New_External_Name (Typ_Name, 'P'));
@@ -5484,6 +5709,25 @@ package body Exp_Disp is
               (Iface_DT_Ptr, Related_Type (Node (AI_Tag_Comp)));
             Append_Elmt (Iface_DT_Ptr, Access_Disp_Table (Typ));
 
+            --  Secondary dispatch table referencing thunks to predefined
+            --  primitives.
+
+            Iface_DT_Ptr :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_External_Name (Typ_Name, 'Y'));
+            Set_Etype (Iface_DT_Ptr, RTE (RE_Address));
+            Set_Ekind (Iface_DT_Ptr, E_Constant);
+            Set_Is_Tag (Iface_DT_Ptr);
+            Set_Has_Thunks (Iface_DT_Ptr);
+            Set_Is_Statically_Allocated (Iface_DT_Ptr);
+            Set_Is_True_Constant (Iface_DT_Ptr);
+            Set_Related_Type
+              (Iface_DT_Ptr, Related_Type (Node (AI_Tag_Comp)));
+            Append_Elmt (Iface_DT_Ptr, Access_Disp_Table (Typ));
+
+            --  Secondary dispatch table referencing user-defined primitives
+            --  covered by this interface.
+
             Iface_DT_Ptr :=
               Make_Defining_Identifier (Loc,
                 Chars => New_External_Name (Typ_Name, 'D'));
@@ -5496,6 +5740,20 @@ package body Exp_Disp is
               (Iface_DT_Ptr, Related_Type (Node (AI_Tag_Comp)));
             Append_Elmt (Iface_DT_Ptr, Access_Disp_Table (Typ));
 
+            --  Secondary dispatch table referencing predefined primitives
+
+            Iface_DT_Ptr :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_External_Name (Typ_Name, 'Z'));
+            Set_Etype (Iface_DT_Ptr, RTE (RE_Address));
+            Set_Ekind (Iface_DT_Ptr, E_Constant);
+            Set_Is_Tag (Iface_DT_Ptr);
+            Set_Is_Statically_Allocated (Iface_DT_Ptr);
+            Set_Is_True_Constant (Iface_DT_Ptr);
+            Set_Related_Type
+              (Iface_DT_Ptr, Related_Type (Node (AI_Tag_Comp)));
+            Append_Elmt (Iface_DT_Ptr, Access_Disp_Table (Typ));
+
             Next_Elmt (AI_Tag_Comp);
          end loop;
       end if;
@@ -5703,33 +5961,38 @@ package body Exp_Disp is
       end if;
 
       if not Present (Abstract_Interface_Alias (Prim)) then
-         Typ          := Scope (DTC_Entity (Prim));
-         DT_Ptr       := Node (First_Elmt (Access_Disp_Table (Typ)));
-         Pos          := DT_Position (Prim);
-         Tag          := First_Tag_Component (Typ);
+         Typ := Scope (DTC_Entity (Prim));
+         Pos := DT_Position (Prim);
+         Tag := First_Tag_Component (Typ);
 
          if Is_Predefined_Dispatching_Operation (Prim)
            or else Is_Predefined_Dispatching_Alias (Prim)
          then
+            DT_Ptr := Node (Next_Elmt (First_Elmt (Access_Disp_Table (Typ))));
             Insert_After (Ins_Nod,
               Build_Set_Predefined_Prim_Op_Address (Loc,
                 Tag_Node     => New_Reference_To (DT_Ptr, Loc),
                 Position     => Pos,
-                Address_Node => Make_Attribute_Reference (Loc,
-                                   Prefix => New_Reference_To (Prim, Loc),
-                                   Attribute_Name => Name_Address)));
+                Address_Node =>
+                  Unchecked_Convert_To (RTE (RE_Address),
+                    Make_Attribute_Reference (Loc,
+                      Prefix => New_Reference_To (Prim, Loc),
+                      Attribute_Name => Name_Unrestricted_Access))));
 
          else
             pragma Assert (Pos /= Uint_0 and then Pos <= DT_Entry_Count (Tag));
 
+            DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
             Insert_After (Ins_Nod,
               Build_Set_Prim_Op_Address (Loc,
                 Typ          => Typ,
                 Tag_Node     => New_Reference_To (DT_Ptr, Loc),
                 Position     => Pos,
-                Address_Node => Make_Attribute_Reference (Loc,
-                                  Prefix => New_Reference_To (Prim, Loc),
-                                  Attribute_Name => Name_Address)));
+                Address_Node =>
+                  Unchecked_Convert_To (RTE (RE_Address),
+                    Make_Attribute_Reference (Loc,
+                      Prefix => New_Reference_To (Prim, Loc),
+                      Attribute_Name => Name_Unrestricted_Access))));
          end if;
 
       --  Ada 2005 (AI-251): Primitive associated with an interface type
@@ -5763,35 +6026,40 @@ package body Exp_Disp is
             Iface_DT_Ptr  := Node (Iface_DT_Elmt);
             pragma Assert (Has_Thunks (Iface_DT_Ptr));
 
-            Iface_Prim    := Abstract_Interface_Alias (Prim);
-            Pos           := DT_Position (Iface_Prim);
-            Tag           := First_Tag_Component (Iface_Typ);
-            L             := New_List;
+            Iface_Prim := Abstract_Interface_Alias (Prim);
+            Pos        := DT_Position (Iface_Prim);
+            Tag        := First_Tag_Component (Iface_Typ);
+            L          := New_List;
 
             if Is_Predefined_Dispatching_Operation (Prim)
               or else Is_Predefined_Dispatching_Alias (Prim)
             then
                Append_To (L,
                  Build_Set_Predefined_Prim_Op_Address (Loc,
-                   Tag_Node => New_Reference_To (Iface_DT_Ptr, Loc),
+                   Tag_Node =>
+                     New_Reference_To (Node (Next_Elmt (Iface_DT_Elmt)), Loc),
                    Position => Pos,
                    Address_Node =>
-                     Make_Attribute_Reference (Loc,
-                       Prefix          => New_Reference_To (Thunk_Id, Loc),
-                       Attribute_Name  => Name_Address)));
+                     Unchecked_Convert_To (RTE (RE_Address),
+                       Make_Attribute_Reference (Loc,
+                         Prefix          => New_Reference_To (Thunk_Id, Loc),
+                         Attribute_Name  => Name_Unrestricted_Access))));
 
                Next_Elmt (Iface_DT_Elmt);
+               Next_Elmt (Iface_DT_Elmt);
                Iface_DT_Ptr := Node (Iface_DT_Elmt);
                pragma Assert (not Has_Thunks (Iface_DT_Ptr));
 
                Append_To (L,
                  Build_Set_Predefined_Prim_Op_Address (Loc,
-                   Tag_Node => New_Reference_To (Iface_DT_Ptr, Loc),
+                   Tag_Node =>
+                     New_Reference_To (Node (Next_Elmt (Iface_DT_Elmt)), Loc),
                    Position => Pos,
                    Address_Node =>
-                     Make_Attribute_Reference (Loc,
-                       Prefix          => New_Reference_To (Alias (Prim), Loc),
-                       Attribute_Name  => Name_Address)));
+                     Unchecked_Convert_To (RTE (RE_Address),
+                       Make_Attribute_Reference (Loc,
+                         Prefix => New_Reference_To (Alias (Prim), Loc),
+                         Attribute_Name  => Name_Unrestricted_Access))));
 
                Insert_Actions_After (Ins_Nod, L);
 
@@ -5804,12 +6072,14 @@ package body Exp_Disp is
                    Typ          => Iface_Typ,
                    Tag_Node     => New_Reference_To (Iface_DT_Ptr, Loc),
                    Position     => Pos,
-                   Address_Node => Make_Attribute_Reference (Loc,
-                                     Prefix =>
-                                       New_Reference_To (Thunk_Id, Loc),
-                                     Attribute_Name => Name_Address)));
+                   Address_Node =>
+                     Unchecked_Convert_To (RTE (RE_Address),
+                       Make_Attribute_Reference (Loc,
+                         Prefix => New_Reference_To (Thunk_Id, Loc),
+                         Attribute_Name => Name_Unrestricted_Access))));
 
                Next_Elmt (Iface_DT_Elmt);
+               Next_Elmt (Iface_DT_Elmt);
                Iface_DT_Ptr := Node (Iface_DT_Elmt);
                pragma Assert (not Has_Thunks (Iface_DT_Ptr));
 
@@ -5818,10 +6088,11 @@ package body Exp_Disp is
                    Typ          => Iface_Typ,
                    Tag_Node     => New_Reference_To (Iface_DT_Ptr, Loc),
                    Position     => Pos,
-                   Address_Node => Make_Attribute_Reference (Loc,
-                                     Prefix =>
-                                       New_Reference_To (Alias (Prim), Loc),
-                                     Attribute_Name => Name_Address)));
+                   Address_Node =>
+                     Unchecked_Convert_To (RTE (RE_Address),
+                       Make_Attribute_Reference (Loc,
+                         Prefix => New_Reference_To (Alias (Prim), Loc),
+                         Attribute_Name => Name_Unrestricted_Access))));
 
                Insert_Actions_After (Ins_Nod, L);
             end if;
@@ -5980,8 +6251,9 @@ package body Exp_Disp is
       end loop;
 
       declare
-         Fixed_Prim : array (Int range 0 .. Count_Prim) of Boolean
-                        := (others => False);
+         Fixed_Prim : array (Int range 0 .. Count_Prim) of Boolean :=
+                        (others => False);
+
          E : Entity_Id;
 
          procedure Handle_Inherited_Private_Subprograms (Typ : Entity_Id);
@@ -6231,7 +6503,7 @@ package body Exp_Disp is
          Prim := Node (Prim_Elmt);
 
          --  At this point all the primitives MUST have a position
-         --  in the dispatch table
+         --  in the dispatch table.
 
          if DT_Position (Prim) = No_Uint then
             raise Program_Error;
@@ -6322,8 +6594,7 @@ package body Exp_Disp is
       Set_DT_Entry_Count (The_Tag, UI_From_Int (DT_Length));
 
       --  The derived type must have at least as many components as its parent
-      --  (for root types, the Etype points back to itself and the test cannot
-      --   fail)
+      --  (for root types Etype points to itself and the test cannot fail).
 
       if DT_Entry_Count (The_Tag) <
            DT_Entry_Count (First_Tag_Component (Parent_Typ))