rtsfind.ads, [...]: Complete support for Ada 2005 interfaces.

2005-11-14  Hristian Kirtchev  <kirtchev@adacore.com>
	    Javier Miranda  <miranda@adacore.com>

	* rtsfind.ads, exp_util.adb, exp_util.ads, exp_disp.adb, exp_disp.ads,
	exp_ch7.adb, sem_ch9.adb, snames.adb, snames.ads,
	exp_ch9.adb, exp_ch9.ads, exp_ch6.adb, exp_ch3.adb, exp_ch3.ads,
	einfo.ads, einfo.adb: Complete support for Ada 2005 interfaces.

	* a-tags.ads, a-tags.adb: Major rewrite and additions to implement
	properly new Ada 2005 interfaces (AI-345) and add run-time checks (via
	assertions).

	* exp_dbug.ads, exp_dbug.adb (Get_Secondary_DT_External_Name): New
	subprogram that generates the external name associated with a
	secondary dispatch table.
	(Get_Secondary_DT_External_Name): New subprogram that generates the
	external name associated with a secondary dispatch table.

From-SVN: r106965

20 files changed, 5168 insertions, 3108 deletions

diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index 4a21e15..8c9312e 100644
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -39,43 +39,64 @@ pragma Elaborate_All (System.HTable);
 
 package body Ada.Tags is
 
---  Structure of the GNAT Dispatch Table
+--  Structure of the GNAT Primary Dispatch Table
 
 --           +-----------------------+
+--           |       Signature       |
+--           +-----------------------+
 --           |     Offset_To_Top     |
 --           +-----------------------+
---           | Typeinfo_Ptr/TSD_Ptr  |----> Type Specific Data
+--           | Typeinfo_Ptr/TSD_Ptr  | ---> Type Specific Data
 --  Tag ---> +-----------------------+      +-------------------+
 --           |        table of       |      | inheritance depth |
 --           :     primitive ops     :      +-------------------+
---           |        pointers       |      |   expanded name   |
+--           |        pointers       |      |   access level    |
 --           +-----------------------+      +-------------------+
---                                          |   external tag    |
---                                          +-------------------+
---                                          |   Hash table link |
+--                                          |   expanded name   |
 --                                          +-------------------+
---                                          | Remotely Callable |
---                                          +-------------------+
---                                          | Rec Ctrler offset |
+--                                          |   external tag    |
 --                                          +-------------------+
---                                          |  Num_Interfaces   |
+--                                          |   hash table link |
 --                                          +-------------------+
---                                          | table of          |
---                                          :   ancestor        :
---                                          |      tags         |
+--                                          | remotely callable |
 --                                          +-------------------+
---                                          | table of          |
---                                          :   interface       :
---                                          |      tags         |
+--                                          | rec ctrler offset |
 --                                          +-------------------+
---                                          | table of          |
---                                          :   primitive op    :
---                                          |     kinds         |
+--                                          |   num prim ops    |
 --                                          +-------------------+
---                                          | table of          |
---                                          :   entry           :
---                                          |     indices       |
+--                                          |  num interfaces   |
 --                                          +-------------------+
+--           Select Specific Data      <--- |     SSD_Ptr       |
+--           +-----------------------+      +-------------------+
+--           | table of primitive    |      | table of          |
+--           :    operation          :      :    ancestor       :
+--           |       kinds           |      |       tags        |
+--           +-----------------------+      +-------------------+
+--           | table of              |      | table of          |
+--           :    entry              :      :    interface      :
+--           |       indices         |      |       tags        |
+--           +-----------------------+      +-------------------+
+
+--  Structure of the GNAT Secondary Dispatch Table
+
+--           +-----------------------+
+--           |       Signature       |
+--           +-----------------------+
+--           |     Offset_To_Top     |
+--           +-----------------------+
+--           |        OSD_Ptr        |---> Object Specific Data
+--  Tag ---> +-----------------------+      +---------------+
+--           |        table of       |      | num prim ops  |
+--           :      primitive op     :      +---------------+
+--           |     thunk pointers    |      | table of      |
+--           +-----------------------+      +   primitive   |
+--                                          |    op offsets |
+--                                          +---------------+
+
+   Offset_To_Signature : constant SSE.Storage_Count :=
+                           DT_Typeinfo_Ptr_Size
+                             + DT_Offset_To_Top_Size
+                             + DT_Signature_Size;
 
    subtype Cstring is String (Positive);
    type Cstring_Ptr is access all Cstring;
@@ -87,13 +108,39 @@ package body Ada.Tags is
    pragma Suppress_Initialization (Tag_Table);
    pragma Suppress (Index_Check, On => Tag_Table);
 
-   type Prim_Op_Kind_Table is array (Natural range <>) of Prim_Op_Kind;
-   pragma Suppress_Initialization (Prim_Op_Kind_Table);
-   pragma Suppress (Index_Check, On => Prim_Op_Kind_Table);
+   --  Object specific data types
+
+   type Object_Specific_Data_Array is array (Positive range <>) of Positive;
+
+   type Object_Specific_Data (Nb_Prim : Positive) is record
+      Num_Prim_Ops : Natural;
+      --  Number of primitive operations of the dispatch table. This field is
+      --  used by the run-time check routines that are activated when the
+      --  run-time is compiled with assertions enabled.
+
+      OSD_Table : Object_Specific_Data_Array (1 .. Nb_Prim);
+      --  Table used in secondary DT to reference their counterpart in the
+      --  select specific data (in the TSD of the primary DT). This construct
+      --  is used in the handling of dispatching triggers in select statements.
+      --  Nb_Prim is the number of non-predefined primitive operations.
+   end record;
+
+   --  Select specific data types
+
+   type Select_Specific_Data_Element is record
+      Index : Positive;
+      Kind  : Prim_Op_Kind;
+   end record;
+
+   type Select_Specific_Data_Array is
+     array (Positive range <>) of Select_Specific_Data_Element;
+
+   type Select_Specific_Data (Nb_Prim : Positive) is record
+      SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim);
+      --  NOTE: Nb_Prim is the number of non-predefined primitive operations
+   end record;
 
-   type Entry_Index_Table is array (Natural range <>) of Positive;
-   pragma Suppress_Initialization (Entry_Index_Table);
-   pragma Suppress (Index_Check, On => Entry_Index_Table);
+   --  Type specific data types
 
    type Type_Specific_Data is record
       Idepth : Natural;
@@ -124,11 +171,22 @@ package body Ada.Tags is
       --  Controller Offset: Used to give support to tagged controlled objects
       --  (see Get_Deep_Controller at s-finimp)
 
+      Num_Prim_Ops : Natural;
+      --  Number of primitive operations of the dispatch table. This field is
+      --  used for additional run-time checks when the run-time is compiled
+      --  with assertions enabled.
+
       Num_Interfaces : Natural;
       --  Number of abstract interface types implemented by the tagged type.
       --  The value Idepth+Num_Interfaces indicates the end of the second table
       --  stored in the Tags_Table component. It is used to implement the
-      --  membership test associated with interfaces (Ada 2005:AI-251)
+      --  membership test associated with interfaces (Ada 2005:AI-251).
+
+      SSD_Ptr : System.Address;
+      --  Pointer to a table of records used in dispatching selects. This
+      --  field has a meaningful value for all tagged types that implement
+      --  a limited, protected, synchronized or task interfaces and have
+      --  non-predefined primitive operations.
 
       Tags_Table : Tag_Table (0 .. 1);
       --  The size of the Tags_Table array actually depends on the tagged type
@@ -138,21 +196,9 @@ package body Ada.Tags is
       --  purpose we are using the same mechanism as for the Prims_Ptr array in
       --  the Dispatch_Table record. See comments below on Prims_Ptr for
       --  further details.
-
-      POK_Table       : Prim_Op_Kind_Table (1 .. 1);
-      Ent_Index_Table : Entry_Index_Table  (1 .. 1);
-      --  Two auxiliary tables used for dispatching in asynchronous,
-      --  conditional and timed selects. Their size depends on the number
-      --  of primitive operations. Indexing in these two tables is performed
-      --  by subtracting the number of predefined primitive operations from
-      --  the given index value. POK_Table contains the callable entity kinds
-      --  of all non-predefined primitive operations. Ent_Index_Table contains
-      --  the entry index of primitive entry wrappers.
    end record;
 
    type Dispatch_Table is record
-      --  Offset_To_Top : Natural;
-      --  Typeinfo_Ptr  : System.Address;
 
       --  According to the C++ ABI the components Offset_To_Top and
       --  Typeinfo_Ptr are stored just "before" the dispatch table (that is,
@@ -164,6 +210,9 @@ package body Ada.Tags is
       --  enough space for these additional components, and generates code that
       --  displaces the _Tag to point after these components.
 
+      --  Offset_To_Top : Natural;
+      --  Typeinfo_Ptr  : System.Address;
+
       Prims_Ptr : Address_Array (1 .. 1);
       --  The size of the Prims_Ptr array actually depends on the tagged type
       --  to which it applies. For each tagged type, the expander computes the
@@ -185,6 +234,20 @@ package body Ada.Tags is
       --  only to declare the corresponding access type.
    end record;
 
+   --  Run-time check types and subprograms: These subprograms are used only
+   --  when the run-time is compiled with assertions enabled.
+
+   type Signature_Type is
+      (Must_Be_Primary_DT,
+       Must_Be_Secondary_DT,
+       Must_Be_Primary_Or_Secondary_DT,
+       Must_Be_Interface,
+       Must_Be_Primary_Or_Interface);
+   --  Type of signature accepted by primitives in this package that are called
+   --  during the elaboration of tagged types. This type is used by the routine
+   --  Check_Signature that is called only when the run-time is compiled with
+   --  assertions enabled.
+
    ---------------------------------------------
    -- Unchecked Conversions for String Fields --
    ---------------------------------------------
@@ -199,6 +262,12 @@ package body Ada.Tags is
    -- Unchecked Conversions for other components --
    ------------------------------------------------
 
+   type Acc_Size
+     is access function (A : System.Address) return Long_Long_Integer;
+
+   function To_Acc_Size is new Unchecked_Conversion (System.Address, Acc_Size);
+   --  The profile of the implicitly defined _size primitive
+
    type Storage_Offset_Ptr is access System.Storage_Elements.Storage_Offset;
 
    function To_Storage_Offset_Ptr is
@@ -208,6 +277,30 @@ package body Ada.Tags is
    -- Local Subprograms --
    -----------------------
 
+   function Check_Index
+     (T     : Tag;
+      Index : Natural) return Boolean;
+   --  Check that Index references a valid entry of the dispatch table of T
+
+   function Check_Signature (T : Tag; Kind : Signature_Type) return Boolean;
+   --  Check that the signature of T is valid and corresponds with the subset
+   --  specified by the signature Kind.
+
+   function Check_Size
+     (Old_T       : Tag;
+      New_T       : Tag;
+      Entry_Count : Natural) return Boolean;
+   --  Verify that Old_T and New_T have at least Entry_Count entries
+
+   function Get_Num_Prim_Ops (T : Tag) return Natural;
+   --  Retrieve the number of primitive operations in the dispatch table of T
+
+   function Is_Primary_DT (T : Tag) return Boolean;
+   pragma Inline_Always (Is_Primary_DT);
+   --  Given a tag returns True if it has the signature of a primary dispatch
+   --  table.  This is Inline_Always since it is called from other Inline_
+   --  Always subprograms where we want no out of line code to be generated.
+
    function Length (Str : Cstring_Ptr) return Natural;
    --  Length of string represented by the given pointer (treating the string
    --  as a C-style string, which is Nul terminated).
@@ -261,9 +354,9 @@ package body Ada.Tags is
 
    package body HTable_Subprograms is
 
-   -----------
-   -- Equal --
-   -----------
+      -----------
+      -- Equal --
+      -----------
 
       function Equal (A, B : System.Address) return Boolean is
          Str1 : constant Cstring_Ptr := To_Cstring_Ptr (A);
@@ -313,6 +406,93 @@ package body Ada.Tags is
 
    end HTable_Subprograms;
 
+   -----------------
+   -- Check_Index --
+   -----------------
+
+   function Check_Index
+     (T     : Tag;
+      Index : Natural) return Boolean
+   is
+      Max_Entries : constant Natural := Get_Num_Prim_Ops (T);
+
+   begin
+      return Index /= 0 and then Index <= Max_Entries;
+   end Check_Index;
+
+   ---------------------
+   -- Check_Signature --
+   ---------------------
+
+   function Check_Signature (T : Tag; Kind : Signature_Type) return Boolean is
+      Offset_To_Top_Ptr : constant Storage_Offset_Ptr :=
+                            To_Storage_Offset_Ptr (To_Address (T)
+                              - Offset_To_Signature);
+
+      Signature : constant Signature_Values :=
+                    To_Signature_Values (Offset_To_Top_Ptr.all);
+
+      Signature_Id : Signature_Kind;
+
+   begin
+      if Signature (1) /= Valid_Signature then
+         Signature_Id := Unknown;
+
+      elsif Signature (2) in Primary_DT .. Abstract_Interface then
+         Signature_Id := Signature (2);
+
+      else
+         Signature_Id := Unknown;
+      end if;
+
+      case Signature_Id is
+         when Primary_DT         =>
+            if Kind = Must_Be_Secondary_DT
+              or else Kind = Must_Be_Interface
+            then
+               return False;
+            end if;
+
+         when Secondary_DT       =>
+            if Kind = Must_Be_Primary_DT
+              or else Kind = Must_Be_Interface
+            then
+               return False;
+            end if;
+
+         when Abstract_Interface =>
+            if Kind = Must_Be_Primary_DT
+              or else Kind = Must_Be_Secondary_DT
+              or else Kind = Must_Be_Primary_Or_Secondary_DT
+            then
+               return False;
+            end if;
+
+         when others =>
+            return False;
+
+      end case;
+
+      return True;
+   end Check_Signature;
+
+   ----------------
+   -- Check_Size --
+   ----------------
+
+   function Check_Size
+     (Old_T       : Tag;
+      New_T       : Tag;
+      Entry_Count : Natural) return Boolean
+   is
+      Max_Entries_Old : constant Natural := Get_Num_Prim_Ops (Old_T);
+      Max_Entries_New : constant Natural := Get_Num_Prim_Ops (New_T);
+
+   begin
+      return Entry_Count <= Max_Entries_Old
+        and then Entry_Count <= Max_Entries_New;
+   end Check_Size;
+
    -------------------
    -- CW_Membership --
    -------------------
@@ -334,8 +514,11 @@ package body Ada.Tags is
    --     = Typ'tag
 
    function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
-      Pos : constant Integer := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
+      Pos : Integer;
    begin
+      pragma Assert (Check_Signature (Obj_Tag, Must_Be_Primary_DT));
+      pragma Assert (Check_Signature (Typ_Tag, Must_Be_Primary_DT));
+      Pos := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
       return Pos >= 0 and then TSD (Obj_Tag).Tags_Table (Pos) = Typ_Tag;
    end CW_Membership;
 
@@ -353,23 +536,34 @@ package body Ada.Tags is
    --  Obj is in Iface'Class if Iface'Tag is found in the table of interfaces
    --  that are contained in the dispatch table referenced by Obj'Tag.
 
-   function IW_Membership
-     (This : System.Address;
-      T    : Tag) return Boolean
-   is
+   function IW_Membership (This : System.Address; T : Tag) return Boolean is
       Curr_DT  : constant Tag := To_Tag_Ptr (This).all;
-      Obj_Base : constant System.Address := This - Offset_To_Top (Curr_DT);
-      Obj_DT   : constant Tag := To_Tag_Ptr (Obj_Base).all;
-
-      Obj_TSD : constant Type_Specific_Data_Ptr := TSD (Obj_DT);
-      Last_Id : constant Natural := Obj_TSD.Idepth + Obj_TSD.Num_Interfaces;
-      Id      : Natural;
+      Id       : Natural;
+      Last_Id  : Natural;
+      Obj_Base : System.Address;
+      Obj_DT   : Tag;
+      Obj_TSD  : Type_Specific_Data_Ptr;
 
    begin
+      pragma Assert
+        (Check_Signature (Curr_DT, Must_Be_Primary_Or_Secondary_DT));
+      pragma Assert
+        (Check_Signature (T, Must_Be_Primary_Or_Interface));
+
+      Obj_Base := This - Offset_To_Top (Curr_DT);
+      Obj_DT   := To_Tag_Ptr (Obj_Base).all;
+
+      pragma Assert
+        (Check_Signature (Curr_DT, Must_Be_Primary_DT));
+
+      Obj_TSD := TSD (Obj_DT);
+      Last_Id := Obj_TSD.Idepth + Obj_TSD.Num_Interfaces;
+
       if Obj_TSD.Num_Interfaces > 0 then
 
          --  Traverse the ancestor tags table plus the interface tags table.
-         --  The former part is required to give support to:
+         --  The former part is required for:
+
          --     Iface_CW in Typ'Class
 
          Id := 0;
@@ -391,9 +585,13 @@ package body Ada.Tags is
    --------------------
 
    function Descendant_Tag (External : String; Ancestor : Tag) return Tag is
-      Int_Tag : constant Tag := Internal_Tag (External);
+      Int_Tag : Tag;
 
    begin
+      pragma Assert (Check_Signature (Ancestor, Must_Be_Primary_DT));
+      Int_Tag := Internal_Tag (External);
+      pragma Assert (Check_Signature (Int_Tag, Must_Be_Primary_DT));
+
       if not Is_Descendant_At_Same_Level (Int_Tag, Ancestor) then
          raise Tag_Error;
       end if;
@@ -413,6 +611,7 @@ package body Ada.Tags is
          raise Tag_Error;
       end if;
 
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       Result := TSD (T).Expanded_Name;
       return Result (1 .. Length (Result));
    end Expanded_Name;
@@ -423,11 +622,13 @@ package body Ada.Tags is
 
    function External_Tag (T : Tag) return String is
       Result : Cstring_Ptr;
+
    begin
       if T = No_Tag then
          raise Tag_Error;
       end if;
 
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       Result := TSD (T).External_Tag;
 
       return Result (1 .. Length (Result));
@@ -439,6 +640,7 @@ package body Ada.Tags is
 
    function Get_Access_Level (T : Tag) return Natural is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return TSD (T).Access_Level;
    end Get_Access_Level;
 
@@ -446,11 +648,12 @@ package body Ada.Tags is
    -- Get_Entry_Index --
    ---------------------
 
-   function Get_Entry_Index
-     (T        : Tag;
-      Position : Positive) return Positive is
+   function Get_Entry_Index (T : Tag; Position : Positive) return Positive is
+      Index : constant Integer := Position - Default_Prim_Op_Count;
    begin
-      return TSD (T).Ent_Index_Table (Position - Default_Prim_Op_Count);
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      pragma Assert (Index > 0);
+      return SSD (T).SSD_Table (Index).Index;
    end Get_Entry_Index;
 
    ----------------------
@@ -459,17 +662,36 @@ package body Ada.Tags is
 
    function Get_External_Tag (T : Tag) return System.Address is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return To_Address (TSD (T).External_Tag);
    end Get_External_Tag;
 
+   ----------------------
+   -- Get_Num_Prim_Ops --
+   ----------------------
+
+   function Get_Num_Prim_Ops (T : Tag) return Natural is
+   begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
+
+      if Is_Primary_DT (T) then
+         return TSD (T).Num_Prim_Ops;
+      else
+         return OSD (Interface_Tag (T)).Num_Prim_Ops;
+      end if;
+   end Get_Num_Prim_Ops;
+
    -------------------------
    -- Get_Prim_Op_Address --
    -------------------------
 
    function Get_Prim_Op_Address
      (T        : Tag;
-      Position : Positive) return System.Address is
+      Position : Positive) return System.Address
+   is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
+      pragma Assert (Check_Index (T, Position));
       return T.Prims_Ptr (Position);
    end Get_Prim_Op_Address;
 
@@ -479,17 +701,37 @@ package body Ada.Tags is
 
    function Get_Prim_Op_Kind
      (T        : Tag;
-      Position : Positive) return Prim_Op_Kind is
+      Position : Positive) return Prim_Op_Kind
+   is
+      Index : constant Integer := Position - Default_Prim_Op_Count;
    begin
-      return TSD (T).POK_Table (Position - Default_Prim_Op_Count);
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      pragma Assert (Index > 0);
+      return SSD (T).SSD_Table (Index).Kind;
    end Get_Prim_Op_Kind;
 
+   ----------------------
+   -- Get_Offset_Index --
+   ----------------------
+
+   function Get_Offset_Index
+     (T        : Interface_Tag;
+      Position : Positive) return Positive
+   is
+      Index : constant Integer := Position - Default_Prim_Op_Count;
+   begin
+      pragma Assert (Check_Signature (Tag (T), Must_Be_Secondary_DT));
+      pragma Assert (Index > 0);
+      return OSD (T).OSD_Table (Index);
+   end Get_Offset_Index;
+
    -------------------
    -- Get_RC_Offset --
    -------------------
 
    function Get_RC_Offset (T : Tag) return SSE.Storage_Offset is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return TSD (T).RC_Offset;
    end Get_RC_Offset;
 
@@ -499,6 +741,7 @@ package body Ada.Tags is
 
    function Get_Remotely_Callable (T : Tag) return Boolean is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       return TSD (T).Remotely_Callable;
    end Get_Remotely_Callable;
 
@@ -506,12 +749,12 @@ package body Ada.Tags is
    -- Inherit_DT --
    ----------------
 
-   procedure Inherit_DT
-    (Old_T       : Tag;
-     New_T       : Tag;
-     Entry_Count : Natural)
-   is
+   procedure Inherit_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural) is
    begin
+      pragma Assert (Check_Signature (Old_T, Must_Be_Primary_Or_Secondary_DT));
+      pragma Assert (Check_Signature (New_T, Must_Be_Primary_Or_Secondary_DT));
+      pragma Assert (Check_Size (Old_T, New_T, Entry_Count));
+
       if Old_T /= null then
          New_T.Prims_Ptr (1 .. Entry_Count) :=
            Old_T.Prims_Ptr (1 .. Entry_Count);
@@ -523,17 +766,22 @@ package body Ada.Tags is
    -----------------
 
    procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag) is
-      New_TSD_Ptr : constant Type_Specific_Data_Ptr := TSD (New_Tag);
+      New_TSD_Ptr : Type_Specific_Data_Ptr;
       Old_TSD_Ptr : Type_Specific_Data_Ptr;
 
    begin
+      pragma Assert (Check_Signature (New_Tag, Must_Be_Primary_Or_Interface));
+      New_TSD_Ptr := TSD (New_Tag);
+
       if Old_Tag /= null then
+         pragma Assert
+           (Check_Signature (Old_Tag, Must_Be_Primary_Or_Interface));
          Old_TSD_Ptr := TSD (Old_Tag);
          New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
          New_TSD_Ptr.Num_Interfaces := Old_TSD_Ptr.Num_Interfaces;
 
          --  Copy the "table of ancestor tags" plus the "table of interfaces"
-         --  of the parent
+         --  of the parent.
 
          New_TSD_Ptr.Tags_Table
            (1 .. New_TSD_Ptr.Idepth + New_TSD_Ptr.Num_Interfaces) :=
@@ -557,7 +805,7 @@ package body Ada.Tags is
 
    begin
       --  Make a copy of the string representing the external tag with
-      --  a null at the end
+      --  a null at the end.
 
       Ext_Copy (External'Range) := External;
       Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
@@ -567,6 +815,7 @@ package body Ada.Tags is
          declare
             Msg1 : constant String := "unknown tagged type: ";
             Msg2 : String (1 .. Msg1'Length + External'Length);
+
          begin
             Msg2 (1 .. Msg1'Length) := Msg1;
             Msg2 (Msg1'Length + 1 .. Msg1'Length + External'Length) :=
@@ -591,6 +840,20 @@ package body Ada.Tags is
         and then TSD (Descendant).Access_Level = TSD (Ancestor).Access_Level;
    end Is_Descendant_At_Same_Level;
 
+   -------------------
+   -- Is_Primary_DT --
+   -------------------
+
+   function Is_Primary_DT (T : Tag) return Boolean is
+      Offset_To_Top_Ptr : constant Storage_Offset_Ptr :=
+                            To_Storage_Offset_Ptr (To_Address (T)
+                              - Offset_To_Signature);
+      Signature         : constant Signature_Values :=
+                            To_Signature_Values (Offset_To_Top_Ptr.all);
+   begin
+      return Signature (2) = Primary_DT;
+   end Is_Primary_DT;
+
    ------------
    -- Length --
    ------------
@@ -617,32 +880,45 @@ package body Ada.Tags is
                             To_Storage_Offset_Ptr (To_Address (T)
                               - DT_Typeinfo_Ptr_Size
                               - DT_Offset_To_Top_Size);
+
    begin
       return Offset_To_Top_Ptr.all;
    end Offset_To_Top;
 
+   ---------
+   -- OSD --
+   ---------
+
+   function OSD
+     (T : Interface_Tag) return Object_Specific_Data_Ptr
+   is
+      OSD_Ptr : Addr_Ptr;
+
+   begin
+      OSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+      return To_Object_Specific_Data_Ptr (OSD_Ptr.all);
+   end OSD;
+
    -----------------
    -- Parent_Size --
    -----------------
 
-   type Acc_Size
-     is access function (A : System.Address) return Long_Long_Integer;
-
-   function To_Acc_Size is new Unchecked_Conversion (System.Address, Acc_Size);
-   --  The profile of the implicitly defined _size primitive
-
    function Parent_Size
      (Obj : System.Address;
       T   : Tag) return SSE.Storage_Count
    is
-      Parent_Tag : constant Tag := TSD (T).Tags_Table (1);
+      Parent_Tag : Tag;
       --  The tag of the parent type through the dispatch table
 
-      F : constant Acc_Size := To_Acc_Size (Parent_Tag.Prims_Ptr (1));
+      F : Acc_Size;
       --  Access to the _size primitive of the parent. We assume that it is
-      --  always in the first slot of the dispatch table
+      --  always in the first slot of the dispatch table.
 
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      Parent_Tag := TSD (T).Tags_Table (1);
+      F := To_Acc_Size (Parent_Tag.Prims_Ptr (1));
+
       --  Here we compute the size of the _parent field of the object
 
       return SSE.Storage_Count (F.all (Obj));
@@ -658,6 +934,8 @@ package body Ada.Tags is
          raise Tag_Error;
       end if;
 
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+
       --  The Parent_Tag of a root-level tagged type is defined to be No_Tag.
       --  The first entry in the Ancestors_Tags array will be null for such
       --  a type, but it's better to be explicit about returning No_Tag in
@@ -674,20 +952,24 @@ package body Ada.Tags is
    -- Register_Interface_Tag --
    ----------------------------
 
-   procedure Register_Interface_Tag
-    (T           : Tag;
-     Interface_T : Tag)
-   is
-      New_T_TSD : constant Type_Specific_Data_Ptr := TSD (T);
+   procedure Register_Interface_Tag (T : Tag; Interface_T : Tag) is
+      New_T_TSD : Type_Specific_Data_Ptr;
       Index     : Natural;
+
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      pragma Assert (Check_Signature (Interface_T, Must_Be_Interface));
+
+      New_T_TSD := TSD (T);
+
       --  Check if the interface is already registered
 
       if New_T_TSD.Num_Interfaces > 0 then
          declare
-            Id       : Natural          := New_T_TSD.Idepth + 1;
-            Last_Id  : constant Natural := New_T_TSD.Idepth
+            Id      : Natural          := New_T_TSD.Idepth + 1;
+            Last_Id : constant Natural := New_T_TSD.Idepth
                                             + New_T_TSD.Num_Interfaces;
+
          begin
             loop
                if New_T_TSD.Tags_Table (Id) = Interface_T then
@@ -720,6 +1002,7 @@ package body Ada.Tags is
 
    procedure Set_Access_Level (T : Tag; Value : Natural) is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       TSD (T).Access_Level := Value;
    end Set_Access_Level;
 
@@ -730,9 +1013,14 @@ package body Ada.Tags is
    procedure Set_Entry_Index
      (T        : Tag;
       Position : Positive;
-      Value    : Positive) is
+      Value    : Positive)
+   is
+      Index : constant Integer := Position - Default_Prim_Op_Count;
+
    begin
-      TSD (T).Ent_Index_Table (Position - Default_Prim_Op_Count) := Value;
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      pragma Assert (Index > 0);
+      SSD (T).SSD_Table (Index).Index := Value;
    end Set_Entry_Index;
 
    -----------------------
@@ -741,6 +1029,8 @@ package body Ada.Tags is
 
    procedure Set_Expanded_Name (T : Tag; Value : System.Address) is
    begin
+      pragma Assert
+        (Check_Signature (T, Must_Be_Primary_Or_Interface));
       TSD (T).Expanded_Name := To_Cstring_Ptr (Value);
    end Set_Expanded_Name;
 
@@ -750,9 +1040,41 @@ package body Ada.Tags is
 
    procedure Set_External_Tag (T : Tag; Value : System.Address) is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
       TSD (T).External_Tag := To_Cstring_Ptr (Value);
    end Set_External_Tag;
 
+   ----------------------
+   -- Set_Num_Prim_Ops --
+   ----------------------
+
+   procedure Set_Num_Prim_Ops (T : Tag; Value : Natural) is
+   begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
+
+      if Is_Primary_DT (T) then
+         TSD (T).Num_Prim_Ops := Value;
+      else
+         OSD (Interface_Tag (T)).Num_Prim_Ops := Value;
+      end if;
+   end Set_Num_Prim_Ops;
+
+   ----------------------
+   -- Set_Offset_Index --
+   ----------------------
+
+   procedure Set_Offset_Index
+     (T        : Interface_Tag;
+      Position : Positive;
+      Value    : Positive)
+   is
+      Index : constant Integer := Position - Default_Prim_Op_Count;
+   begin
+      pragma Assert (Check_Signature (Tag (T), Must_Be_Secondary_DT));
+      pragma Assert (Index > 0);
+      OSD (T).OSD_Table (Index) := Value;
+   end Set_Offset_Index;
+
    -----------------------
    -- Set_Offset_To_Top --
    -----------------------
@@ -766,9 +1088,22 @@ package body Ada.Tags is
                               - DT_Typeinfo_Ptr_Size
                               - DT_Offset_To_Top_Size);
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
       Offset_To_Top_Ptr.all := Value;
    end Set_Offset_To_Top;
 
+   -------------
+   -- Set_OSD --
+   -------------
+
+   procedure Set_OSD (T : Interface_Tag; Value : System.Address) is
+      OSD_Ptr : Addr_Ptr;
+   begin
+      pragma Assert (Check_Signature (Tag (T), Must_Be_Secondary_DT));
+      OSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+      OSD_Ptr.all := Value;
+   end Set_OSD;
+
    -------------------------
    -- Set_Prim_Op_Address --
    -------------------------
@@ -776,8 +1111,11 @@ package body Ada.Tags is
    procedure Set_Prim_Op_Address
      (T        : Tag;
       Position : Positive;
-      Value    : System.Address) is
+      Value    : System.Address)
+   is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
+      pragma Assert (Check_Index (T, Position));
       T.Prims_Ptr (Position) := Value;
    end Set_Prim_Op_Address;
 
@@ -788,9 +1126,13 @@ package body Ada.Tags is
    procedure Set_Prim_Op_Kind
      (T        : Tag;
       Position : Positive;
-      Value    : Prim_Op_Kind) is
+      Value    : Prim_Op_Kind)
+   is
+      Index : constant Integer := Position - Default_Prim_Op_Count;
    begin
-      TSD (T).POK_Table (Position - Default_Prim_Op_Count) := Value;
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      pragma Assert (Index > 0);
+      SSD (T).SSD_Table (Index).Kind := Value;
    end Set_Prim_Op_Kind;
 
    -------------------
@@ -799,6 +1141,7 @@ package body Ada.Tags is
 
    procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset) is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       TSD (T).RC_Offset := Value;
    end Set_RC_Offset;
 
@@ -808,20 +1151,41 @@ package body Ada.Tags is
 
    procedure Set_Remotely_Callable (T : Tag; Value : Boolean) is
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
       TSD (T).Remotely_Callable := Value;
    end Set_Remotely_Callable;
 
    -------------
+   -- Set_SSD --
+   -------------
+
+   procedure Set_SSD (T : Tag; Value : System.Address) is
+   begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+      TSD (T).SSD_Ptr := Value;
+   end Set_SSD;
+
+   -------------
    -- Set_TSD --
    -------------
 
    procedure Set_TSD (T : Tag; Value : System.Address) is
-      TSD_Ptr : constant Addr_Ptr :=
-                  To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+      TSD_Ptr : Addr_Ptr;
    begin
+      pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
+      TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD_Ptr.all := Value;
    end Set_TSD;
 
+   ---------
+   -- SSD --
+   ---------
+
+   function SSD (T : Tag) return Select_Specific_Data_Ptr is
+   begin
+      return To_Select_Specific_Data_Ptr (TSD (T).SSD_Ptr);
+   end SSD;
+
    ------------------
    -- Typeinfo_Ptr --
    ------------------
diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads
index 34d7d63..46e6c20 100644
--- a/gcc/ada/a-tags.ads
+++ b/gcc/ada/a-tags.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -53,31 +53,38 @@ package Ada.Tags is
 
    function Internal_Tag (External : String) return Tag;
 
-   function Descendant_Tag (External : String; Ancestor : Tag) return Tag;
+   function Descendant_Tag
+     (External : String;
+      Ancestor : Tag) return Tag;
+   pragma Ada_05 (Descendant_Tag);
 
    function Is_Descendant_At_Same_Level
      (Descendant : Tag;
       Ancestor   : Tag) return Boolean;
+   pragma Ada_05 (Is_Descendant_At_Same_Level);
 
    function Parent_Tag (T : Tag) return Tag;
+   pragma Ada_05 (Parent_Tag);
 
    Tag_Error : exception;
 
 private
+   --  The following subprogram specifications are placed here instead of
+   --  the package body to see them from the frontend through rtsfind.
 
    ---------------------------------------------------------------
    -- Abstract Procedural Interface For The GNAT Dispatch Table --
    ---------------------------------------------------------------
 
    --  GNAT's Dispatch Table format is customizable in order to match the
-   --  format used in another language. GNAT supports programs that use
-   --  two different dispatch table formats at the same time: the native
-   --  format that supports Ada 95 tagged types and which is described in
-   --  Ada.Tags, and a foreign format for types that are imported from some
-   --  other language (typically C++) which is described in Interfaces.CPP.
-   --  The runtime information kept for each tagged type is separated into
-   --  two objects: the Dispatch Table and the Type Specific Data record.
-   --  These two objects are allocated statically using the constants:
+   --  format used in another language. GNAT supports programs that use two
+   --  different dispatch table formats at the same time: the native format
+   --  that supports Ada 95 tagged types and which is described in Ada.Tags,
+   --  and a foreign format for types that are imported from some other
+   --  language (typically C++) which is described in Interfaces.CPP. The
+   --  runtime information kept for each tagged type is separated into two
+   --  objects: the Dispatch Table and the Type Specific Data record. These
+   --  two objects are allocated statically using the constants:
 
    --      DT Size  = DT_Prologue_Size  + Nb_Prim * DT_Entry_Size
    --      TSD Size = TSD_Prologue_Size + (1 + Idepth)  * TSD_Entry_Size
@@ -85,9 +92,9 @@ private
    --  where Nb_prim is the number of primitive operations of the given
    --  type and Idepth its inheritance depth.
 
-   --  The compiler generates calls to the following SET routines to
-   --  initialize those structures and uses the GET functions to
-   --  retreive the information when needed
+   --  In order to set or retrieve information from the Dispatch Table or
+   --  the Type Specific Data record, GNAT generates calls to Set_XXX or
+   --  Get_XXX routines, where XXX is the name of the field of interest.
 
    type Dispatch_Table;
    type Tag is access all Dispatch_Table;
@@ -95,6 +102,19 @@ private
 
    No_Tag : constant Tag := null;
 
+   type Object_Specific_Data (Nb_Prim : Positive);
+   type Object_Specific_Data_Ptr is access all Object_Specific_Data;
+   --  Information associated with the secondary dispatch table of tagged-type
+   --  objects implementing abstract interfaces.
+
+   type Select_Specific_Data (Nb_Prim : Positive);
+   type Select_Specific_Data_Ptr is access all Select_Specific_Data;
+   --  A table used to store the primitive operation kind and entry index of
+   --  primitive subprograms of a type that implements a limited interface.
+   --  The Select Specific Data table resides in the Type Specific Data of a
+   --  type. This construct is used in the handling of dispatching triggers
+   --  in select statements.
+
    type Type_Specific_Data;
    type Type_Specific_Data_Ptr is access all Type_Specific_Data;
 
@@ -109,17 +129,16 @@ private
       POK_Protected_Function,
       POK_Protected_Procedure,
       POK_Task_Entry,
+      POK_Task_Function,
       POK_Task_Procedure);
 
-   --  Number of predefined primitive operations added by the Expander
-   --  for a tagged type. It is utilized for indexing in the two auxiliary
-   --  tables used for dispatching asynchronous, conditional and timed
-   --  selects. In order to be space efficien, indexing is performed by
-   --  subtracting this constant value from the provided position in the
-   --  auxiliary tables.
-   --  This value is mirrored from Exp_Disp.ads.
-
-   Default_Prim_Op_Count : constant Positive := 14;
+   Default_Prim_Op_Count : constant Positive := 15;
+   --  Number of predefined primitive operations added by the Expander for a
+   --  tagged type. It is utilized for indexing in the two auxiliary tables
+   --  used for dispatching asynchronous, conditional and timed selects. In
+   --  order to be space efficient, indexing is performed by subtracting this
+   --  constant value from the provided position in the auxiliary tables (must
+   --  match Exp_Disp.Default_Prim_Op_Count).
 
    package SSE renames System.Storage_Elements;
 
@@ -127,9 +146,7 @@ private
    --  Given the tag of an object and the tag associated to a type, return
    --  true if Obj is in Typ'Class.
 
-   function IW_Membership
-     (This : System.Address;
-      T    : Tag) return Boolean;
+   function IW_Membership (This : System.Address; T : Tag) return Boolean;
    --  Ada 2005 (AI-251): General routine that checks if a given object
    --  implements a tagged type. Its common usage is to check if Obj is in
    --  Iface'Class, but it is also used to check if a class-wide interface
@@ -147,22 +164,27 @@ private
    --  Given the tag associated with a type, returns the accessibility level
    --  of the type.
 
-   function Get_Entry_Index
-     (T        : Tag;
-      Position : Positive) return Positive;
+   function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
    --  Return a primitive operation's entry index (if entry) given a dispatch
    --  table T and a position of a primitive operation in T.
 
    function Get_External_Tag (T : Tag) return System.Address;
    --  Retrieve the address of a null terminated string containing
-   --  the external name
+   --  the external name.
+
+   function Get_Offset_Index
+     (T        : Interface_Tag;
+      Position : Positive) return Positive;
+   --  Given a pointer to a secondary dispatch table (T) and a position of an
+   --  operation in the DT, retrieve the corresponding operation's position in
+   --  the primary dispatch table from the Offset Specific Data table of T.
 
    function Get_Prim_Op_Address
      (T        : Tag;
       Position : Positive) return System.Address;
    --  Given a pointer to a dispatch table (T) and a position in the DT
    --  this function returns the address of the virtual function stored
-   --  in it (used for dispatching calls)
+   --  in it (used for dispatching calls).
 
    function Get_Prim_Op_Kind
      (T        : Tag;
@@ -182,10 +204,7 @@ private
    function Get_Remotely_Callable (T : Tag) return Boolean;
    --  Return the value previously set by Set_Remotely_Callable
 
-   procedure Inherit_DT
-    (Old_T       : Tag;
-     New_T       : Tag;
-     Entry_Count : Natural);
+   procedure Inherit_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural);
    --  Entry point used to initialize the DT of a type knowing the tag
    --  of the direct ancestor and the number of primitive ops that are
    --  inherited (Entry_Count).
@@ -193,21 +212,23 @@ private
    procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag);
    --  Initialize the TSD of a type knowing the tag of the direct ancestor
 
+   function OSD (T : Interface_Tag) return Object_Specific_Data_Ptr;
+   --  Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table,
+   --  retrieve the address of the record containing the Objet Specific
+   --  Data table.
+
    function Parent_Size
      (Obj : System.Address;
       T   : Tag) return SSE.Storage_Count;
-   --  Computes the size the ancestor part of a tagged extension object
-   --  whose address is 'obj' by calling the indirectly _size function of
-   --  the ancestor. The ancestor is the parent of the type represented by
-   --  tag T. This function assumes that _size is always in slot 1 of
-   --  the dispatch table.
+   --  Computes the size the ancestor part of a tagged extension object whose
+   --  address is 'obj' by calling indirectly the ancestor _size function. The
+   --  ancestor is the parent of the type represented by tag T. This function
+   --  assumes that _size is always in slot one of the dispatch table.
 
    pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
    --  This procedure is used in s-finimp and is thus exported manually
 
-   procedure Register_Interface_Tag
-    (T           : Tag;
-     Interface_T : Tag);
+   procedure Register_Interface_Tag (T : Tag; Interface_T : Tag);
    --  Ada 2005 (AI-251): Used to initialize the table of interfaces
    --  implemented by a type. Required to give support to IW_Membership.
 
@@ -215,13 +236,21 @@ private
    --  Insert the Tag and its associated external_tag in a table for the
    --  sake of Internal_Tag
 
-   procedure Set_Entry_Index
-     (T        : Tag;
-      Position : Positive;
-      Value    : Positive);
+   procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
    --  Set the entry index of a primitive operation in T's TSD table indexed
    --  by Position.
 
+   procedure Set_Num_Prim_Ops (T : Tag; Value : Natural);
+   --  Set the number of primitive operations in the dispatch table of T. This
+   --  is used for debugging purposes.
+
+   procedure Set_Offset_Index
+     (T        : Interface_Tag;
+      Position : Positive;
+      Value    : Positive);
+   --  Set the offset value of a primitive operation in a secondary dispatch
+   --  table denoted by T, indexed by Position.
+
    procedure Set_Offset_To_Top
      (T     : Tag;
       Value : System.Storage_Elements.Storage_Offset);
@@ -230,6 +259,10 @@ private
    --  is always 0; in secondary dispatch tables this is the offset to the base
    --  of the enclosing type.
 
+   procedure Set_OSD (T : Interface_Tag; Value : System.Address);
+   --  Given a pointer T to a secondary dispatch table, store the pointer to
+   --  the record containing the Object Specific Data generated by GNAT.
+
    procedure Set_Prim_Op_Address
      (T        : Tag;
       Position : Positive;
@@ -245,6 +278,10 @@ private
    --  Set the kind of a primitive operation in T's TSD table indexed by
    --  Position.
 
+   procedure Set_SSD (T : Tag; Value : System.Address);
+   --  Given a pointer T to a dispatch Table, stores the pointer to the record
+   --  containing the Select Specific Data generated by GNAT.
+
    procedure Set_TSD (T : Tag; Value : System.Address);
    --  Given a pointer T to a dispatch Table, stores the address of the record
    --  containing the Type Specific Data generated by GNAT.
@@ -269,15 +306,24 @@ private
    --  Set to true if the type has been declared in a context described
    --  in E.4 (18).
 
+   function SSD (T : Tag) return Select_Specific_Data_Ptr;
+   --  Given a pointer T to a dispatch Table, retrieves the address of the
+   --  record containing the Select Specific Data in T's TSD.
+
    function TSD (T : Tag) return Type_Specific_Data_Ptr;
-   --  Given a pointer T to a dispatch Table, retreives the address of the
-   --  record containing the Type Specific Data generated by GNAT
+   --  Given a pointer T to a dispatch Table, retrieves the address of the
+   --  record containing the Type Specific Data generated by GNAT.
 
    DT_Prologue_Size : constant SSE.Storage_Count :=
                         SSE.Storage_Count
-                          (2 * (Standard'Address_Size / System.Storage_Unit));
+                          (3 * (Standard'Address_Size / System.Storage_Unit));
    --  Size of the first part of the dispatch table
 
+   DT_Signature_Size : constant SSE.Storage_Count :=
+                         SSE.Storage_Count
+                           (Standard'Address_Size / System.Storage_Unit);
+   --  Size of the Signature field of the dispatch table
+
    DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
                             SSE.Storage_Count
                               (Standard'Address_Size / System.Storage_Unit);
@@ -295,7 +341,7 @@ private
 
    TSD_Prologue_Size : constant SSE.Storage_Count :=
                          SSE.Storage_Count
-                           (8 * (Standard'Address_Size / System.Storage_Unit));
+                          (10 * (Standard'Address_Size / System.Storage_Unit));
    --  Size of the first part of the type specific data
 
    TSD_Entry_Size : constant SSE.Storage_Count :=
@@ -308,22 +354,57 @@ private
    --  of this type are declared with a dummy size of 1, the actual size
    --  depending on the number of primitive operations.
 
-   --  Unchecked Conversions for Tag and TSD
+   type Signature_Kind is
+      (Unknown,
+       Valid_Signature,
+       Primary_DT,
+       Secondary_DT,
+       Abstract_Interface);
+   for Signature_Kind'Size use 8;
+   --  Kind of signature found in the header of the dispatch table. These
+   --  signatures are generated by the frontend and are used by the Check_XXX
+   --  routines to ensure that the kind of dispatch table managed by each of
+   --  the routines in this package is correct. This additional check is only
+   --  performed with this run-time package is compiled with assertions enabled
+
+   --  The signature is a sequence of two bytes. The first byte must have the
+   --  value Valid_Signature, and the second byte must have a value in the
+   --  range Primary_DT .. Abstract_Interface. The Unknown value is used by
+   --  the Check_XXX routines to indicate that the signature is wrong.
+
+   --  Unchecked Conversions
+
+   type Addr_Ptr is access System.Address;
+   type Tag_Ptr  is access Tag;
+
+   type Signature_Values is
+      array (1 .. DT_Signature_Size) of Signature_Kind;
+   --  Type used to see the signature as a sequence of Signature_Kind values
+
+   function To_Addr_Ptr is
+      new Unchecked_Conversion (System.Address, Addr_Ptr);
 
    function To_Type_Specific_Data_Ptr is
      new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
 
    function To_Address is
-     new Unchecked_Conversion (Type_Specific_Data_Ptr, System.Address);
+     new Unchecked_Conversion (Interface_Tag, System.Address);
 
    function To_Address is
      new Unchecked_Conversion (Tag, System.Address);
 
-   type Addr_Ptr is access System.Address;
-   type Tag_Ptr  is access Tag;
+   function To_Address is
+     new Unchecked_Conversion (Type_Specific_Data_Ptr, System.Address);
 
-   function To_Addr_Ptr is
-      new Unchecked_Conversion (System.Address, Addr_Ptr);
+   function To_Object_Specific_Data_Ptr is
+     new Unchecked_Conversion (System.Address, Object_Specific_Data_Ptr);
+
+   function To_Select_Specific_Data_Ptr is
+     new Unchecked_Conversion (System.Address, Select_Specific_Data_Ptr);
+
+   function To_Signature_Values is
+     new Unchecked_Conversion (System.Storage_Elements.Storage_Offset,
+                               Signature_Values);
 
    function To_Tag_Ptr is
      new Unchecked_Conversion (System.Address, Tag_Ptr);
@@ -334,21 +415,32 @@ private
    pragma Inline_Always (CW_Membership);
    pragma Inline_Always (IW_Membership);
    pragma Inline_Always (Get_Access_Level);
+   pragma Inline_Always (Get_Entry_Index);
+   pragma Inline_Always (Get_Offset_Index);
    pragma Inline_Always (Get_Prim_Op_Address);
+   pragma Inline_Always (Get_Prim_Op_Kind);
    pragma Inline_Always (Get_RC_Offset);
    pragma Inline_Always (Get_Remotely_Callable);
    pragma Inline_Always (Inherit_DT);
    pragma Inline_Always (Inherit_TSD);
+   pragma Inline_Always (OSD);
    pragma Inline_Always (Register_Interface_Tag);
    pragma Inline_Always (Register_Tag);
    pragma Inline_Always (Set_Access_Level);
+   pragma Inline_Always (Set_Entry_Index);
    pragma Inline_Always (Set_Expanded_Name);
    pragma Inline_Always (Set_External_Tag);
+   pragma Inline_Always (Set_Num_Prim_Ops);
+   pragma Inline_Always (Set_Offset_Index);
    pragma Inline_Always (Set_Offset_To_Top);
    pragma Inline_Always (Set_Prim_Op_Address);
+   pragma Inline_Always (Set_Prim_Op_Kind);
    pragma Inline_Always (Set_RC_Offset);
    pragma Inline_Always (Set_Remotely_Callable);
+   pragma Inline_Always (Set_OSD);
+   pragma Inline_Always (Set_SSD);
    pragma Inline_Always (Set_TSD);
+   pragma Inline_Always (SSD);
    pragma Inline_Always (TSD);
 
 end Ada.Tags;
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index db44614..c126bd8 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -214,8 +214,10 @@ package body Einfo is
    --    Abstract_Interfaces             Elist24
 
    --    Abstract_Interface_Alias        Node25
+   --    Current_Use_Clause              Node25
 
    --    Overridden_Operation            Node26
+   --    Package_Instantiation           Node26
 
    --    Wrapped_Entity                  Node27
 
@@ -388,7 +390,7 @@ package body Einfo is
    --    Has_Recursive_Call             Flag143
    --    Is_Unsigned_Type               Flag144
    --    Strict_Alignment               Flag145
-   --    Elaborate_All_Desirable        Flag146
+   --    (unused)                       Flag146
    --    Needs_Debug_Info               Flag147
    --    Suppress_Elaboration_Warnings  Flag148
    --    Is_Compilation_Unit            Flag149
@@ -444,12 +446,13 @@ package body Einfo is
    --    Is_Local_Anonymous_Access      Flag194
    --    Is_Primitive_Wrapper           Flag195
    --    Was_Hidden                     Flag196
+   --    Is_Limited_Interface           Flag197
+   --    Is_Protected_Interface         Flag198
+   --    Is_Synchronized_Interface      Flag199
+   --    Is_Task_Interface              Flag200
+
+   --    Has_Anon_Block_Suffix          Flag201
 
-   --    (unused)                       Flag197
-   --    (unused)                       Flag198
-   --    (unused)                       Flag199
-   --    (unused)                       Flag200
-   --    (unused)                       Flag201
    --    (unused)                       Flag202
    --    (unused)                       Flag203
    --    (unused)                       Flag204
@@ -698,6 +701,12 @@ package body Einfo is
       return Node22 (Id);
    end Corresponding_Remote_Type;
 
+   function Current_Use_Clause (Id : E) return E is
+   begin
+      pragma Assert (Ekind (Id) = E_Package);
+      return Node25 (Id);
+   end Current_Use_Clause;
+
    function Current_Value (Id : E) return N is
    begin
       pragma Assert (Ekind (Id) in Object_Kind);
@@ -839,11 +848,6 @@ package body Einfo is
       return Node16 (Id);
    end DTC_Entity;
 
-   function Elaborate_All_Desirable (Id : E) return B is
-   begin
-      return Flag146 (Id);
-   end Elaborate_All_Desirable;
-
    function Elaboration_Entity (Id : E) return E is
    begin
       pragma Assert
@@ -1073,6 +1077,11 @@ package body Einfo is
       return Flag79 (Id);
    end Has_All_Calls_Remote;
 
+   function Has_Anon_Block_Suffix (Id : E) return B is
+   begin
+      return Flag201 (Id);
+   end Has_Anon_Block_Suffix;
+
    function Has_Atomic_Components (Id : E) return B is
    begin
       return Flag86 (Implementation_Base_Type (Id));
@@ -1667,6 +1676,12 @@ package body Einfo is
       return Flag106 (Id);
    end Is_Limited_Composite;
 
+   function Is_Limited_Interface (Id : E) return B is
+   begin
+      pragma Assert (Is_Interface (Id));
+      return Flag197 (Id);
+   end Is_Limited_Interface;
+
    function Is_Limited_Record (Id : E) return B is
    begin
       return Flag25 (Id);
@@ -1750,6 +1765,12 @@ package body Einfo is
       return Flag53 (Id);
    end Is_Private_Descendant;
 
+   function Is_Protected_Interface (Id : E) return B is
+   begin
+      pragma Assert (Is_Interface (Id));
+      return Flag198 (Id);
+   end Is_Protected_Interface;
+
    function Is_Public (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -1792,6 +1813,12 @@ package body Einfo is
       return Flag28 (Id);
    end Is_Statically_Allocated;
 
+   function Is_Synchronized_Interface (Id : E) return B is
+   begin
+      pragma Assert (Is_Interface (Id));
+      return Flag199 (Id);
+   end Is_Synchronized_Interface;
+
    function Is_Tag (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -1803,6 +1830,12 @@ package body Einfo is
       return Flag55 (Id);
    end Is_Tagged_Type;
 
+   function Is_Task_Interface (Id : E) return B is
+   begin
+      pragma Assert (Is_Interface (Id));
+      return Flag200 (Id);
+   end Is_Task_Interface;
+
    function Is_Thread_Body (Id : E) return B is
    begin
       return Flag77 (Id);
@@ -2016,7 +2049,8 @@ package body Einfo is
 
    function Obsolescent_Warning (Id : E) return N is
    begin
-      pragma Assert (Is_Subprogram (Id));
+      pragma Assert
+        (Is_Subprogram (Id) or else Is_Package_Or_Generic_Package (Id));
       return Node24 (Id);
    end Obsolescent_Warning;
 
@@ -2048,6 +2082,15 @@ package body Einfo is
       return Node26 (Id);
    end Overridden_Operation;
 
+   function Package_Instantiation (Id : E) return N is
+   begin
+      pragma Assert
+        (False
+           or else Ekind (Id) = E_Generic_Package
+           or else Ekind (Id) = E_Package);
+      return Node26 (Id);
+   end Package_Instantiation;
+
    function Packed_Array_Type (Id : E) return E is
    begin
       pragma Assert (Is_Array_Type (Id));
@@ -2744,7 +2787,13 @@ package body Einfo is
       Set_Node22 (Id, V);
    end Set_Corresponding_Remote_Type;
 
-   procedure Set_Current_Value (Id : E; V : E) is
+   procedure Set_Current_Use_Clause (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind (Id) = E_Package);
+      Set_Node25 (Id, V);
+   end Set_Current_Use_Clause;
+
+   procedure Set_Current_Value (Id : E; V : N) is
    begin
       pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
       Set_Node9 (Id, V);
@@ -2888,11 +2937,6 @@ package body Einfo is
       Set_Node16 (Id, V);
    end Set_DTC_Entity;
 
-   procedure Set_Elaborate_All_Desirable (Id : E; V : B := True) is
-   begin
-      Set_Flag146 (Id, V);
-   end Set_Elaborate_All_Desirable;
-
    procedure Set_Elaboration_Entity (Id : E; V : E) is
    begin
       pragma Assert
@@ -3126,6 +3170,11 @@ package body Einfo is
       Set_Flag79 (Id, V);
    end Set_Has_All_Calls_Remote;
 
+   procedure Set_Has_Anon_Block_Suffix (Id : E; V : B := True) is
+   begin
+      Set_Flag201 (Id, V);
+   end Set_Has_Anon_Block_Suffix;
+
    procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
    begin
       pragma Assert (not Is_Type (Id) or else Base_Type (Id) = Id);
@@ -3754,6 +3803,12 @@ package body Einfo is
       Set_Flag106 (Id, V);
    end Set_Is_Limited_Composite;
 
+   procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Interface (Id));
+      Set_Flag197 (Id, V);
+   end Set_Is_Limited_Interface;
+
    procedure Set_Is_Limited_Record (Id : E; V : B := True) is
    begin
       Set_Flag25 (Id, V);
@@ -3838,6 +3893,12 @@ package body Einfo is
       Set_Flag53 (Id, V);
    end Set_Is_Private_Descendant;
 
+   procedure Set_Is_Protected_Interface (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Interface (Id));
+      Set_Flag198 (Id, V);
+   end Set_Is_Protected_Interface;
+
    procedure Set_Is_Public (Id : E; V : B := True) is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -3886,6 +3947,12 @@ package body Einfo is
       Set_Flag28 (Id, V);
    end Set_Is_Statically_Allocated;
 
+   procedure Set_Is_Synchronized_Interface (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Interface (Id));
+      Set_Flag199 (Id, V);
+   end Set_Is_Synchronized_Interface;
+
    procedure Set_Is_Tag (Id : E; V : B := True) is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -3902,6 +3969,12 @@ package body Einfo is
       Set_Flag77 (Id, V);
    end Set_Is_Thread_Body;
 
+   procedure Set_Is_Task_Interface (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Interface (Id));
+      Set_Flag200 (Id, V);
+   end Set_Is_Task_Interface;
+
    procedure Set_Is_True_Constant (Id : E; V : B := True) is
    begin
       Set_Flag163 (Id, V);
@@ -4108,7 +4181,8 @@ package body Einfo is
 
    procedure Set_Obsolescent_Warning (Id : E; V : N) is
    begin
-      pragma Assert (Is_Subprogram (Id));
+      pragma Assert
+        (Is_Subprogram (Id) or else Is_Package_Or_Generic_Package (Id));
       Set_Node24 (Id, V);
    end Set_Obsolescent_Warning;
 
@@ -4140,6 +4214,15 @@ package body Einfo is
       Set_Node26 (Id, V);
    end Set_Overridden_Operation;
 
+   procedure Set_Package_Instantiation (Id : E; V : N) is
+   begin
+      pragma Assert
+        (Ekind (Id) = E_Void
+           or else Ekind (Id) = E_Generic_Package
+           or else Ekind (Id) = E_Package);
+      Set_Node26 (Id, V);
+   end Set_Package_Instantiation;
+
    procedure Set_Packed_Array_Type (Id : E; V : E) is
    begin
       pragma Assert (Is_Array_Type (Id));
@@ -5693,17 +5776,17 @@ package body Einfo is
       end if;
    end Is_Limited_Type;
 
-   ----------------
-   -- Is_Package --
-   ----------------
+   -----------------------------------
+   -- Is_Package_Or_Generic_Package --
+   -----------------------------------
 
-   function Is_Package (Id : E) return B is
+   function Is_Package_Or_Generic_Package (Id : E) return B is
    begin
       return
         Ekind (Id) = E_Package
           or else
         Ekind (Id) = E_Generic_Package;
-   end Is_Package;
+   end Is_Package_Or_Generic_Package;
 
    --------------------------
    -- Is_Protected_Private --
@@ -6466,7 +6549,6 @@ package body Einfo is
       W ("Delay_Subprogram_Descriptors",  Flag50  (Id));
       W ("Depends_On_Private",            Flag14  (Id));
       W ("Discard_Names",                 Flag88  (Id));
-      W ("Elaborate_All_Desirable",       Flag146 (Id));
       W ("Elaboration_Entity_Required",   Flag174 (Id));
       W ("Entry_Accepted",                Flag152 (Id));
       W ("Finalize_Storage_Only",         Flag158 (Id));
@@ -6475,6 +6557,7 @@ package body Einfo is
       W ("Has_Aliased_Components",        Flag135 (Id));
       W ("Has_Alignment_Clause",          Flag46  (Id));
       W ("Has_All_Calls_Remote",          Flag79  (Id));
+      W ("Has_Anon_Block_Suffix",         Flag201 (Id));
       W ("Has_Atomic_Components",         Flag86  (Id));
       W ("Has_Biased_Representation",     Flag139 (Id));
       W ("Has_Completion",                Flag26  (Id));
@@ -6580,6 +6663,7 @@ package body Einfo is
       W ("Is_Known_Valid",                Flag37  (Id));
       W ("Is_Known_Valid",                Flag170 (Id));
       W ("Is_Limited_Composite",          Flag106 (Id));
+      W ("Is_Limited_Interface",          Flag197 (Id));
       W ("Is_Limited_Record",             Flag25  (Id));
       W ("Is_Machine_Code_Subprogram",    Flag137 (Id));
       W ("Is_Non_Static_Subtype",         Flag109 (Id));
@@ -6595,6 +6679,7 @@ package body Einfo is
       W ("Is_Primitive_Wrapper",          Flag195 (Id));
       W ("Is_Private_Composite",          Flag107 (Id));
       W ("Is_Private_Descendant",         Flag53  (Id));
+      W ("Is_Protected_Interface",        Flag198 (Id));
       W ("Is_Public",                     Flag10  (Id));
       W ("Is_Pure",                       Flag44  (Id));
       W ("Is_Pure_Unit_Access_Type",      Flag189 (Id));
@@ -6602,9 +6687,11 @@ package body Einfo is
       W ("Is_Remote_Types",               Flag61  (Id));
       W ("Is_Renaming_Of_Object",         Flag112 (Id));
       W ("Is_Shared_Passive",             Flag60  (Id));
+      W ("Is_Synchronized_Interface",     Flag199 (Id));
       W ("Is_Statically_Allocated",       Flag28  (Id));
       W ("Is_Tag",                        Flag78  (Id));
       W ("Is_Tagged_Type",                Flag55  (Id));
+      W ("Is_Task_Interface",             Flag200 (Id));
       W ("Is_Thread_Body",                Flag77  (Id));
       W ("Is_True_Constant",              Flag163 (Id));
       W ("Is_Unchecked_Union",            Flag117 (Id));
@@ -7526,7 +7613,9 @@ package body Einfo is
               E_Record_Subtype_With_Private              =>
             Write_Str ("Abstract_Interfaces");
 
-         when Subprogram_Kind                            =>
+         when Subprogram_Kind                            |
+              E_Package                                  |
+              E_Generic_Package                          =>
             Write_Str ("Obsolescent_Warning");
 
          when Task_Kind                                  =>
@@ -7548,6 +7637,9 @@ package body Einfo is
               E_Function                                 =>
             Write_Str ("Abstract_Interface_Alias");
 
+         when E_Package                                  =>
+            Write_Str ("Current_Use_Clause");
+
          when others                                     =>
             Write_Str ("Field25??");
       end case;
@@ -7560,6 +7652,10 @@ package body Einfo is
    procedure Write_Field26_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Generic_Package                          |
+              E_Package                                  =>
+            Write_Str ("Package_Instantiation");
+
          when E_Procedure                                |
               E_Function                                 =>
             Write_Str ("Overridden_Operation");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 189a9ec..fa1e584 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -594,6 +594,11 @@ package Einfo is
 --      created at the same time as the discriminal, and used to replace
 --      occurrences of the discriminant within the type declaration.
 
+--    Current_Use_Clause (Node25)
+--      Present in packages. Indicates the use clause currently in scope
+--      that makes the package use_visible. Used to detect redundant use
+--      clauses for the same package.
+
 --    Current_Value (Node9)
 --       Present in E_Variable, E_Out_Parameter and E_In_Out_Parameter
 --       entities. Set non-Empty if the (constant) current value of the
@@ -801,13 +806,6 @@ package Einfo is
 --       Present in all entities. Contains a value of the enumeration type
 --       Entity_Kind declared in a subsequent section in this spec.
 
---    Elaborate_All_Desirable (Flag146)
---       Present in package and subprogram entities, and in generic package
---       and subprogram entities. Set if internal analysis of a client that
---       with's this unit determines that Elaborate_All is desirable, i.e.
---       that there is a possibility that Program_Error may be raised if
---       Elaborate_All conditions cannot be met.
-
 --    Elaboration_Entity (Node13)
 --       Present in generic and non-generic package and subprogram
 --       entities. This is a boolean entity associated with the unit that
@@ -1230,6 +1228,11 @@ package Einfo is
 --       be RCI entities, so the flag Is_Remote_Call_Interface will always
 --       be set if this flag is set.
 
+--    Has_Anon_Block_Suffix (Flag201)
+--       Present in all entities. Set if the entity is nested within one or
+--       more anonymous blocks and the Chars field contains a name with an
+--       anonymous block suffix (see Exp_Dbug for furthert details).
+
 --    Has_Atomic_Components (Flag86) [implementation base type only]
 --       Present in all types and objects. Set only for an array type or
 --       an array object if a valid pragma Atomic_Components applies to the
@@ -2106,6 +2109,10 @@ package Einfo is
 --       do not become visible until the immediate scope of the composite
 --       type itself (RM 7.3.1 (5)).
 
+--    Is_Limited_Interface (Flag197)
+--       Present in types that are interfaces. True if interface is declared
+--       limited, or is derived from limited interfaces.
+
 --    Is_Limited_Record (Flag25)
 --       Present in all entities. Set to true for record (sub)types if the
 --       record is declared to be limited. Note that this flag is not set
@@ -2159,8 +2166,8 @@ package Einfo is
 --       including generic formal parameters.
 
 --    Is_Obsolescent (Flag153)
---       Present in all entities. Set only for subprograms when a valid pragma
---       Obsolescent applies to the subprogram.
+--       Present in all entities. Set only for packages and subprograms to
+--       which a valid pragma Obsolescent applies.
 
 --    Is_Optional_Parameter (Flag134)
 --       Present in parameter entities. Set if the parameter is specified as
@@ -2175,7 +2182,7 @@ package Einfo is
 --       Present in subprograms. Set if the subprogram is a primitive
 --       operation of a derived type, that overrides an inherited operation.
 
---    Is_Package (synthesized)
+--    Is_Package_Or_Generic_Package (synthesized)
 --       Applies to all entities. True for packages and generic packages.
 --       False for all other entities.
 
@@ -2264,6 +2271,10 @@ package Einfo is
 --       Applies to all entities, true for private types and subtypes,
 --       as well as for record with private types as subtypes
 
+--    Is_Protected_Interface (Flag198)
+--       Present in types that are interfaces. True if interface is declared
+--       protected, or is derived from protected interfaces.
+
 --    Is_Protected_Type (synthesized)
 --       Applies to all entities, true for protected types and subtypes
 
@@ -2358,6 +2369,10 @@ package Einfo is
 --       or a string slice type, or an array type with one dimension and a
 --       component type that is a character type.
 
+--    Is_Synchronized_Interface (Flag199)
+--       Present_types that are interfaces. True is interface is declared
+--       synchronized, or is derived from synchronized interfaces.
+
 --    Is_Tag (Flag78)
 --       Present in E_Component. For regular tagged type this flag is set on
 --       the tag component (whose name is Name_uTag) and for CPP_Class tagged
@@ -2367,6 +2382,10 @@ package Einfo is
 --    Is_Tagged_Type (Flag55)
 --       Present in all entities, true for an entity for a tagged type.
 
+--    Is_Task_Interface (Flag200)
+--       Present in types that are interfaces. True is interface is declared
+--        as such, or if it is derived from task interfaces.
+
 --    Is_Task_Record_Type (synthesized)
 --       Applies to all entities, true if Is_Concurrent_Record_Type
 --       Corresponding_Concurrent_Type is a task type.
@@ -2732,8 +2751,8 @@ package Einfo is
 --       formals as a value of type Pos.
 
 --    Obsolescent_Warning (Node24)
---       Present in subprogram entities. Set non-empty only if the pragma
---       Obsolescent had a string argument, in which case it records the
+--       Present in package and subprogram entities. Set non-empty only if the
+--       pragma Obsolescent had a string argument, in which case it records the
 --       contents of the corresponding string literal node.
 
 --    Original_Access_Type (Node21)
@@ -2778,6 +2797,18 @@ package Einfo is
 --       Present in subprograms. For overriding operations, points to the
 --       user-defined parent subprogram that is being overridden.
 
+--    Package_Instantiation (Node26)
+--       Present in packages and generic packages. When present, this field
+--       references an N_Package_Instantiation node associated with an
+--       instantiated package. In the case where the referenced node has
+--       been rewritten to an N_Package_Specification, the instantiation
+--       node is available from the Original_Node field of the package spec
+--       node. This is currently not guaranteed to be set in all cases, but
+--       when set, the field is used in Get_Package_Instantiation_Node as
+--       one of the means of obtaining the instantiation node. Eventually
+--       it should be set in all cases, including package entities associated
+--       with formal packages. ???
+
 --    Packed_Array_Type (Node23)
 --       Present in array types and subtypes, including the string literal
 --       subtype case, if the corresponding type is packed (either bit packed
@@ -4009,6 +4040,7 @@ package Einfo is
    --    Can_Never_Be_Null             (Flag38)
    --    Checks_May_Be_Suppressed      (Flag31)
    --    Debug_Info_Off                (Flag166)
+   --    Has_Anon_Block_Suffix         (Flag201)
    --    Has_Controlled_Component      (Flag43)   (base type only)
    --    Has_Convention_Pragma         (Flag119)
    --    Has_Delayed_Freeze            (Flag18)
@@ -4123,6 +4155,10 @@ package Einfo is
    --    Is_Frozen                     (Flag4)
    --    Is_Generic_Actual_Type        (Flag94)
    --    Is_Generic_Type               (Flag13)
+   --    Is_Limited_Interface          (Flag197)
+   --    Is_Protected_Interface        (Flag198)
+   --    Is_Synchronized_Interface     (Flag199)
+   --    Is_Task_Interface             (Flag200)
    --    Is_Non_Static_Subtype         (Flag109)
    --    Is_Packed                     (Flag51)   (base type only)
    --    Is_Private_Composite          (Flag107)
@@ -4428,7 +4464,6 @@ package Einfo is
    --    Delay_Cleanups                (Flag114)
    --    Delay_Subprogram_Descriptors  (Flag50)
    --    Discard_Names                 (Flag88)
-   --    Elaborate_All_Desirable       (Flag146)
    --    Has_Completion                (Flag26)
    --    Has_Controlling_Result        (Flag98)
    --    Has_Master_Entity             (Flag21)
@@ -4596,10 +4631,12 @@ package Einfo is
    --    Generic_Renamings             (Elist23)  (for an instance)
    --    Inner_Instances               (Elist23)  (generic case only)
    --    Limited_View                  (Node23)   (non-generic, not instance)
+   --    Obsolescent_Warning           (Node24)
+   --    Current_Use_Clause            (Node25)
+   --    Package_Instantiation         (Node26)
    --    Delay_Subprogram_Descriptors  (Flag50)
    --    Body_Needed_For_SAL           (Flag40)
    --    Discard_Names                 (Flag88)
-   --    Elaborate_All_Desirable       (Flag146)
    --    Elaboration_Entity_Required   (Flag174)
    --    From_With_Type                (Flag159)
    --    Has_All_Calls_Remote          (Flag79)
@@ -4678,7 +4715,6 @@ package Einfo is
    --    Delay_Cleanups                (Flag114)
    --    Delay_Subprogram_Descriptors  (Flag50)
    --    Discard_Names                 (Flag88)
-   --    Elaborate_All_Desirable       (Flag146)
    --    Has_Completion                (Flag26)
    --    Has_Master_Entity             (Flag21)
    --    Has_Nested_Block_With_Handler (Flag101)
@@ -5145,6 +5181,7 @@ package Einfo is
    function Corresponding_Equality             (Id : E) return E;
    function Corresponding_Record_Type          (Id : E) return E;
    function Corresponding_Remote_Type          (Id : E) return E;
+   function Current_Use_Clause                 (Id : E) return E;
    function Current_Value                      (Id : E) return N;
    function Debug_Info_Off                     (Id : E) return B;
    function Debug_Renaming_Link                (Id : E) return E;
@@ -5168,7 +5205,6 @@ package Einfo is
    function Discriminant_Constraint            (Id : E) return L;
    function Discriminant_Default_Value         (Id : E) return N;
    function Discriminant_Number                (Id : E) return U;
-   function Elaborate_All_Desirable            (Id : E) return B;
    function Elaboration_Entity                 (Id : E) return E;
    function Elaboration_Entity_Required        (Id : E) return B;
    function Enclosing_Scope                    (Id : E) return E;
@@ -5208,6 +5244,7 @@ package Einfo is
    function Has_Aliased_Components             (Id : E) return B;
    function Has_Alignment_Clause               (Id : E) return B;
    function Has_All_Calls_Remote               (Id : E) return B;
+   function Has_Anon_Block_Suffix              (Id : E) return B;
    function Has_Atomic_Components              (Id : E) return B;
    function Has_Biased_Representation          (Id : E) return B;
    function Has_Completion                     (Id : E) return B;
@@ -5314,6 +5351,7 @@ package Einfo is
    function Is_Known_Non_Null                  (Id : E) return B;
    function Is_Known_Valid                     (Id : E) return B;
    function Is_Limited_Composite               (Id : E) return B;
+   function Is_Limited_Interface               (Id : E) return B;
    function Is_Machine_Code_Subprogram         (Id : E) return B;
    function Is_Non_Static_Subtype              (Id : E) return B;
    function Is_Null_Init_Proc                  (Id : E) return B;
@@ -5328,6 +5366,7 @@ package Einfo is
 
    function Is_Private_Composite               (Id : E) return B;
    function Is_Private_Descendant              (Id : E) return B;
+   function Is_Protected_Interface             (Id : E) return B;
    function Is_Public                          (Id : E) return B;
    function Is_Pure                            (Id : E) return B;
    function Is_Pure_Unit_Access_Type           (Id : E) return B;
@@ -5336,8 +5375,10 @@ package Einfo is
    function Is_Renaming_Of_Object              (Id : E) return B;
    function Is_Shared_Passive                  (Id : E) return B;
    function Is_Statically_Allocated            (Id : E) return B;
+   function Is_Synchronized_Interface          (Id : E) return B;
    function Is_Tag                             (Id : E) return B;
    function Is_Tagged_Type                     (Id : E) return B;
+   function Is_Task_Interface                  (Id : E) return B;
    function Is_Thread_Body                     (Id : E) return B;
    function Is_True_Constant                   (Id : E) return B;
    function Is_Unchecked_Union                 (Id : E) return B;
@@ -5379,6 +5420,7 @@ package Einfo is
    function Original_Array_Type                (Id : E) return E;
    function Original_Record_Component          (Id : E) return E;
    function Overridden_Operation               (Id : E) return E;
+   function Package_Instantiation              (Id : E) return N;
    function Packed_Array_Type                  (Id : E) return E;
    function Parent_Subtype                     (Id : E) return E;
    function Primitive_Operations               (Id : E) return L;
@@ -5519,7 +5561,7 @@ package Einfo is
    function Is_Dynamic_Scope                   (Id : E) return B;
    function Is_Indefinite_Subtype              (Id : E) return B;
    function Is_Limited_Type                    (Id : E) return B;
-   function Is_Package                         (Id : E) return B;
+   function Is_Package_Or_Generic_Package      (Id : E) return B;
    function Is_Protected_Private               (Id : E) return B;
    function Is_Protected_Record_Type           (Id : E) return B;
    function Is_Return_By_Reference_Type        (Id : E) return B;
@@ -5638,6 +5680,7 @@ package Einfo is
    procedure Set_Corresponding_Equality        (Id : E; V : E);
    procedure Set_Corresponding_Record_Type     (Id : E; V : E);
    procedure Set_Corresponding_Remote_Type     (Id : E; V : E);
+   procedure Set_Current_Use_Clause            (Id : E; V : E);
    procedure Set_Current_Value                 (Id : E; V : N);
    procedure Set_Debug_Info_Off                (Id : E; V : B := True);
    procedure Set_Debug_Renaming_Link           (Id : E; V : E);
@@ -5661,7 +5704,6 @@ package Einfo is
    procedure Set_Discriminant_Constraint       (Id : E; V : L);
    procedure Set_Discriminant_Default_Value    (Id : E; V : N);
    procedure Set_Discriminant_Number           (Id : E; V : U);
-   procedure Set_Elaborate_All_Desirable       (Id : E; V : B := True);
    procedure Set_Elaboration_Entity            (Id : E; V : E);
    procedure Set_Elaboration_Entity_Required   (Id : E; V : B := True);
    procedure Set_Enclosing_Scope               (Id : E; V : E);
@@ -5700,6 +5742,7 @@ package Einfo is
    procedure Set_Has_Aliased_Components        (Id : E; V : B := True);
    procedure Set_Has_Alignment_Clause          (Id : E; V : B := True);
    procedure Set_Has_All_Calls_Remote          (Id : E; V : B := True);
+   procedure Set_Has_Anon_Block_Suffix         (Id : E; V : B := True);
    procedure Set_Has_Atomic_Components         (Id : E; V : B := True);
    procedure Set_Has_Biased_Representation     (Id : E; V : B := True);
    procedure Set_Has_Completion                (Id : E; V : B := True);
@@ -5810,6 +5853,7 @@ package Einfo is
    procedure Set_Is_Known_Non_Null             (Id : E; V : B := True);
    procedure Set_Is_Known_Valid                (Id : E; V : B := True);
    procedure Set_Is_Limited_Composite          (Id : E; V : B := True);
+   procedure Set_Is_Limited_Interface          (Id : E; V : B := True);
    procedure Set_Is_Limited_Record             (Id : E; V : B := True);
    procedure Set_Is_Machine_Code_Subprogram    (Id : E; V : B := True);
    procedure Set_Is_Non_Static_Subtype         (Id : E; V : B := True);
@@ -5823,9 +5867,9 @@ package Einfo is
    procedure Set_Is_Potentially_Use_Visible    (Id : E; V : B := True);
    procedure Set_Is_Preelaborated              (Id : E; V : B := True);
    procedure Set_Is_Primitive_Wrapper          (Id : E; V : B := True);
-
    procedure Set_Is_Private_Composite          (Id : E; V : B := True);
    procedure Set_Is_Private_Descendant         (Id : E; V : B := True);
+   procedure Set_Is_Protected_Interface        (Id : E; V : B := True);
    procedure Set_Is_Public                     (Id : E; V : B := True);
    procedure Set_Is_Pure                       (Id : E; V : B := True);
    procedure Set_Is_Pure_Unit_Access_Type      (Id : E; V : B := True);
@@ -5834,8 +5878,10 @@ package Einfo is
    procedure Set_Is_Renaming_Of_Object         (Id : E; V : B := True);
    procedure Set_Is_Shared_Passive             (Id : E; V : B := True);
    procedure Set_Is_Statically_Allocated       (Id : E; V : B := True);
+   procedure Set_Is_Synchronized_Interface     (Id : E; V : B := True);
    procedure Set_Is_Tag                        (Id : E; V : B := True);
    procedure Set_Is_Tagged_Type                (Id : E; V : B := True);
+   procedure Set_Is_Task_Interface             (Id : E; V : B := True);
    procedure Set_Is_Thread_Body                (Id : E; V : B := True);
    procedure Set_Is_True_Constant              (Id : E; V : B := True);
    procedure Set_Is_Unchecked_Union            (Id : E; V : B := True);
@@ -5876,6 +5922,7 @@ package Einfo is
    procedure Set_Original_Array_Type           (Id : E; V : E);
    procedure Set_Original_Record_Component     (Id : E; V : E);
    procedure Set_Overridden_Operation          (Id : E; V : E);
+   procedure Set_Package_Instantiation         (Id : E; V : N);
    procedure Set_Packed_Array_Type             (Id : E; V : E);
    procedure Set_Parent_Subtype                (Id : E; V : E);
    procedure Set_Primitive_Operations          (Id : E; V : L);
@@ -6185,6 +6232,7 @@ package Einfo is
    pragma Inline (Corresponding_Equality);
    pragma Inline (Corresponding_Record_Type);
    pragma Inline (Corresponding_Remote_Type);
+   pragma Inline (Current_Use_Clause);
    pragma Inline (Current_Value);
    pragma Inline (Debug_Info_Off);
    pragma Inline (Debug_Renaming_Link);
@@ -6208,7 +6256,6 @@ package Einfo is
    pragma Inline (Discriminant_Constraint);
    pragma Inline (Discriminant_Default_Value);
    pragma Inline (Discriminant_Number);
-   pragma Inline (Elaborate_All_Desirable);
    pragma Inline (Elaboration_Entity);
    pragma Inline (Elaboration_Entity_Required);
    pragma Inline (Enclosing_Scope);
@@ -6247,6 +6294,7 @@ package Einfo is
    pragma Inline (Has_Aliased_Components);
    pragma Inline (Has_Alignment_Clause);
    pragma Inline (Has_All_Calls_Remote);
+   pragma Inline (Has_Anon_Block_Suffix);
    pragma Inline (Has_Atomic_Components);
    pragma Inline (Has_Biased_Representation);
    pragma Inline (Has_Completion);
@@ -6377,6 +6425,7 @@ package Einfo is
    pragma Inline (Is_Known_Non_Null);
    pragma Inline (Is_Known_Valid);
    pragma Inline (Is_Limited_Composite);
+   pragma Inline (Is_Limited_Interface);
    pragma Inline (Is_Limited_Record);
    pragma Inline (Is_Machine_Code_Subprogram);
    pragma Inline (Is_Modular_Integer_Type);
@@ -6400,6 +6449,7 @@ package Einfo is
    pragma Inline (Is_Private_Composite);
    pragma Inline (Is_Private_Descendant);
    pragma Inline (Is_Private_Type);
+   pragma Inline (Is_Protected_Interface);
    pragma Inline (Is_Protected_Type);
    pragma Inline (Is_Public);
    pragma Inline (Is_Pure);
@@ -6414,8 +6464,10 @@ package Einfo is
    pragma Inline (Is_Signed_Integer_Type);
    pragma Inline (Is_Statically_Allocated);
    pragma Inline (Is_Subprogram);
+   pragma Inline (Is_Synchronized_Interface);
    pragma Inline (Is_Tag);
    pragma Inline (Is_Tagged_Type);
+   pragma Inline (Is_Task_Interface);
    pragma Inline (Is_Thread_Body);
    pragma Inline (Is_True_Constant);
    pragma Inline (Is_Task_Type);
@@ -6459,6 +6511,7 @@ package Einfo is
    pragma Inline (Original_Array_Type);
    pragma Inline (Original_Record_Component);
    pragma Inline (Overridden_Operation);
+   pragma Inline (Package_Instantiation);
    pragma Inline (Packed_Array_Type);
    pragma Inline (Parameter_Mode);
    pragma Inline (Parent_Subtype);
@@ -6552,6 +6605,7 @@ package Einfo is
    pragma Inline (Set_Corresponding_Equality);
    pragma Inline (Set_Corresponding_Record_Type);
    pragma Inline (Set_Corresponding_Remote_Type);
+   pragma Inline (Set_Current_Use_Clause);
    pragma Inline (Set_Current_Value);
    pragma Inline (Set_Debug_Info_Off);
    pragma Inline (Set_Debug_Renaming_Link);
@@ -6574,7 +6628,6 @@ package Einfo is
    pragma Inline (Set_Discriminant_Constraint);
    pragma Inline (Set_Discriminant_Default_Value);
    pragma Inline (Set_Discriminant_Number);
-   pragma Inline (Set_Elaborate_All_Desirable);
    pragma Inline (Set_Elaboration_Entity);
    pragma Inline (Set_Elaboration_Entity_Required);
    pragma Inline (Set_Enclosing_Scope);
@@ -6611,6 +6664,7 @@ package Einfo is
    pragma Inline (Set_Has_Aliased_Components);
    pragma Inline (Set_Has_Alignment_Clause);
    pragma Inline (Set_Has_All_Calls_Remote);
+   pragma Inline (Set_Has_Anon_Block_Suffix);
    pragma Inline (Set_Has_Atomic_Components);
    pragma Inline (Set_Has_Biased_Representation);
    pragma Inline (Set_Has_Completion);
@@ -6720,6 +6774,7 @@ package Einfo is
    pragma Inline (Set_Is_Known_Non_Null);
    pragma Inline (Set_Is_Known_Valid);
    pragma Inline (Set_Is_Limited_Composite);
+   pragma Inline (Set_Is_Limited_Interface);
    pragma Inline (Set_Is_Limited_Record);
    pragma Inline (Set_Is_Machine_Code_Subprogram);
    pragma Inline (Set_Is_Non_Static_Subtype);
@@ -6736,6 +6791,7 @@ package Einfo is
 
    pragma Inline (Set_Is_Private_Composite);
    pragma Inline (Set_Is_Private_Descendant);
+   pragma Inline (Set_Is_Protected_Interface);
    pragma Inline (Set_Is_Public);
    pragma Inline (Set_Is_Pure);
    pragma Inline (Set_Is_Pure_Unit_Access_Type);
@@ -6744,8 +6800,10 @@ package Einfo is
    pragma Inline (Set_Is_Renaming_Of_Object);
    pragma Inline (Set_Is_Shared_Passive);
    pragma Inline (Set_Is_Statically_Allocated);
+   pragma Inline (Set_Is_Synchronized_Interface);
    pragma Inline (Set_Is_Tag);
    pragma Inline (Set_Is_Tagged_Type);
+   pragma Inline (Set_Is_Task_Interface);
    pragma Inline (Set_Is_Thread_Body);
    pragma Inline (Set_Is_True_Constant);
    pragma Inline (Set_Is_Unchecked_Union);
@@ -6786,6 +6844,7 @@ package Einfo is
    pragma Inline (Set_Original_Array_Type);
    pragma Inline (Set_Original_Record_Component);
    pragma Inline (Set_Overridden_Operation);
+   pragma Inline (Set_Package_Instantiation);
    pragma Inline (Set_Packed_Array_Type);
    pragma Inline (Set_Parent_Subtype);
    pragma Inline (Set_Primitive_Operations);
@@ -6849,7 +6908,7 @@ package Einfo is
    --  things here which are small, but not of the canonical attribute
    --  access/set format that can be handled by xeinfo.
 
-   pragma Inline (Is_Package);
+   pragma Inline (Is_Package_Or_Generic_Package);
    pragma Inline (Is_Wrapper_Package);
    pragma Inline (Known_RM_Size);
    pragma Inline (Known_Static_Component_Bit_Offset);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 4b82921..3feb7d3 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -79,13 +79,6 @@ package body Exp_Ch3 is
    --  used for attachment of any actions required in its construction.
    --  It also supplies the source location used for the procedure.
 
-   procedure Build_Class_Wide_Master (T : Entity_Id);
-   --  for access to class-wide limited types we must build a task master
-   --  because some subsequent extension may add a task component. To avoid
-   --  bringing in the tasking run-time whenever an access-to-class-wide
-   --  limited type is used, we use the soft-link mechanism and add a level
-   --  of indirection to calls to routines that manipulate Master_Ids.
-
    function Build_Discriminant_Formals
      (Rec_Id : Entity_Id;
       Use_Dl : Boolean) return List_Id;
@@ -651,6 +644,7 @@ package body Exp_Ch3 is
       M_Id : Entity_Id;
       Decl : Node_Id;
       P    : Node_Id;
+      Par  : Node_Id;
 
    begin
       --  Nothing to do if there is no task hierarchy
@@ -659,6 +653,16 @@ package body Exp_Ch3 is
          return;
       end if;
 
+      --  Find declaration that created the access type: either a
+      --  type declaration, or an object declaration with an
+      --  access definition, in which case the type is anonymous.
+
+      if Is_Itype (T) then
+         P := Associated_Node_For_Itype (T);
+      else
+         P := Parent (T);
+      end if;
+
       --  Nothing to do if we already built a master entity for this scope
 
       if not Has_Master_Entity (Scope (T)) then
@@ -677,24 +681,24 @@ package body Exp_Ch3 is
                Make_Explicit_Dereference (Loc,
                  New_Reference_To (RTE (RE_Current_Master), Loc)));
 
-         P := Parent (T);
          Insert_Before (P, Decl);
          Analyze (Decl);
          Set_Has_Master_Entity (Scope (T));
 
          --  Now mark the containing scope as a task master
 
-         while Nkind (P) /= N_Compilation_Unit loop
-            P := Parent (P);
+         Par := P;
+         while Nkind (Par) /= N_Compilation_Unit loop
+            Par := Parent (Par);
 
             --  If we fall off the top, we are at the outer level, and the
             --  environment task is our effective master, so nothing to mark.
 
-            if Nkind (P) = N_Task_Body
-              or else Nkind (P) = N_Block_Statement
-              or else Nkind (P) = N_Subprogram_Body
+            if Nkind (Par) = N_Task_Body
+              or else Nkind (Par) = N_Block_Statement
+              or else Nkind (Par) = N_Subprogram_Body
             then
-               Set_Is_Task_Master (P, True);
+               Set_Is_Task_Master (Par, True);
                exit;
             end if;
          end loop;
@@ -711,7 +715,7 @@ package body Exp_Ch3 is
           Defining_Identifier => M_Id,
           Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
           Name => Make_Identifier (Loc, Name_uMaster));
-      Insert_Before (Parent (T), Decl);
+      Insert_Before (P, Decl);
       Analyze (Decl);
 
       Set_Master_Id (T, M_Id);
@@ -1758,10 +1762,18 @@ package body Exp_Ch3 is
                Aux_N : Node_Id;
 
             begin
-               if not Is_Interface (Typ)
-                 and then Etype (Typ) /= Typ
-               then
-                  Init_Secondary_Tags_Internal (Etype (Typ));
+               if not Is_Interface (Typ) then
+
+                  --  Climb to the ancestor (if any) handling private types
+
+                  if Present (Full_View (Etype (Typ))) then
+                     if Full_View (Etype (Typ)) /= Typ then
+                        Init_Secondary_Tags_Internal (Full_View (Etype (Typ)));
+                     end if;
+
+                  elsif Etype (Typ) /= Typ then
+                     Init_Secondary_Tags_Internal (Etype (Typ));
+                  end if;
                end if;
 
                if Present (Abstract_Interfaces (Typ))
@@ -1824,7 +1836,14 @@ package body Exp_Ch3 is
             --  interfaces.
 
             ADT := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
-            Init_Secondary_Tags_Internal (Typ);
+
+            --  Handle private types
+
+            if Present (Full_View (Typ)) then
+               Init_Secondary_Tags_Internal (Full_View (Typ));
+            else
+               Init_Secondary_Tags_Internal (Typ);
+            end if;
          end Init_Secondary_Tags;
 
       --  Start of processing for Build_Init_Procedure
@@ -2478,6 +2497,13 @@ package body Exp_Ch3 is
             return False;
          end if;
 
+         --  If it is a type derived from a type with unknown discriminants,
+         --  we cannot build an initialization procedure for it.
+
+         if Has_Unknown_Discriminants (Rec_Id) then
+            return False;
+         end if;
+
          --  Otherwise we need to generate an initialization procedure if
          --  Is_CPP_Class is False and at least one of the following applies:
 
@@ -4547,34 +4573,52 @@ package body Exp_Ch3 is
                   ADT : Elist_Id := Access_Disp_Table (Def_Id);
 
                   procedure Add_Secondary_Tables (Typ : Entity_Id);
-                  --  Comment required ???
+                  --  Internal subprogram, recursively climb to the ancestors
 
                   --------------------------
                   -- Add_Secondary_Tables --
                   --------------------------
 
                   procedure Add_Secondary_Tables (Typ : Entity_Id) is
-                     E      : Entity_Id;
-                     Result : List_Id;
+                     E            : Entity_Id;
+                     Iface        : Elmt_Id;
+                     Result       : List_Id;
+                     Suffix_Index : Int;
 
                   begin
-                     if Etype (Typ) /= Typ then
+                     --  Climb to the ancestor (if any) handling private types
+
+                     if Present (Full_View (Etype (Typ))) then
+                        if Full_View (Etype (Typ)) /= Typ then
+                           Add_Secondary_Tables (Full_View (Etype (Typ)));
+                        end if;
+
+                     elsif Etype (Typ) /= Typ then
                         Add_Secondary_Tables (Etype (Typ));
                      end if;
 
                      if Present (Abstract_Interfaces (Typ))
-                       and then not Is_Empty_Elmt_List
-                                      (Abstract_Interfaces (Typ))
+                       and then
+                         not Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
                      then
+                        Iface := First_Elmt (Abstract_Interfaces (Typ));
+                        Suffix_Index := 0;
+
                         E := First_Entity (Typ);
                         while Present (E) loop
                            if Is_Tag (E) and then Chars (E) /= Name_uTag then
-                              Make_Abstract_Interface_DT
-                                (AI_Tag          => E,
+                              Make_Secondary_DT
+                                (Typ             => Def_Id,
+                                 Ancestor_Typ    => Typ,
+                                 Suffix_Index    => Suffix_Index,
+                                 Iface           => Node (Iface),
+                                 AI_Tag          => E,
                                  Acc_Disp_Tables => ADT,
                                  Result          => Result);
 
                               Append_Freeze_Actions (Def_Id, Result);
+                              Suffix_Index := Suffix_Index + 1;
+                              Next_Elmt (Iface);
                            end if;
 
                            Next_Entity (E);
@@ -4585,7 +4629,14 @@ package body Exp_Ch3 is
                --  Start of processing to build secondary dispatch tables
 
                begin
-                  Add_Secondary_Tables  (Def_Id);
+                  --  Handle private types
+
+                  if Present (Full_View (Def_Id)) then
+                     Add_Secondary_Tables  (Full_View (Def_Id));
+                  else
+                     Add_Secondary_Tables  (Def_Id);
+                  end if;
+
                   Set_Access_Disp_Table (Def_Id, ADT);
                   Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
                end;
@@ -4699,9 +4750,14 @@ package body Exp_Ch3 is
            and then not Is_Interface  (Def_Id)
            and then not Is_Abstract   (Def_Id)
            and then not Is_Controlled (Def_Id)
-           and then Implements_Limited_Interface (Def_Id)
+           and then
+             Implements_Interface
+               (Typ          => Def_Id,
+                Kind         => Any_Limited_Interface,
+                Check_Parent => True)
          then
-            Append_Freeze_Actions (Def_Id, Make_Disp_Select_Tables (Def_Id));
+            Append_Freeze_Actions (Def_Id,
+              Make_Select_Specific_Data_Table (Def_Id));
          end if;
       end if;
    end Freeze_Record_Type;
@@ -5897,6 +5953,7 @@ package body Exp_Ch3 is
       --    disp_asynchronous_select
       --    disp_conditional_select
       --    disp_get_prim_op_kind
+      --    disp_get_task_id
       --    disp_timed_select
       --  for limited interfaces and tagged types that implement a limited
       --  interface.
@@ -5908,50 +5965,36 @@ package body Exp_Ch3 is
           or else
              (not Is_Abstract (Tag_Typ)
                 and then not Is_Controlled (Tag_Typ)
-                and then Implements_Limited_Interface (Tag_Typ)))
+              and then
+                Implements_Interface
+                  (Typ          => Tag_Typ,
+                   Kind         => Any_Limited_Interface,
+                   Check_Parent => True)))
       then
-         if Is_Interface (Tag_Typ) then
-            Append_To (Res,
-              Make_Abstract_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Asynchronous_Select_Spec (Tag_Typ)));
-
-            Append_To (Res,
-              Make_Abstract_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Conditional_Select_Spec (Tag_Typ)));
-
-            Append_To (Res,
-              Make_Abstract_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Get_Prim_Op_Kind_Spec (Tag_Typ)));
-
-            Append_To (Res,
-              Make_Abstract_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Timed_Select_Spec (Tag_Typ)));
+         Append_To (Res,
+           Make_Subprogram_Declaration (Loc,
+             Specification =>
+               Make_Disp_Asynchronous_Select_Spec (Tag_Typ)));
 
-         else
-            Append_To (Res,
-              Make_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Asynchronous_Select_Spec (Tag_Typ)));
+         Append_To (Res,
+           Make_Subprogram_Declaration (Loc,
+             Specification =>
+               Make_Disp_Conditional_Select_Spec (Tag_Typ)));
 
-            Append_To (Res,
-              Make_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Conditional_Select_Spec (Tag_Typ)));
+         Append_To (Res,
+           Make_Subprogram_Declaration (Loc,
+             Specification =>
+               Make_Disp_Get_Prim_Op_Kind_Spec (Tag_Typ)));
 
-            Append_To (Res,
-              Make_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Get_Prim_Op_Kind_Spec (Tag_Typ)));
+         Append_To (Res,
+           Make_Subprogram_Declaration (Loc,
+             Specification =>
+               Make_Disp_Get_Task_Id_Spec (Tag_Typ)));
 
-            Append_To (Res,
-              Make_Subprogram_Declaration (Loc,
-                Specification =>
-                  Make_Disp_Timed_Select_Spec (Tag_Typ)));
-         end if;
+         Append_To (Res,
+           Make_Subprogram_Declaration (Loc,
+             Specification =>
+               Make_Disp_Timed_Select_Spec (Tag_Typ)));
       end if;
 
       --  Specs for finalization actions that may be required in case a
@@ -6310,26 +6353,33 @@ package body Exp_Ch3 is
       end if;
 
       --  Generate the bodies for the following primitive operations:
+
       --    disp_asynchronous_select
       --    disp_conditional_select
       --    disp_get_prim_op_kind
+      --    disp_get_task_id
       --    disp_timed_select
-      --  for tagged types that implement a limited interface.
+
+      --  for limited interfaces and tagged types that implement a limited
+      --  interface. The interface versions will have null bodies.
 
       if Ada_Version >= Ada_05
-        and then not Is_Interface  (Tag_Typ)
-        and then not Is_Abstract   (Tag_Typ)
-        and then not Is_Controlled (Tag_Typ)
-        and then Implements_Limited_Interface (Tag_Typ)
+        and then
+          ((Is_Interface (Tag_Typ) and then Is_Limited_Record (Tag_Typ))
+              or else
+                (not Is_Abstract (Tag_Typ)
+                   and then not Is_Controlled (Tag_Typ)
+                   and then
+                     Implements_Interface
+                       (Typ          => Tag_Typ,
+                        Kind         => Any_Limited_Interface,
+                        Check_Parent => True)))
       then
-         Append_To (Res,
-           Make_Disp_Asynchronous_Select_Body (Tag_Typ));
-         Append_To (Res,
-           Make_Disp_Conditional_Select_Body  (Tag_Typ));
-         Append_To (Res,
-           Make_Disp_Get_Prim_Op_Kind_Body    (Tag_Typ));
-         Append_To (Res,
-           Make_Disp_Timed_Select_Body        (Tag_Typ));
+         Append_To (Res, Make_Disp_Asynchronous_Select_Body (Tag_Typ));
+         Append_To (Res, Make_Disp_Conditional_Select_Body  (Tag_Typ));
+         Append_To (Res, Make_Disp_Get_Prim_Op_Kind_Body    (Tag_Typ));
+         Append_To (Res, Make_Disp_Get_Task_Id_Body         (Tag_Typ));
+         Append_To (Res, Make_Disp_Timed_Select_Body        (Tag_Typ));
       end if;
 
       if not Is_Limited_Type (Tag_Typ) then
@@ -6337,23 +6387,23 @@ package body Exp_Ch3 is
          --  Body for equality
 
          if Eq_Needed then
+            Decl :=
+              Predef_Spec_Or_Body (Loc,
+                Tag_Typ => Tag_Typ,
+                Name    => Eq_Name,
+                Profile => New_List (
+                  Make_Parameter_Specification (Loc,
+                    Defining_Identifier =>
+                      Make_Defining_Identifier (Loc, Name_X),
+                    Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
 
-            Decl := Predef_Spec_Or_Body (Loc,
-              Tag_Typ => Tag_Typ,
-              Name    => Eq_Name,
-              Profile => New_List (
-                Make_Parameter_Specification (Loc,
-                  Defining_Identifier =>
-                    Make_Defining_Identifier (Loc, Name_X),
-                  Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
-
-                Make_Parameter_Specification (Loc,
-                  Defining_Identifier =>
-                    Make_Defining_Identifier (Loc, Name_Y),
-                  Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
+                  Make_Parameter_Specification (Loc,
+                    Defining_Identifier =>
+                      Make_Defining_Identifier (Loc, Name_Y),
+                    Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
 
-              Ret_Type => Standard_Boolean,
-              For_Body => True);
+                Ret_Type => Standard_Boolean,
+                For_Body => True);
 
             declare
                Def          : constant Node_Id := Parent (Tag_Typ);
@@ -6403,19 +6453,20 @@ package body Exp_Ch3 is
 
          --  Body for dispatching assignment
 
-         Decl := Predef_Spec_Or_Body (Loc,
-           Tag_Typ => Tag_Typ,
-           Name    => Name_uAssign,
-           Profile => New_List (
-             Make_Parameter_Specification (Loc,
-               Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
-               Out_Present         => True,
-               Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
-
-             Make_Parameter_Specification (Loc,
-               Defining_Identifier => Make_Defining_Identifier (Loc, Name_Y),
-               Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
-           For_Body => True);
+         Decl :=
+           Predef_Spec_Or_Body (Loc,
+             Tag_Typ => Tag_Typ,
+             Name    => Name_uAssign,
+             Profile => New_List (
+               Make_Parameter_Specification (Loc,
+                 Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
+                 Out_Present         => True,
+                 Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
+
+               Make_Parameter_Specification (Loc,
+                 Defining_Identifier => Make_Defining_Identifier (Loc, Name_Y),
+                 Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
+             For_Body => True);
 
          Set_Handled_Statement_Sequence (Decl,
            Make_Handled_Sequence_Of_Statements (Loc, New_List (
@@ -6541,6 +6592,7 @@ package body Exp_Ch3 is
       return
         not (Is_Limited_Type (Typ)
                and then not Has_Inheritable_Stream_Attribute)
+          and then not Has_Unknown_Discriminants (Typ)
           and then RTE_Available (RE_Tag)
           and then RTE_Available (RE_Root_Stream_Type)
           and then not Restriction_Active (No_Dispatch)
diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads
index f4d6097..ce2b799 100644
--- a/gcc/ada/exp_ch3.ads
+++ b/gcc/ada/exp_ch3.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---           Copyright (C) 1992-2005 Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005, 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,12 +40,21 @@ package Exp_Ch3 is
    procedure Expand_Previous_Access_Type (Def_Id : Entity_Id);
    --  For a full type declaration that contains tasks, or that is a task,
    --  check whether there exists an access type whose designated type is an
-   --  incomplete declarations for the current composite type. If so, build
-   --  the master for that access type, now that it is known to denote an
-   --  object with tasks.
+   --  incomplete declarations for the current composite type. If so, build the
+   --  master for that access type, now that it is known to denote an object
+   --  with tasks.
 
    procedure Expand_Record_Extension (T : Entity_Id; Def : Node_Id);
-   --  Add a field _parent in the extension part of the record.
+   --  Add a field _parent in the extension part of the record
+
+   procedure Build_Class_Wide_Master (T : Entity_Id);
+   --  For access to class-wide limited types we must build a task master
+   --  because some subsequent extension may add a task component. To avoid
+   --  bringing in the tasking run-time whenever an access-to-class-wide
+   --  limited type is used, we use the soft-link mechanism and add a level of
+   --  indirection to calls to routines that manipulate Master_Ids. This must
+   --  also be used for anonymous access types whose designated type is a task
+   --  or synchronized interface.
 
    procedure Build_Discr_Checking_Funcs (N : Node_Id);
    --  Builds function which checks whether the component name is consistent
@@ -66,10 +75,10 @@ package Exp_Ch3 is
    --  constructed tree, and Typ is the type of the entity (the initialization
    --  procedure of the base type is the procedure that actually gets called).
    --  In_Init_Proc has to be set to True when the call is itself in an init
-   --  proc in order to enable the use of discriminals. Enclos_type is the
-   --  type of the init proc and it is used for various expansion cases
-   --  including the case where Typ is a task type which is a array component,
-   --  the indices of the enclosing type are used to build the string that
+   --  proc in order to enable the use of discriminals. Enclos_type is the type
+   --  of the init proc and it is used for various expansion cases including
+   --  the case where Typ is a task type which is a array component, the
+   --  indices of the enclosing type are used to build the string that
    --  identifies each task at runtime.
    --
    --  Discr_Map is used to replace discriminants by their discriminals in
@@ -84,33 +93,32 @@ package Exp_Ch3 is
 
    function Freeze_Type (N : Node_Id) return Boolean;
    --  This function executes the freezing actions associated with the given
-   --  freeze type node N and returns True if the node is to be deleted.
-   --  We delete the node if it is present just for front end purpose and
-   --  we don't want Gigi to see the node.  This function can't delete the
-   --  node itself since it would confuse any remaining processing of the
-   --  freeze node.
+   --  freeze type node N and returns True if the node is to be deleted. We
+   --  delete the node if it is present just for front end purpose and we don't
+   --  want Gigi to see the node. This function can't delete the node itself
+   --  since it would confuse any remaining processing of the freeze node.
 
    function Needs_Simple_Initialization (T : Entity_Id) return Boolean;
    --  Certain types need initialization even though there is no specific
-   --  initialization routine. In this category are access types (which
-   --  need initializing to null), packed array types whose implementation
-   --  is a modular type, and all scalar types if Normalize_Scalars is set,
-   --  as well as private types whose underlying type is present and meets
-   --  any of these criteria. Finally, descendants of String and Wide_String
-   --  also need initialization in Initialize/Normalize_Scalars mode.
+   --  initialization routine. In this category are access types (which need
+   --  initializing to null), packed array types whose implementation is a
+   --  modular type, and all scalar types if Normalize_Scalars is set, as well
+   --  as private types whose underlying type is present and meets any of these
+   --  criteria. Finally, descendants of String and Wide_String also need
+   --  initialization in Initialize/Normalize_Scalars mode.
 
    function Get_Simple_Init_Val
      (T    : Entity_Id;
       Loc  : Source_Ptr;
       Size : Uint := No_Uint) return Node_Id;
-   --  For a type which Needs_Simple_Initialization (see above), prepares
-   --  the tree for an expression representing the required initial value.
-   --  Loc is the source location used in constructing this tree which is
-   --  returned as the result of the call. The Size parameter indicates the
-   --  target size of the object if it is known (indicated by a value that
-   --  is not No_Uint and is greater than zero). If Size is not given (Size
-   --  set to No_Uint, or non-positive), then the Esize of T is used as an
-   --  estimate of the Size. The object size is needed to prepare a known
-   --  invalid value for use by Normalize_Scalars.
+   --  For a type which Needs_Simple_Initialization (see above), prepares the
+   --  tree for an expression representing the required initial value. Loc is
+   --  the source location used in constructing this tree which is returned as
+   --  the result of the call. The Size parameter indicates the target size of
+   --  the object if it is known (indicated by a value that is not No_Uint and
+   --  is greater than zero). If Size is not given (Size set to No_Uint, or
+   --  non-positive), then the Esize of T is used as an estimate of the Size.
+   --  The object size is needed to prepare a known invalid value for use by
+   --  Normalize_Scalars.
 
 end Exp_Ch3;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 884d549..76dde0e 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -99,10 +99,11 @@ package body Exp_Ch6 is
    --  we have an infinite recursion.
 
    procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id);
-   --  For each actual of an in-out parameter which is a numeric conversion
-   --  of the form T(A), where A denotes a variable, we insert the declaration:
+   --  For each actual of an in-out or out parameter which is a numeric
+   --  (view) conversion of the form T (A), where A denotes a variable,
+   --  we insert the declaration:
    --
-   --    Temp : T := T (A);
+   --    Temp : T[ := T (A)];
    --
    --  prior to the call. Then we replace the actual with a reference to Temp,
    --  and append the assignment:
@@ -1464,6 +1465,48 @@ package body Exp_Ch6 is
          end if;
       end if;
 
+      --  Ada 2005 (AI-345): We have a procedure call as a triggering
+      --  alternative in an asynchronous select or as an entry call in
+      --  a conditional or timed select. Check whether the procedure call
+      --  is a renaming of an entry and rewrite it as an entry call.
+
+      if Ada_Version >= Ada_05
+        and then Nkind (N) = N_Procedure_Call_Statement
+        and then
+           ((Nkind (Parent (N)) = N_Triggering_Alternative
+               and then Triggering_Statement (Parent (N)) = N)
+          or else
+            (Nkind (Parent (N)) = N_Entry_Call_Alternative
+               and then Entry_Call_Statement (Parent (N)) = N))
+      then
+         declare
+            Ren_Decl : Node_Id;
+            Ren_Root : Entity_Id := Subp;
+
+         begin
+            --  This may be a chain of renamings, find the root
+
+            if Present (Alias (Ren_Root)) then
+               Ren_Root := Alias (Ren_Root);
+            end if;
+
+            if Present (Original_Node (Parent (Parent (Ren_Root)))) then
+               Ren_Decl := Original_Node (Parent (Parent (Ren_Root)));
+
+               if Nkind (Ren_Decl) = N_Subprogram_Renaming_Declaration then
+                  Rewrite (N,
+                    Make_Entry_Call_Statement (Loc,
+                      Name =>
+                        New_Copy_Tree (Name (Ren_Decl)),
+                      Parameter_Associations =>
+                        New_Copy_List_Tree (Parameter_Associations (N))));
+
+                  return;
+               end if;
+            end if;
+         end;
+      end if;
+
       --  First step, compute extra actuals, corresponding to any
       --  Extra_Formals present. Note that we do not access Extra_Formals
       --  directly, instead we simply note the presence of the extra
@@ -1558,13 +1601,29 @@ package body Exp_Ch6 is
                      Act_Prev := Expression (Act_Prev);
                   end loop;
 
-                  Add_Extra_Actual (
-                    Make_Attribute_Reference (Sloc (Prev),
-                      Prefix =>
-                        Duplicate_Subexpr_No_Checks
-                          (Act_Prev, Name_Req => True),
-                      Attribute_Name => Name_Constrained),
-                    Extra_Constrained (Formal));
+                  --  If the expression is a conversion of a dereference,
+                  --  this is internally generated code that manipulates
+                  --  addresses, e.g. when building interface tables. No
+                  --  check should occur in this case, and the discriminated
+                  --  object is not directly a hand.
+
+                  if not Comes_From_Source (Actual)
+                    and then Nkind (Actual) = N_Unchecked_Type_Conversion
+                    and then Nkind (Act_Prev) = N_Explicit_Dereference
+                  then
+                     Add_Extra_Actual
+                       (New_Occurrence_Of (Standard_False, Loc),
+                        Extra_Constrained (Formal));
+
+                  else
+                     Add_Extra_Actual
+                       (Make_Attribute_Reference (Sloc (Prev),
+                        Prefix =>
+                          Duplicate_Subexpr_No_Checks
+                            (Act_Prev, Name_Req => True),
+                        Attribute_Name => Name_Constrained),
+                        Extra_Constrained (Formal));
+                  end if;
                end;
             end if;
          end if;
@@ -1591,10 +1650,10 @@ package body Exp_Ch6 is
                      pragma Assert (Present (Parm_Ent));
 
                      if Present (Extra_Accessibility (Parm_Ent)) then
-                        Add_Extra_Actual (
-                          New_Occurrence_Of
-                            (Extra_Accessibility (Parm_Ent), Loc),
-                          Extra_Accessibility (Formal));
+                        Add_Extra_Actual
+                          (New_Occurrence_Of
+                             (Extra_Accessibility (Parm_Ent), Loc),
+                           Extra_Accessibility (Formal));
 
                      --  If the actual access parameter does not have an
                      --  associated extra formal providing its scope level,
@@ -1602,10 +1661,10 @@ package body Exp_Ch6 is
                      --  accessibility.
 
                      else
-                        Add_Extra_Actual (
-                          Make_Integer_Literal (Loc,
-                            Intval => Scope_Depth (Standard_Standard)),
-                          Extra_Accessibility (Formal));
+                        Add_Extra_Actual
+                          (Make_Integer_Literal (Loc,
+                           Intval => Scope_Depth (Standard_Standard)),
+                           Extra_Accessibility (Formal));
                      end if;
                   end;
 
@@ -1613,10 +1672,10 @@ package body Exp_Ch6 is
                --  level of the actual's access type.
 
                else
-                  Add_Extra_Actual (
-                    Make_Integer_Literal (Loc,
-                      Intval => Type_Access_Level (Etype (Prev_Orig))),
-                    Extra_Accessibility (Formal));
+                  Add_Extra_Actual
+                    (Make_Integer_Literal (Loc,
+                     Intval => Type_Access_Level (Etype (Prev_Orig))),
+                     Extra_Accessibility (Formal));
                end if;
 
             else
@@ -3092,6 +3151,12 @@ package body Exp_Ch6 is
       --  If the call is the right side of an assignment or the expression in
       --  an object declaration, we don't need to create a temp as the left
       --  side will already trigger stack checking if necessary.
+      --
+      --  If the call is a component in an extension aggregate, it will be
+      --  expanded into assignments as well, so no temporary is needed. This
+      --  also solves the problem of functions returning types with unknown
+      --  discriminants, where it is not possible to declare an object of the
+      --  type altogether.
 
       ---------------------------
       -- Returned_By_Reference --
@@ -3143,6 +3208,9 @@ package body Exp_Ch6 is
                 and then Expression (Parent (N)) = N
                   and then Nkind (Parent (Parent (N))) = N_Aggregate
                     and then Rhs_Of_Assign_Or_Decl (Parent (Parent (N))))
+           or else
+             (Nkind (Parent (N)) = N_Extension_Aggregate
+               and then Is_Private_Type (Etype (Typ)))
          then
             return True;
          else
@@ -4052,8 +4120,8 @@ package body Exp_Ch6 is
    -----------------------
 
    procedure Freeze_Subprogram (N : Node_Id) is
-      Loc       : constant Source_Ptr := Sloc (N);
-      E         : constant Entity_Id  := Entity (N);
+      Loc : constant Source_Ptr := Sloc (N);
+      E   : constant Entity_Id  := Entity (N);
 
       procedure Check_Overriding_Inherited_Interfaces (E : Entity_Id);
       --  (Ada 2005): Check if the primitive E covers some interface already
@@ -4068,6 +4136,10 @@ package body Exp_Ch6 is
       --  immediate ancestor associated with the interface; otherwise Prim and
       --  Ancestor_Iface_Prim have the same info.
 
+      procedure Register_Predefined_DT_Entry (Prim : Entity_Id);
+      --  (Ada 2005): Register a predefined primitive in all the secondary
+      --  dispatch tables of its primitive type.
+
       -------------------------------------------
       -- Check_Overriding_Inherited_Interfaces --
       -------------------------------------------
@@ -4090,11 +4162,18 @@ package body Exp_Ch6 is
          --  Get the entity associated with this primitive operation
 
          Typ := Scope (DTC_Entity (E));
-         while Etype (Typ) /= Typ loop
+         loop
+            exit when Etype (Typ) = Typ
+              or else (Present (Full_View (Etype (Typ)))
+                         and then Full_View (Etype (Typ)) = Typ);
 
-            --  Climb to the immediate ancestor
+            --  Climb to the immediate ancestor handling private types
 
-            Typ := Etype (Typ);
+            if Present (Full_View (Etype (Typ))) then
+               Typ := Full_View (Etype (Typ));
+            else
+               Typ := Etype (Typ);
+            end if;
 
             if Present (Abstract_Interfaces (Typ)) then
 
@@ -4192,35 +4271,40 @@ package body Exp_Ch6 is
          if not Present (Ancestor_Iface_Prim) then
             Prim_Typ  := Scope (DTC_Entity (Alias (Prim)));
             Iface_Typ := Scope (DTC_Entity (Abstract_Interface_Alias (Prim)));
-            Iface_Tag := Find_Interface_Tag
-                           (T     => Prim_Typ,
-                            Iface => Iface_Typ);
 
             --  Generate the code of the thunk only when this primitive
             --  operation is associated with a secondary dispatch table.
 
-            if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
-               Thunk_Id  := Make_Defining_Identifier (Loc,
-                              New_Internal_Name ('T'));
-               New_Thunk :=
-                 Expand_Interface_Thunk
-                   (N           => Prim,
-                    Thunk_Alias => Alias (Prim),
-                    Thunk_Id    => Thunk_Id,
-                    Thunk_Tag   => Iface_Tag);
-
-               Insert_After (N, New_Thunk);
-
-               Iface_DT_Ptr :=
-                 Find_Interface_ADT
-                   (T     => Prim_Typ,
-                    Iface => Iface_Typ);
-
-               Insert_After (New_Thunk,
-                 Fill_Secondary_DT_Entry (Sloc (Prim),
-                   Prim         => Prim,
-                   Iface_DT_Ptr => Iface_DT_Ptr,
-                   Thunk_Id     => Thunk_Id));
+            if Is_Interface (Iface_Typ) then
+               Iface_Tag := Find_Interface_Tag
+                              (T     => Prim_Typ,
+                               Iface => Iface_Typ);
+
+               if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
+                  Thunk_Id  :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => New_Internal_Name ('T'));
+
+                  New_Thunk :=
+                    Expand_Interface_Thunk
+                      (N           => Prim,
+                       Thunk_Alias => Alias (Prim),
+                       Thunk_Id    => Thunk_Id,
+                       Thunk_Tag   => Iface_Tag);
+
+                  Insert_After (N, New_Thunk);
+
+                  Iface_DT_Ptr :=
+                    Find_Interface_ADT
+                      (T     => Prim_Typ,
+                       Iface => Iface_Typ);
+
+                  Insert_After (New_Thunk,
+                    Fill_Secondary_DT_Entry (Sloc (Prim),
+                      Prim         => Prim,
+                      Iface_DT_Ptr => Iface_DT_Ptr,
+                      Thunk_Id     => Thunk_Id));
+               end if;
             end if;
 
          else
@@ -4243,8 +4327,9 @@ package body Exp_Ch6 is
             --    type T is new I with ...
 
             if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
-               Thunk_Id  := Make_Defining_Identifier (Loc,
-                              New_Internal_Name ('T'));
+               Thunk_Id :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => New_Internal_Name ('T'));
 
                if Present (Alias (Prim)) then
                   Prim_Op := Alias (Prim);
@@ -4275,6 +4360,70 @@ package body Exp_Ch6 is
          end if;
       end Register_Interface_DT_Entry;
 
+      ----------------------------------
+      -- Register_Predefined_DT_Entry --
+      ----------------------------------
+
+      procedure Register_Predefined_DT_Entry (Prim : Entity_Id) is
+         Iface_DT_Ptr : Elmt_Id;
+         Iface_Tag    : Entity_Id;
+         Iface_Typ    : Elmt_Id;
+         New_Thunk    : Entity_Id;
+         Prim_Typ     : Entity_Id;
+         Thunk_Id     : Entity_Id;
+
+      begin
+         Prim_Typ := Scope (DTC_Entity (Prim));
+
+         if not Present (Access_Disp_Table (Prim_Typ))
+           or else not Present (Abstract_Interfaces (Prim_Typ))
+         then
+            return;
+         end if;
+
+         --  Skip the first acces-to-dispatch-table pointer since it leads
+         --  to the primary dispatch table. We are only concerned with the
+         --  secondary dispatch table pointers. Note that the access-to-
+         --  dispatch-table pointer corresponds to the first implemented
+         --  interface retrieved below.
+
+         Iface_DT_Ptr := Next_Elmt (First_Elmt (Access_Disp_Table (Prim_Typ)));
+         Iface_Typ := First_Elmt (Abstract_Interfaces (Prim_Typ));
+         while Present (Iface_DT_Ptr) and then Present (Iface_Typ) loop
+            Iface_Tag := Find_Interface_Tag (Prim_Typ, Node (Iface_Typ));
+            pragma Assert (Present (Iface_Tag));
+
+            if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
+               Thunk_Id := Make_Defining_Identifier (Loc,
+                             New_Internal_Name ('T'));
+
+               New_Thunk :=
+                 Expand_Interface_Thunk
+                  (N           => Prim,
+                   Thunk_Alias => Prim,
+                   Thunk_Id    => Thunk_Id,
+                   Thunk_Tag   => Iface_Tag);
+
+               Insert_After (N, New_Thunk);
+               Insert_After (New_Thunk,
+                 Make_DT_Access_Action (Node (Iface_Typ),
+                   Action => Set_Prim_Op_Address,
+                   Args   => New_List (
+                     Unchecked_Convert_To (RTE (RE_Tag),
+                       New_Reference_To (Node (Iface_DT_Ptr), Loc)),
+
+                     Make_Integer_Literal (Loc, DT_Position (Prim)),
+
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => New_Reference_To (Thunk_Id, Loc),
+                       Attribute_Name => Name_Address))));
+            end if;
+
+            Next_Elmt (Iface_DT_Ptr);
+            Next_Elmt (Iface_Typ);
+         end loop;
+      end Register_Predefined_DT_Entry;
+
    --  Start of processing for Freeze_Subprogram
 
    begin
@@ -4297,19 +4446,38 @@ package body Exp_Ch6 is
               Fill_DT_Entry (Sloc (N), Prim => E));
 
          else
-            --  Ada 2005 (AI-251): Check if this entry corresponds with
-            --  a subprogram that covers an abstract interface type.
+            declare
+               Typ : constant Entity_Id := Scope (DTC_Entity (E));
 
-            if Present (Abstract_Interface_Alias (E)) then
-               Register_Interface_DT_Entry (E);
+            begin
+               --  There is no dispatch table associated with abstract
+               --  interface types; each type implementing interfaces
+               --  will fill the associated secondary DT entries.
 
-            --  Common case: Primitive subprogram
+               if not Is_Interface (Typ)
+                 or else Present (Alias (E))
+               then
+                  --  Ada 2005 (AI-251): Check if this entry corresponds with
+                  --  a subprogram that covers an abstract interface type.
 
-            else
-               Insert_After (N,
-                 Fill_DT_Entry (Sloc (N), Prim => E));
-               Check_Overriding_Inherited_Interfaces (E);
-            end if;
+                  if Present (Abstract_Interface_Alias (E)) then
+                     Register_Interface_DT_Entry (E);
+
+                  --  Common case: Primitive subprogram
+
+                  else
+                     --  Generate thunks for all the predefined operations
+
+                     if Is_Predefined_Dispatching_Operation (E) then
+                        Register_Predefined_DT_Entry (E);
+                     end if;
+
+                     Insert_After (N,
+                       Fill_DT_Entry (Sloc (N), Prim => E));
+                     Check_Overriding_Inherited_Interfaces (E);
+                  end if;
+               end if;
+            end;
          end if;
       end if;
 
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index f7d0119..b0bad8c 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1793,6 +1793,13 @@ package body Exp_Ch7 is
                   return The_Parent;
                end if;
 
+            --  A raise statement can be wrapped. This will arise when the
+            --  expression in a raise_with_expression uses the secondary
+            --  stack, for example.
+
+            when N_Raise_Statement  =>
+               return The_Parent;
+
             --  If the expression is within the iteration scheme of a loop,
             --  we must create a declaration for it, followed by an assignment
             --  in order to have a usable statement to wrap.
@@ -2728,13 +2735,27 @@ package body Exp_Ch7 is
       Utyp := Underlying_Type (Base_Type (Utyp));
       Set_Assignment_OK (Cref);
 
-      --  Deal with non-tagged derivation of private views
+      --  Deal with non-tagged derivation of private views. If the parent is
+      --  now known to be protected, the finalization routine is the one
+      --  defined on the corresponding record of the ancestor (corresponding
+      --  records do not automatically inherit operations, but maybe they
+      --  should???)
 
       if Is_Untagged_Derivation (Typ) then
-         Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
+         if Is_Protected_Type (Typ) then
+            Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
+         else
+            Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
+         end if;
+
          Cref := Unchecked_Convert_To (Utyp, Cref);
+
+         --  We need to set Assignment_OK to prevent problems with unchecked
+         --  conversions, where we do not want them to be converted back in the
+         --  case of untagged record derivation (see code in Make_*_Call
+         --  procedures for similar situations).
+
          Set_Assignment_OK (Cref);
-         --  To prevent problems with UC see 1.156 RH ???
       end if;
 
       --  If the underlying_type is a subtype, we are dealing with
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 6911d86..3943dc4 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -65,21 +65,33 @@ package body Exp_Ch9 is
    -- Select_Expansion_Utilities --
    --------------------------------
 
+   --  The following constant establishes the upper bound for the index of
+   --  an entry family. It is used to limit the allocated size of protected
+   --  types with defaulted discriminant of an integer type, when the bound
+   --  of some entry family depends on a discriminant. The limitation to
+   --  entry families of 128K should be reasonable in all cases, and is a
+   --  documented implementation restriction. It will be lifted when protected
+   --  entry families are re-implemented as a single ordered queue.
+
+   Entry_Family_Bound : constant Int := 2**16;
+
    --  The following package contains helper routines used in the expansion of
    --  dispatching asynchronous, conditional and timed selects.
 
    package Select_Expansion_Utilities is
       function Build_Abort_Block
-        (Loc     : Source_Ptr;
-         Blk_Ent : Entity_Id;
-         Blk     : Node_Id) return Node_Id;
+        (Loc         : Source_Ptr;
+         Abr_Blk_Ent : Entity_Id;
+         Cln_Blk_Ent : Entity_Id;
+         Blk         : Node_Id) return Node_Id;
       --  Generate:
       --    begin
       --       Blk
       --    exception
       --       when Abort_Signal => Abort_Undefer;
       --    end;
-      --  Blk_Ent is the name of the encapsulated block, Blk is the actual
+      --  Abr_Blk_Ent is the name of the generated block, Cln_Blk_Ent is
+      --  the name of the encapsulated cleanup block, Blk is the actual
       --  block node.
 
       function Build_B
@@ -121,28 +133,23 @@ package body Exp_Ch9 is
       function Build_S
         (Loc      : Source_Ptr;
          Decls    : List_Id;
+         Obj      : Entity_Id;
          Call_Ent : Entity_Id) return Entity_Id;
       --  Generate:
-      --    S : constant Integer := DT_Position (Call_Ent);
-      --  where Call_Ent is the entity of the dispatching call name. Append
-      --  the object declaration to the list and return the name of the
-      --  object.
+      --    S : constant Integer :=
+      --          Ada.Tags.Get_Offset_Index (
+      --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
+      --            DT_Position (Call_Ent));
+      --  where Obj is the pointer to a secondary table, Call_Ent is the
+      --  entity of the dispatching call name. Append the object declaration
+      --  to the list and return its defining identifier.
 
-      function Build_Wrapping_Procedure
-        (Loc   : Source_Ptr;
-         Nam   : Character;
-         Decls : List_Id;
-         Stmts : List_Id) return Entity_Id;
-      --  Generate:
-      --    procedure <temp>Nam is
-      --    begin
-      --       Stmts
-      --    end <temp>Nam;
-      --  where Nam is the generated procedure name and Stmts are the
-      --  encapsulated statements. Append the procedure body to Decls.
-      --  Return the internally generated procedure name.
    end Select_Expansion_Utilities;
 
+   -----------------------------------------
+   -- Body for Select_Expansion_Utilities --
+   -----------------------------------------
+
    package body Select_Expansion_Utilities is
 
       -----------------------
@@ -150,15 +157,17 @@ package body Exp_Ch9 is
       -----------------------
 
       function Build_Abort_Block
-        (Loc   : Source_Ptr;
-         Blk_Ent : Entity_Id;
-         Blk     : Node_Id) return Node_Id
+        (Loc         : Source_Ptr;
+         Abr_Blk_Ent : Entity_Id;
+         Cln_Blk_Ent : Entity_Id;
+         Blk         : Node_Id) return Node_Id
       is
       begin
          return
            Make_Block_Statement (Loc,
-             Declarations =>
-               No_List,
+             Identifier   => New_Reference_To (Abr_Blk_Ent, Loc),
+
+             Declarations => No_List,
 
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
@@ -166,7 +175,7 @@ package body Exp_Ch9 is
                    New_List (
                      Make_Implicit_Label_Declaration (Loc,
                        Defining_Identifier =>
-                         Blk_Ent,
+                         Cln_Blk_Ent,
                        Label_Construct =>
                          Blk),
                      Blk),
@@ -194,7 +203,8 @@ package body Exp_Ch9 is
         (Loc   : Source_Ptr;
          Decls : List_Id) return Entity_Id
       is
-         B : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uB);
+         B : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                     Chars => New_Internal_Name ('B'));
 
       begin
          Append_To (Decls,
@@ -217,7 +227,8 @@ package body Exp_Ch9 is
         (Loc   : Source_Ptr;
          Decls : List_Id) return Entity_Id
       is
-         C : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uC);
+         C : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                     Chars => New_Internal_Name ('C'));
 
       begin
          Append_To (Decls,
@@ -262,52 +273,30 @@ package body Exp_Ch9 is
       function Build_S
         (Loc      : Source_Ptr;
          Decls    : List_Id;
+         Obj      : Entity_Id;
          Call_Ent : Entity_Id) return Entity_Id
       is
-         S : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uS);
+         S : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                     Chars => New_Internal_Name ('S'));
 
       begin
          Append_To (Decls,
            Make_Object_Declaration (Loc,
              Defining_Identifier => S,
              Constant_Present    => True,
+
              Object_Definition   =>
                New_Reference_To (Standard_Integer, Loc),
+
              Expression          =>
-               Make_Integer_Literal (Loc,
-                 Intval => DT_Position (Call_Ent))));
+               Make_Function_Call (Loc,
+                 Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
+                 Parameter_Associations => New_List (
+                   Unchecked_Convert_To (RTE (RE_Interface_Tag), Obj),
+                   Make_Integer_Literal (Loc, DT_Position (Call_Ent))))));
 
          return S;
       end Build_S;
-
-      ------------------------------
-      -- Build_Wrapping_Procedure --
-      ------------------------------
-
-      function Build_Wrapping_Procedure
-        (Loc   : Source_Ptr;
-         Nam   : Character;
-         Decls : List_Id;
-         Stmts : List_Id) return Entity_Id
-      is
-         Proc_Nam : constant Entity_Id :=
-                      Make_Defining_Identifier (Loc, New_Internal_Name (Nam));
-      begin
-         Append_To (Decls,
-           Make_Subprogram_Body (Loc,
-             Specification =>
-               Make_Procedure_Specification (Loc,
-                 Defining_Unit_Name =>
-                   Proc_Nam),
-             Declarations =>
-               No_List,
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements =>
-                   New_Copy_List (Stmts))));
-
-         return Proc_Nam;
-      end Build_Wrapping_Procedure;
    end Select_Expansion_Utilities;
 
    package SEU renames Select_Expansion_Utilities;
@@ -335,6 +324,18 @@ package body Exp_Ch9 is
    --  of the System.Address pointer passed to entry barrier functions
    --  and entry body procedures.
 
+   procedure Add_Formal_Renamings
+     (Spec  : Node_Id;
+      Decls : List_Id;
+      Ent   : Entity_Id;
+      Loc   : Source_Ptr);
+   --  Create renaming declarations for the formals, inside the procedure
+   --  that implements an entry body. The renamings make the original names
+   --  of the formals accessible to gdb, and serve no other purpose.
+   --    Spec is the specification of the procedure being built.
+   --    Decls is the list of declarations to be enhanced.
+   --    Ent is the entity for the original entry body.
+
    function Build_Accept_Body (Astat : Node_Id) return Node_Id;
    --  Transform accept statement into a block with added exception handler.
    --  Used both for simple accept statements and for accept alternatives in
@@ -463,8 +464,9 @@ package body Exp_Ch9 is
    --  The object is a limited record and therefore a by_reference type.
 
    function Build_Selected_Name
-     (Prefix, Selector : Name_Id;
-      Append_Char      : Character := ' ') return Name_Id;
+     (Prefix      : Entity_Id;
+      Selector    : Entity_Id;
+      Append_Char : Character := ' ') return Name_Id;
    --  Build a name in the form of Prefix__Selector, with an optional
    --  character appended. This is used for internal subprograms generated
    --  for operations of protected types, including barrier functions.
@@ -572,7 +574,7 @@ package body Exp_Ch9 is
       Actuals : List_Id;
       Formals : List_Id;
       Decls   : List_Id;
-      Stmts   : List_Id) return Node_Id;
+      Stmts   : List_Id) return Entity_Id;
    --  Set the components of the generated parameter block with the values of
    --  the actual parameters. Generate aliased temporaries to capture the
    --  values for types that are passed by copy. Otherwise generate a reference
@@ -588,6 +590,7 @@ package body Exp_Ch9 is
 
    function Parameter_Block_Unpack
      (Loc     : Source_Ptr;
+      P       : Entity_Id;
       Actuals : List_Id;
       Formals : List_Id) return List_Id;
    --  Retrieve the values of the components from the parameter block and
@@ -795,6 +798,7 @@ package body Exp_Ch9 is
       Pid   : Entity_Id;
       Loc   : Source_Ptr)
    is
+      Decl    : Node_Id;
       Obj_Ptr : Node_Id;
 
    begin
@@ -812,14 +816,16 @@ package body Exp_Ch9 is
             New_External_Name
               (Chars (Corresponding_Record_Type (Pid)), 'P'));
 
-      Prepend_To (Decls,
+      Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier =>
             Make_Defining_Identifier (Loc, Name_uObject),
           Object_Definition => New_Reference_To (Obj_Ptr, Loc),
           Expression =>
             Unchecked_Convert_To (Obj_Ptr,
-              Make_Identifier (Loc, Name_uO))));
+              Make_Identifier (Loc, Name_uO)));
+      Set_Needs_Debug_Info (Defining_Identifier (Decl));
+      Prepend_To (Decls, Decl);
 
       Prepend_To (Decls,
         Make_Full_Type_Declaration (Loc,
@@ -829,6 +835,65 @@ package body Exp_Ch9 is
               New_Reference_To (Corresponding_Record_Type (Pid), Loc))));
    end Add_Object_Pointer;
 
+   --------------------------
+   -- Add_Formal_Renamings --
+   --------------------------
+
+   procedure Add_Formal_Renamings
+     (Spec  : Node_Id;
+      Decls : List_Id;
+      Ent   : Entity_Id;
+      Loc   : Source_Ptr)
+   is
+      Ptr : constant Entity_Id :=
+              Defining_Identifier
+                (Next (First (Parameter_Specifications (Spec))));
+      --  The name of the formal that holds the address of the parameter block
+      --  for the call.
+
+      Comp   : Entity_Id;
+      Decl   : Node_Id;
+      Formal : Entity_Id;
+      New_F  : Entity_Id;
+
+   begin
+      Formal := First_Formal (Ent);
+      while Present (Formal) loop
+         Comp   := Entry_Component (Formal);
+         New_F  :=
+           Make_Defining_Identifier (Sloc (Formal), Chars (Formal));
+         Set_Etype (New_F, Etype (Formal));
+         Set_Scope (New_F, Ent);
+         Set_Needs_Debug_Info (New_F);   --  That's the whole point.
+
+         if Ekind (Formal) = E_In_Parameter then
+            Set_Ekind (New_F, E_Constant);
+         else
+            Set_Ekind (New_F, E_Variable);
+            Set_Extra_Constrained (New_F, Extra_Constrained (Formal));
+         end if;
+
+         Set_Actual_Subtype (New_F, Actual_Subtype (Formal));
+
+         Decl :=
+           Make_Object_Renaming_Declaration (Loc,
+           Defining_Identifier => New_F,
+           Subtype_Mark => New_Reference_To (Etype (Formal), Loc),
+           Name =>
+             Make_Explicit_Dereference (Loc,
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Unchecked_Convert_To (Entry_Parameters_Type (Ent),
+                     Make_Identifier (Loc, Chars (Ptr))),
+                 Selector_Name =>
+                   New_Reference_To (Comp, Loc))));
+
+         Append (Decl, Decls);
+         Set_Renamed_Object (Formal, New_F);
+         Next_Formal (Formal);
+      end loop;
+   end Add_Formal_Renamings;
+
    ------------------------------
    -- Add_Private_Declarations --
    ------------------------------
@@ -840,6 +905,7 @@ package body Exp_Ch9 is
       Loc   : Source_Ptr)
    is
       Def      : constant Node_Id   := Protected_Definition (Parent (Typ));
+      Decl     : Node_Id;
       Body_Ent : constant Entity_Id := Corresponding_Body   (Parent (Typ));
       P        : Node_Id;
       Pdef     : Entity_Id;
@@ -849,28 +915,30 @@ package body Exp_Ch9 is
 
       if Present (Private_Declarations (Def)) then
          P := First (Private_Declarations (Def));
-
          while Present (P) loop
             if Nkind (P) = N_Component_Declaration then
                Pdef := Defining_Identifier (P);
-               Prepend_To (Decls,
+               Decl :=
                  Make_Object_Renaming_Declaration (Loc,
                    Defining_Identifier => Prival (Pdef),
                    Subtype_Mark => New_Reference_To (Etype (Pdef), Loc),
                    Name =>
                      Make_Selected_Component (Loc,
                        Prefix        => Make_Identifier (Loc, Name),
-                       Selector_Name => Make_Identifier (Loc, Chars (Pdef)))));
+                       Selector_Name => Make_Identifier (Loc, Chars (Pdef))));
+               Set_Needs_Debug_Info (Defining_Identifier (Decl));
+               Prepend_To (Decls, Decl);
             end if;
+
             Next (P);
          end loop;
       end if;
 
-      --  One more "prival" for the object itself, with the right protection
-      --  type.
+      --  One more "prival" for object itself, with the right protection type
 
       declare
          Protection_Type : RE_Id;
+
       begin
          if Has_Attach_Handler (Typ) then
             if Restricted_Profile then
@@ -906,14 +974,16 @@ package body Exp_Ch9 is
             Protection_Type := RE_Protection;
          end if;
 
-         Prepend_To (Decls,
+         Decl :=
            Make_Object_Renaming_Declaration (Loc,
              Defining_Identifier => Object_Ref (Body_Ent),
              Subtype_Mark => New_Reference_To (RTE (Protection_Type), Loc),
              Name =>
                Make_Selected_Component (Loc,
                  Prefix        => Make_Identifier (Loc, Name),
-                 Selector_Name => Make_Identifier (Loc, Name_uObject))));
+                 Selector_Name => Make_Identifier (Loc, Name_uObject)));
+         Set_Needs_Debug_Info (Defining_Identifier (Decl));
+         Prepend_To (Decls, Decl);
       end;
    end Add_Private_Declarations;
 
@@ -931,9 +1001,9 @@ package body Exp_Ch9 is
 
    begin
       --  At the end of the statement sequence, Complete_Rendezvous is called.
-      --  A label skipping the Complete_Rendezvous, and all other
-      --  accept processing, has already been added for the expansion
-      --  of requeue statements.
+      --  A label skipping the Complete_Rendezvous, and all other accept
+      --  processing, has already been added for the expansion of requeue
+      --  statements.
 
       Call := Build_Runtime_Call (Loc, RE_Complete_Rendezvous);
       Insert_Before (Last (Statements (Stats)), Call);
@@ -1161,7 +1231,6 @@ package body Exp_Ch9 is
       E : Entity_Id) return Node_Id
    is
       Loc : constant Source_Ptr := Sloc (N);
-
    begin
       return
         Make_Function_Call (Loc,
@@ -1247,7 +1316,8 @@ package body Exp_Ch9 is
               Component_List =>
                 Make_Component_List (Loc,
                   Component_Items => Cdecls),
-              Tagged_Present  => Ada_Version >= Ada_05,
+              Tagged_Present  =>
+                 Ada_Version >= Ada_05 and then Is_Tagged_Type (Ctyp),
               Limited_Present => True));
    end Build_Corresponding_Record;
 
@@ -1269,11 +1339,10 @@ package body Exp_Ch9 is
       Typ    : Entity_Id;
 
    begin
-      Ent := First_Entity (Concurrent_Type);
-      Eindx := 0;
-
       --  Count number of non-family entries
 
+      Eindx := 0;
+      Ent := First_Entity (Concurrent_Type);
       while Present (Ent) loop
          if Ekind (Ent) = E_Entry then
             Eindx := Eindx + 1;
@@ -1288,7 +1357,6 @@ package body Exp_Ch9 is
 
       Ent := First_Entity (Concurrent_Type);
       Comp := First (Component_List);
-
       while Present (Ent) loop
          if Ekind (Ent) = E_Entry_Family then
             while Chars (Ent) /= Chars (Defining_Identifier (Comp)) loop
@@ -1323,75 +1391,97 @@ package body Exp_Ch9 is
    is
       Actual   : Entity_Id;
       Comp_Nam : Node_Id;
-      Comp_Rec : Node_Id;
       Comps    : List_Id;
       Formal   : Entity_Id;
+      Has_Comp : Boolean := False;
+      Rec_Nam  : Node_Id;
 
    begin
       Actual := First (Actuals);
       Comps  := New_List;
       Formal := Defining_Identifier (First (Formals));
+
       while Present (Actual) loop
-         --  Generate:
-         --    type Ann is access all <actual-type>
+         if not Is_Controlling_Actual (Actual) then
 
-         Comp_Nam :=
-           Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+            --  Generate:
+            --    type Ann is access all <actual-type>
 
-         Append_To (Decls,
-           Make_Full_Type_Declaration (Loc,
-             Defining_Identifier =>
-               Comp_Nam,
-             Type_Definition =>
-               Make_Access_To_Object_Definition (Loc,
-                 All_Present =>
-                   True,
-                 Constant_Present =>
-                   Ekind (Formal) = E_In_Parameter,
-                 Subtype_Indication =>
-                   New_Reference_To (Etype (Actual), Loc))));
+            Comp_Nam :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
 
-         --  Generate:
-         --    Param : Ann;
+            Append_To (Decls,
+              Make_Full_Type_Declaration (Loc,
+                Defining_Identifier =>
+                  Comp_Nam,
+                Type_Definition =>
+                  Make_Access_To_Object_Definition (Loc,
+                    All_Present =>
+                      True,
+                    Constant_Present =>
+                      Ekind (Formal) = E_In_Parameter,
+                    Subtype_Indication =>
+                      New_Reference_To (Etype (Actual), Loc))));
 
-         Append_To (Comps,
-           Make_Component_Declaration (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Chars (Formal)),
-             Component_Definition =>
-               Make_Component_Definition (Loc,
-                 Aliased_Present =>
-                   False,
-                 Subtype_Indication =>
-                   New_Reference_To (Comp_Nam, Loc))));
+            --  Generate:
+            --    Param : Ann;
+
+            Append_To (Comps,
+              Make_Component_Declaration (Loc,
+                Defining_Identifier =>
+                  Make_Defining_Identifier (Loc, Chars (Formal)),
+                Component_Definition =>
+                  Make_Component_Definition (Loc,
+                    Aliased_Present =>
+                      False,
+                    Subtype_Indication =>
+                      New_Reference_To (Comp_Nam, Loc))));
+
+            Has_Comp := True;
+         end if;
 
          Next_Actual (Actual);
          Next_Formal_With_Extras (Formal);
       end loop;
 
-      --  Generate:
-      --    type Pnn is record
-      --       Param1 : Ann1;
-      --       ...
-      --       ParamN : AnnN;
+      Rec_Nam :=
+        Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
 
-      --  where Pnn is a parameter wrapping record, Param1 .. ParamN are the
-      --  original parameter names and Ann1 .. AnnN are the access to actual
-      --  types.
+      if Has_Comp then
 
-      Comp_Rec :=
-        Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+         --  Generate:
+         --    type Pnn is record
+         --       Param1 : Ann1;
+         --       ...
+         --       ParamN : AnnN;
 
-      Append_To (Decls,
-        Make_Full_Type_Declaration (Loc,
-          Defining_Identifier =>
-            Comp_Rec,
-          Type_Definition =>
-            Make_Record_Definition (Loc,
-              Component_List =>
-                Make_Component_List (Loc, Comps))));
+         --  where Pnn is a parameter wrapping record, Param1 .. ParamN are
+         --  the original parameter names and Ann1 .. AnnN are the access to
+         --  actual types.
+
+         Append_To (Decls,
+           Make_Full_Type_Declaration (Loc,
+             Defining_Identifier =>
+               Rec_Nam,
+             Type_Definition =>
+               Make_Record_Definition (Loc,
+                 Component_List =>
+                   Make_Component_List (Loc, Comps))));
+      else
+         --  Generate:
+         --    type Pnn is null record;
 
-      return Comp_Rec;
+         Append_To (Decls,
+           Make_Full_Type_Declaration (Loc,
+             Defining_Identifier =>
+               Rec_Nam,
+             Type_Definition =>
+               Make_Record_Definition (Loc,
+                 Null_Present   => True,
+                 Component_List => Empty)));
+      end if;
+
+      return Rec_Nam;
    end Build_Parameter_Block;
 
    ------------------------
@@ -1579,8 +1669,8 @@ package body Exp_Ch9 is
                --  The two parameters must be mode conformant and have
                --  the exact same types.
 
-               if Out_Present (Prim_Op_Param) /= Out_Present (Proc_Param)
-                 or else In_Present (Prim_Op_Param) /= In_Present (Proc_Param)
+               if Ekind (Defining_Identifier (Prim_Op_Param)) /=
+                  Ekind (Defining_Identifier (Proc_Param))
                  or else Etype (Parameter_Type (Prim_Op_Param)) /=
                          Etype (Parameter_Type (Proc_Param))
                then
@@ -1637,7 +1727,6 @@ package body Exp_Ch9 is
          return Type_Conformant_Parameters (
            Parameter_Specifications (Prim_Op_Spec),
            Parameter_Specifications (Proc_Spec));
-
       end Overriding_Possible;
 
       -----------------------------
@@ -1653,25 +1742,22 @@ package body Exp_Ch9 is
 
       begin
          Formal := First (Formals);
+         while Present (Formal) loop
 
-         if Present (Formal) then
-            while Present (Formal) loop
+            --  Create an explicit copy of the entry parameter
 
-               --  Create an explicit copy of the entry parameter
+            Append_To (New_Formals,
+              Make_Parameter_Specification (Loc,
+                Defining_Identifier =>
+                  Make_Defining_Identifier (Loc,
+                    Chars          => Chars (Defining_Identifier (Formal))),
+                    In_Present     => In_Present  (Formal),
+                    Out_Present    => Out_Present (Formal),
+                    Parameter_Type => New_Reference_To (Etype (
+                                        Parameter_Type (Formal)), Loc)));
 
-               Append_To (New_Formals,
-                 Make_Parameter_Specification (Loc,
-                   Defining_Identifier =>
-                     Make_Defining_Identifier (Loc,
-                       Chars => Chars (Defining_Identifier (Formal))),
-                   In_Present  => In_Present  (Formal),
-                   Out_Present => Out_Present (Formal),
-                   Parameter_Type => New_Reference_To (Etype (
-                                       Parameter_Type (Formal)), Loc)));
-
-               Next (Formal);
-            end loop;
-         end if;
+            Next (Formal);
+         end loop;
 
          return New_Formals;
       end Replicate_Entry_Formals;
@@ -1697,10 +1783,13 @@ package body Exp_Ch9 is
 
          if Present (Primitive_Operations (Iface)) then
             Iface_Prim_Op_Elmt := First_Elmt (Primitive_Operations (Iface));
-
             while Present (Iface_Prim_Op_Elmt) loop
                Iface_Prim_Op := Node (Iface_Prim_Op_Elmt);
 
+               while Present (Alias (Iface_Prim_Op)) loop
+                  Iface_Prim_Op := Alias (Iface_Prim_Op);
+               end loop;
+
                --  The current primitive operation can be overriden by the
                --  generated entry wrapper.
 
@@ -1897,9 +1986,7 @@ package body Exp_Ch9 is
       Spec := Build_Find_Body_Index_Spec (Typ);
 
       Ent := First_Entity (Typ);
-
       while Present (Ent) loop
-
          if Ekind (Ent) = E_Entry_Family then
             Has_F := True;
             exit;
@@ -1955,12 +2042,10 @@ package body Exp_Ch9 is
 
          elsif Nkind (Ret) = N_If_Statement then
 
-            --  Ranges are in increasing order, so last one doesn't need a
-            --  guard.
+            --  Ranges are in increasing order, so last one doesn't need guard
 
             declare
                Nod : constant Node_Id := Last (Elsif_Parts (Ret));
-
             begin
                Remove (Nod);
                Set_Else_Statements (Ret, Then_Statements (Nod));
@@ -2021,7 +2106,8 @@ package body Exp_Ch9 is
       S := Scope (E);
 
       --  Ada 2005 (AI-287): Do not set/get the has_master_entity reminder
-      --  in internal scopes. Required for nested limited aggregates.
+      --  in internal scopes, unless present already.. Required for nested
+      --  limited aggregates. This could use some more explanation ????
 
       if Ada_Version >= Ada_05 then
          while Is_Internal (S) loop
@@ -2110,12 +2196,17 @@ package body Exp_Ch9 is
       Espec := Build_Protected_Entry_Specification (Edef, Empty, Loc);
 
       --  <object pointer declaration>
-      --  Add object pointer declaration. This is needed by the
-      --  discriminal and prival renamings, which should already
-      --  have been inserted into the declaration list.
+
+      --  Add object pointer declaration. This is needed by the discriminal and
+      --  prival renamings, which should already have been inserted into the
+      --  declaration list.
 
       Add_Object_Pointer (Op_Decls, Pid, Loc);
 
+      --  Add renamings for formals for use by debugger
+
+      Add_Formal_Renamings (Espec, Op_Decls, Ent, Loc);
+
       if Abort_Allowed
         or else Restriction_Active (No_Entry_Queue) = False
         or else Number_Entries (Pid) > 1
@@ -2169,6 +2260,9 @@ package body Exp_Ch9 is
               RTE (RE_Exceptional_Complete_Single_Entry_Body), Loc);
          end if;
 
+         --  Create body of entry procedure. The renaming declarations are
+         --  placed ahead of the block that contains the actual entry body.
+
          return
            Make_Subprogram_Body (Loc,
              Specification => Espec,
@@ -2248,6 +2342,7 @@ package body Exp_Ch9 is
       Ident       : Entity_Id) return List_Id
    is
       Loc         : constant Source_Ptr := Sloc (N);
+      Decl        : Node_Id;
       Formal      : Entity_Id;
       New_Plist   : List_Id;
       New_Param   : Node_Id;
@@ -2255,7 +2350,6 @@ package body Exp_Ch9 is
    begin
       New_Plist := New_List;
       Formal := First_Formal (Ident);
-
       while Present (Formal) loop
          New_Param :=
            Make_Parameter_Specification (Loc,
@@ -2278,7 +2372,7 @@ package body Exp_Ch9 is
       --  to protected subprogram, the parameter is in-out. Otherwise it is
       --  an in parameter.
 
-      Prepend_To (New_Plist,
+      Decl :=
         Make_Parameter_Specification (Loc,
           Defining_Identifier =>
             Make_Defining_Identifier (Loc, Name_uObject),
@@ -2286,7 +2380,9 @@ package body Exp_Ch9 is
           Out_Present =>
            (Etype (Ident) = Standard_Void_Type
               and then not Is_RTE (Obj_Type, RE_Address)),
-          Parameter_Type => New_Reference_To (Obj_Type, Loc)));
+          Parameter_Type => New_Reference_To (Obj_Type, Loc));
+      Set_Needs_Debug_Info (Defining_Identifier (Decl));
+      Prepend_To (New_Plist, Decl);
 
       return New_Plist;
    end Build_Protected_Spec;
@@ -2302,9 +2398,7 @@ package body Exp_Ch9 is
    is
       Loc       : constant Source_Ptr := Sloc (N);
       Decl      : Node_Id;
-      Protnm    : constant Name_Id := Chars (Prottyp);
       Ident     : Entity_Id;
-      Nam       : Name_Id;
       New_Id    : Entity_Id;
       New_Plist : List_Id;
       New_Spec  : Node_Id;
@@ -2324,7 +2418,6 @@ package body Exp_Ch9 is
       end if;
 
       Ident := Defining_Unit_Name (Specification (Decl));
-      Nam := Chars (Ident);
 
       New_Plist :=
         Build_Protected_Spec (Decl,
@@ -2333,7 +2426,7 @@ package body Exp_Ch9 is
 
       New_Id :=
         Make_Defining_Identifier (Loc,
-          Chars => Build_Selected_Name (Protnm, Nam, Append_Chr (Mode)));
+          Chars => Build_Selected_Name (Prottyp, Ident, Append_Chr (Mode)));
 
       --  The unprotected operation carries the user code, and debugging
       --  information must be generated for it, even though this spec does
@@ -2397,24 +2490,28 @@ package body Exp_Ch9 is
       function Is_Exception_Safe (Subprogram : Node_Id) return Boolean is
 
          function Has_Side_Effect (N : Node_Id) return Boolean;
-         --  Return True whenever encountering a subprogram call or a
-         --  raise statement of any kind in the sequence of statements N
+         --  Return True whenever encountering a subprogram call or raise
+         --  statement of any kind in the sequence of statements
 
          ---------------------
          -- Has_Side_Effect --
          ---------------------
 
-         --  What is this doing buried two levels down in exp_ch9. It
-         --  seems like a generally useful function, and indeed there
-         --  may be code duplication going on here ???
+         --  What is this doing buried two levels down in exp_ch9. It seems
+         --  like a generally useful function, and indeed there may be code
+         --  duplication going on here ???
 
          function Has_Side_Effect (N : Node_Id) return Boolean is
-            Stmt : Node_Id := N;
+            Stmt : Node_Id;
             Expr : Node_Id;
 
             function Is_Call_Or_Raise (N : Node_Id) return Boolean;
             --  Indicate whether N is a subprogram call or a raise statement
 
+            ----------------------
+            -- Is_Call_Or_Raise --
+            ----------------------
+
             function Is_Call_Or_Raise (N : Node_Id) return Boolean is
             begin
                return Nkind (N) = N_Procedure_Call_Statement
@@ -2428,6 +2525,7 @@ package body Exp_Ch9 is
          --  Start of processing for Has_Side_Effect
 
          begin
+            Stmt := N;
             while Present (Stmt) loop
                if Is_Call_Or_Raise (Stmt) then
                   return True;
@@ -2485,13 +2583,12 @@ package body Exp_Ch9 is
       P_Op_Spec :=
         Build_Protected_Sub_Specification (N, Pid, Protected_Mode);
 
-      --  Build a list of the formal parameters of the protected
-      --  version of the subprogram to use as the actual parameters
-      --  of the unprotected version.
+      --  Build a list of the formal parameters of the protected version of
+      --  the subprogram to use as the actual parameters of the unprotected
+      --  version.
 
       Uactuals := New_List;
       Pformal := First (Parameter_Specifications (P_Op_Spec));
-
       while Present (Pformal) loop
          Append (
            Make_Identifier (Loc, Chars (Defining_Identifier (Pformal))),
@@ -2499,8 +2596,8 @@ package body Exp_Ch9 is
          Next (Pformal);
       end loop;
 
-      --  Make a call to the unprotected version of the subprogram
-      --  built above for use by the protected version built below.
+      --  Make a call to the unprotected version of the subprogram built above
+      --  for use by the protected version built below.
 
       if Nkind (Op_Spec) = N_Function_Specification then
          if Exc_Safe then
@@ -2711,17 +2808,18 @@ package body Exp_Ch9 is
    -------------------------
 
    function Build_Selected_Name
-     (Prefix, Selector : Name_Id;
-      Append_Char      : Character := ' ') return Name_Id
+     (Prefix      : Entity_Id;
+      Selector    : Entity_Id;
+      Append_Char : Character := ' ') return Name_Id
    is
       Select_Buffer : String (1 .. Hostparm.Max_Name_Length);
       Select_Len    : Natural;
 
    begin
-      Get_Name_String (Selector);
+      Get_Name_String (Chars (Selector));
       Select_Len := Name_Len;
       Select_Buffer (1 .. Select_Len) := Name_Buffer (1 .. Name_Len);
-      Get_Name_String (Prefix);
+      Get_Name_String (Chars (Prefix));
 
       --  If scope is anonymous type, discard suffix to recover name of
       --  single protected object. Otherwise use protected type name.
@@ -2739,12 +2837,28 @@ package body Exp_Ch9 is
          Name_Buffer (Name_Len) := Select_Buffer (J);
       end loop;
 
+      --  Now add the Append_Char if specified. The encoding to follow
+      --  depends on the type of entity. If Append_Char is either 'N' or 'P',
+      --  then the entity is associated to a protected type subprogram.
+      --  Otherwise, it is a protected type entry. For each case, the
+      --  encoding to follow for the suffix is documented in exp_dbug.ads.
+
+      --  It would be better to encapsulate this as a routine in Exp_Dbug ???
+
       if Append_Char /= ' ' then
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Append_Char;
+         if Append_Char = 'P' or Append_Char = 'N' then
+            Name_Len := Name_Len + 1;
+            Name_Buffer (Name_Len) := Append_Char;
+            return Name_Find;
+         else
+            Name_Buffer (Name_Len + 1) := '_';
+            Name_Buffer (Name_Len + 2) := Append_Char;
+            Name_Len := Name_Len + 2;
+            return New_External_Name (Name_Find, ' ', -1);
+         end if;
+      else
+         return Name_Find;
       end if;
-
-      return Name_Find;
    end Build_Selected_Name;
 
    -----------------------------
@@ -2815,24 +2929,26 @@ package body Exp_Ch9 is
          Loc       : constant Source_Ptr := Sloc (N);
          Parms     : constant List_Id    := Parameter_Associations (N);
          Stats     : constant List_Id    := New_List;
-         Pdecl     : Node_Id;
-         Xdecl     : Node_Id;
-         Decls     : List_Id;
+         Actual    : Node_Id;
+         Call      : Node_Id;
+         Comm_Name : Entity_Id;
          Conctyp   : Node_Id;
+         Decls     : List_Id;
          Ent       : Entity_Id;
          Ent_Acc   : Entity_Id;
+         Formal    : Node_Id;
+         Iface_Tag : Entity_Id;
+         Iface_Typ : Entity_Id;
+         N_Node    : Node_Id;
+         N_Var     : Node_Id;
          P         : Entity_Id;
-         X         : Entity_Id;
-         Plist     : List_Id;
          Parm1     : Node_Id;
          Parm2     : Node_Id;
          Parm3     : Node_Id;
-         Call      : Node_Id;
-         Actual    : Node_Id;
-         Formal    : Node_Id;
-         N_Node    : Node_Id;
-         N_Var     : Node_Id;
-         Comm_Name : Entity_Id;
+         Pdecl     : Node_Id;
+         Plist     : List_Id;
+         X         : Entity_Id;
+         Xdecl     : Node_Id;
 
       begin
          --  Simple entry and entry family cases merge here
@@ -2899,7 +3015,7 @@ package body Exp_Ch9 is
          end if;
 
          --  The third parameter is the packaged parameters. If there are
-         --  none, then it is just the null address, since nothing is passed
+         --  none, then it is just the null address, since nothing is passed.
 
          if No (Parms) then
             Parm3 := New_Reference_To (RTE (RE_Null_Address), Loc);
@@ -2909,8 +3025,8 @@ package body Exp_Ch9 is
          --  of a packaged record containing the required parameter values.
 
          else
-            --  First build a list of parameter values, which are
-            --  references to objects of the parameter types.
+            --  First build a list of parameter values, which are references to
+            --  objects of the parameter types.
 
             Plist := New_List;
 
@@ -2932,9 +3048,9 @@ package body Exp_Ch9 is
                       Object_Definition =>
                         New_Reference_To (Etype (Formal), Loc));
 
-                  --  We have to make an assignment statement separate for
-                  --  the case of limited type. We can not assign it unless
-                  --  the Assignment_OK flag is set first.
+                  --  We have to make an assignment statement separate for the
+                  --  case of limited type. We cannot assign it unless the
+                  --  Assignment_OK flag is set first.
 
                   if Ekind (Formal) /= E_Out_Parameter then
                      N_Var :=
@@ -2954,8 +3070,36 @@ package body Exp_Ch9 is
                     Prefix =>
                       New_Reference_To (Defining_Identifier (N_Node), Loc)));
                else
-                  Append_To (Plist,
-                    Make_Reference (Loc, Prefix => Relocate_Node (Actual)));
+                  --  Interface class-wide formal
+
+                  if Ada_Version >= Ada_05
+                    and then Ekind (Etype (Formal)) = E_Class_Wide_Type
+                    and then Is_Interface (Etype (Formal))
+                  then
+                     Iface_Typ := Etype (Etype (Formal));
+
+                     --  Generate:
+                     --    formal_iface_type! (actual.iface_tag)'reference
+
+                     Iface_Tag :=
+                       Find_Interface_Tag (Etype (Actual), Iface_Typ);
+                     pragma Assert (Present (Iface_Tag));
+
+                     Append_To (Plist,
+                       Make_Reference (Loc,
+                         Unchecked_Convert_To (Iface_Typ,
+                           Make_Selected_Component (Loc,
+                             Prefix =>
+                               Relocate_Node (Actual),
+                             Selector_Name =>
+                               New_Reference_To (Iface_Tag, Loc)))));
+                  else
+                     --  Generate:
+                     --    actual'reference
+
+                     Append_To (Plist,
+                       Make_Reference (Loc, Relocate_Node (Actual)));
+                  end if;
                end if;
 
                Next_Actual (Actual);
@@ -3066,8 +3210,8 @@ package body Exp_Ch9 is
 
          Append_To (Stats, Call);
 
-         --  If there are out or in/out parameters by copy
-         --  add assignment statements for the result values.
+         --  If there are out or in/out parameters by copy add assignment
+         --  statements for the result values.
 
          if Present (Parms) then
             Actual := First_Actual (N);
@@ -3088,17 +3232,17 @@ package body Exp_Ch9 is
                             Selector_Name =>
                               Make_Identifier (Loc, Chars (Formal)))));
 
-                  --  In all cases (including limited private types) we
-                  --  want the assignment to be valid.
+                  --  In all cases (including limited private types) we want
+                  --  the assignment to be valid.
 
                   Set_Assignment_OK (Name (N_Node));
 
                   --  If the call is the triggering alternative in an
-                  --  asynchronous select, or the entry_call alternative
-                  --  of a conditional entry call, the assignments for in-out
-                  --  parameters are incorporated into the statement list
-                  --  that follows, so that there are executed only if the
-                  --  entry call succeeds.
+                  --  asynchronous select, or the entry_call alternative of a
+                  --  conditional entry call, the assignments for in-out
+                  --  parameters are incorporated into the statement list that
+                  --  follows, so that there are executed only if the entry
+                  --  call succeeds.
 
                   if (Nkind (Parent (N)) = N_Triggering_Alternative
                        and then N = Triggering_Statement (Parent (N)))
@@ -3394,9 +3538,9 @@ package body Exp_Ch9 is
       Op_Decls  : List_Id;
 
    begin
-      --  Make an unprotected version of the subprogram for use
-      --  within the same object, with a new name and an additional
-      --  parameter representing the object.
+      --  Make an unprotected version of the subprogram for use within the same
+      --  object, with a new name and an additional parameter representing the
+      --  object.
 
       Op_Decls := Declarations (N);
       N_Op_Spec :=
@@ -3434,22 +3578,61 @@ package body Exp_Ch9 is
               Make_Defining_Identifier (Loc,
                 Chars => New_Internal_Name ('F'));
 
-            Efam_Decl :=
-              Make_Full_Type_Declaration (Loc,
-                Defining_Identifier => Efam_Type,
-                Type_Definition =>
-                  Make_Unconstrained_Array_Definition (Loc,
-                    Subtype_Marks => (New_List (
-                      New_Occurrence_Of (
+            declare
+               Bas : Entity_Id :=
                        Base_Type
-                         (Etype (Discrete_Subtype_Definition
-                           (Parent (Efam)))), Loc))),
+                        (Etype (Discrete_Subtype_Definition (Parent (Efam))));
+               Bas_Decl : Node_Id := Empty;
+               Lo, Hi   : Node_Id;
+
+            begin
+               Get_Index_Bounds
+                 (Discrete_Subtype_Definition (Parent (Efam)), Lo, Hi);
+               if Scope (Bas) = Standard_Standard
+                 and then Bas = Base_Type (Standard_Integer)
+                 and then Has_Discriminants (Conctyp)
+                 and then Present
+                   (Discriminant_Default_Value (First_Discriminant (Conctyp)))
+                 and then
+                   (Denotes_Discriminant (Lo, True)
+                     or else Denotes_Discriminant (Hi, True))
+               then
+                  Bas :=
+                    Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
+                  Bas_Decl :=
+                    Make_Subtype_Declaration (Loc,
+                       Defining_Identifier => Bas,
+                       Subtype_Indication =>
+                         Make_Subtype_Indication (Loc,
+                           Subtype_Mark =>
+                             New_Occurrence_Of (Standard_Integer, Loc),
+                           Constraint =>
+                             Make_Range_Constraint (Loc,
+                               Range_Expression => Make_Range (Loc,
+                                 Make_Integer_Literal
+                                   (Loc, -Entry_Family_Bound),
+                                 Make_Integer_Literal
+                                   (Loc, Entry_Family_Bound - 1)))));
+
+                  Insert_After (Current_Node, Bas_Decl);
+                  Current_Node := Bas_Decl;
+                  Analyze (Bas_Decl);
+               end if;
+
+               Efam_Decl :=
+                 Make_Full_Type_Declaration (Loc,
+                   Defining_Identifier => Efam_Type,
+                   Type_Definition =>
+                     Make_Unconstrained_Array_Definition (Loc,
+                       Subtype_Marks =>
+                         (New_List (New_Occurrence_Of (Bas, Loc))),
 
                     Component_Definition =>
                       Make_Component_Definition (Loc,
                         Aliased_Present    => False,
                         Subtype_Indication =>
                           New_Reference_To (Standard_Character, Loc))));
+            end;
 
             Insert_After (Current_Node, Efam_Decl);
             Current_Node := Efam_Decl;
@@ -3485,8 +3668,8 @@ package body Exp_Ch9 is
    -- Concurrent_Ref --
    --------------------
 
-   --  The expression returned for a reference to a concurrent
-   --  object has the form:
+   --  The expression returned for a reference to a concurrent object has the
+   --  form:
 
    --    taskV!(name)._Task_Id
 
@@ -3501,8 +3684,8 @@ package body Exp_Ch9 is
    --    objectV!(name.all)._Object
 
    --  here taskV and objectV are the types for the associated records, which
-   --  contain the required _Task_Id and _Object fields for tasks and
-   --  protected objects, respectively.
+   --  contain the required _Task_Id and _Object fields for tasks and protected
+   --  objects, respectively.
 
    --  For the case of a task type name, the expression is
 
@@ -3514,8 +3697,8 @@ package body Exp_Ch9 is
 
    --    objectR
 
-   --  which is a renaming of the _object field of the current object
-   --  object record, passed into protected operations as a parameter.
+   --  which is a renaming of the _object field of the current object object
+   --  record, passed into protected operations as a parameter.
 
    function Concurrent_Ref (N : Node_Id) return Node_Id is
       Loc  : constant Source_Ptr := Sloc (N);
@@ -3560,8 +3743,8 @@ package body Exp_Ch9 is
             end if;
          end loop;
 
-         --  We know that we are within the task body, so should have
-         --  found it in scope.
+         --  We know that we are within the task body, so should have found it
+         --  in scope.
 
          raise Program_Error;
       end Is_Current_Task;
@@ -3598,10 +3781,11 @@ package body Exp_Ch9 is
             else
                declare
                   Decl   : Node_Id;
-                  T_Self : constant Entity_Id
-                    := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
-                  T_Body : constant Node_Id
-                    := Parent (Corresponding_Body (Parent (Entity (N))));
+                  T_Self : constant Entity_Id :=
+                             Make_Defining_Identifier (Loc,
+                               Chars => New_Internal_Name ('T'));
+                  T_Body : constant Node_Id :=
+                             Parent (Corresponding_Body (Parent (Entity (N))));
 
                begin
                   Decl := Make_Object_Declaration (Loc,
@@ -3680,22 +3864,22 @@ package body Exp_Ch9 is
       S    : Node_Id;
 
    begin
-      --  The queues of entries and entry families appear in  textual
-      --  order in the associated record. The entry index is computed as
-      --  the sum of the number of queues for all entries that precede the
-      --  designated one, to which is added the index expression, if this
-      --  expression denotes a member of a family.
+      --  The queues of entries and entry families appear in textual order in
+      --  the associated record. The entry index is computed as the sum of the
+      --  number of queues for all entries that precede the designated one, to
+      --  which is added the index expression, if this expression denotes a
+      --  member of a family.
 
       --  The following is a place holder for the count of simple entries
 
       Num := Make_Integer_Literal (Sloc, 1);
 
-      --  We construct an expression which is a series of addition
-      --  operations. The first operand is the number of single entries that
-      --  precede this one, the second operand is the index value relative
-      --  to the start of the referenced family, and the remaining operands
-      --  are the lengths of the entry families that precede this entry, i.e.
-      --  the constructed expression is:
+      --  We construct an expression which is a series of addition operations.
+      --  The first operand is the number of single entries that precede this
+      --  one, the second operand is the index value relative to the start of
+      --  the referenced family, and the remaining operands are the lengths of
+      --  the entry families that precede this entry, i.e. the constructed
+      --  expression is:
 
       --    number_simple_entries +
       --      (s'pos (index-value) - s'pos (family'first)) + 1 +
@@ -3703,8 +3887,8 @@ package body Exp_Ch9 is
 
       --  where index-value is the given index value, and s is the index
       --  subtype (we have to use pos because the subtype might be an
-      --  enumeration type preventing direct subtraction).
-      --  Note that the task entry array is one-indexed.
+      --  enumeration type preventing direct subtraction). Note that the task
+      --  entry array is one-indexed.
 
       --  The upper bound of the entry family may be a discriminant, so we
       --  retrieve the lower bound explicitly to compute offset, rather than
@@ -3770,7 +3954,6 @@ package body Exp_Ch9 is
 
    procedure Establish_Task_Master (N : Node_Id) is
       Call : Node_Id;
-
    begin
       if Restriction_Active (No_Task_Hierarchy) = False then
          Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
@@ -3822,13 +4005,12 @@ package body Exp_Ch9 is
    --  We can distinguish the two cases by seeing whether the accept statement
    --  is part of a list. If not, then it must be in an accept alternative.
 
-   --  To expand the requeue statement, a label is provided at the end of
-   --  the accept statement or alternative of which it is a part, so that
-   --  the statement can be skipped after the requeue is complete.
-   --  This label is created here rather than during the expansion of the
-   --  accept statement, because it will be needed by any requeue
-   --  statements within the accept, which are expanded before the
-   --  accept.
+   --  To expand the requeue statement, a label is provided at the end of the
+   --  accept statement or alternative of which it is a part, so that the
+   --  statement can be skipped after the requeue is complete. This label is
+   --  created here rather than during the expansion of the accept statement,
+   --  because it will be needed by any requeue statements within the accept,
+   --  which are expanded before the accept.
 
    procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
@@ -3864,8 +4046,8 @@ package body Exp_Ch9 is
 
          --  Create and declare two labels to be placed at the end of the
          --  accept statement. The first label is used to allow requeues to
-         --  skip the remainder of entry processing. The second label is
-         --  used to skip the remainder of entry processing if the rendezvous
+         --  skip the remainder of entry processing. The second label is used
+         --  to skip the remainder of entry processing if the rendezvous
          --  completes in the middle of the accept body.
 
          if Present (Handled_Statement_Sequence (N)) then
@@ -3952,11 +4134,10 @@ package body Exp_Ch9 is
                   Next (Alt);
                end loop;
 
-               --  If we are the first accept statement, then we have to
-               --  create the Ann variable, as for the stand alone case,
-               --  except that it is inserted before the selective accept.
-               --  Similarly, a label for requeue expansion must be
-               --  declared.
+               --  If we are the first accept statement, then we have to create
+               --  the Ann variable, as for the stand alone case, except that
+               --  it is inserted before the selective accept. Similarly, a
+               --  label for requeue expansion must be declared.
 
                if N = Accept_Statement (Alt) then
                   Ann :=
@@ -3971,8 +4152,8 @@ package body Exp_Ch9 is
                   Insert_Before (Sel_Acc, Adecl);
                   Analyze (Adecl);
 
-               --  If we are not the first accept statement, then find the
-               --  Ann variable allocated by the first accept and use it.
+               --  If we are not the first accept statement, then find the Ann
+               --  variable allocated by the first accept and use it.
 
                else
                   Ann :=
@@ -3991,30 +4172,31 @@ package body Exp_Ch9 is
             Set_Needs_Debug_Info (Ann);
          end if;
 
-         --  Create renaming declarations for the entry formals. Each
-         --  reference to a formal becomes a dereference of a component
-         --  of the parameter block, whose address is held in Ann.
-         --  These declarations are eventually inserted into the accept
-         --  block, and analyzed there so that they have the proper scope
-         --  for gdb and do not conflict with other declarations.
+         --  Create renaming declarations for the entry formals. Each reference
+         --  to a formal becomes a dereference of a component of the parameter
+         --  block, whose address is held in Ann. These declarations are
+         --  eventually inserted into the accept block, and analyzed there so
+         --  that they have the proper scope for gdb and do not conflict with
+         --  other declarations.
 
          if Present (Parameter_Specifications (N))
            and then Present (Handled_Statement_Sequence (N))
          then
             declare
-               Formal : Entity_Id;
-               New_F  : Entity_Id;
                Comp   : Entity_Id;
                Decl   : Node_Id;
+               Formal : Entity_Id;
+               New_F  : Entity_Id;
 
             begin
                New_Scope (Ent);
                Formal := First_Formal (Ent);
 
                while Present (Formal) loop
-                  Comp   := Entry_Component (Formal);
-                  New_F  :=
+                  Comp  := Entry_Component (Formal);
+                  New_F :=
                     Make_Defining_Identifier (Sloc (Formal), Chars (Formal));
+
                   Set_Etype (New_F, Etype (Formal));
                   Set_Scope (New_F, Ent);
                   Set_Needs_Debug_Info (New_F);   --  That's the whole point.
@@ -4030,16 +4212,19 @@ package body Exp_Ch9 is
 
                   Decl :=
                     Make_Object_Renaming_Declaration (Loc,
-                    Defining_Identifier => New_F,
-                    Subtype_Mark => New_Reference_To (Etype (Formal), Loc),
-                    Name =>
-                      Make_Explicit_Dereference (Loc,
-                        Make_Selected_Component (Loc,
-                          Prefix =>
-                            Unchecked_Convert_To (Entry_Parameters_Type (Ent),
-                              New_Reference_To (Ann, Loc)),
-                          Selector_Name =>
-                            New_Reference_To (Comp, Loc))));
+                      Defining_Identifier =>
+                        New_F,
+                      Subtype_Mark =>
+                        New_Reference_To (Etype (Formal), Loc),
+                      Name =>
+                        Make_Explicit_Dereference (Loc,
+                          Make_Selected_Component (Loc,
+                            Prefix =>
+                              Unchecked_Convert_To (
+                                Entry_Parameters_Type (Ent),
+                                New_Reference_To (Ann, Loc)),
+                            Selector_Name =>
+                              New_Reference_To (Comp, Loc))));
 
                   if No (Declarations (N)) then
                      Set_Declarations (N, New_List);
@@ -4065,10 +4250,10 @@ package body Exp_Ch9 is
       Comps  : List_Id;
       T      : constant Entity_Id  := Defining_Identifier (N);
       D_T    : constant Entity_Id  := Designated_Type (T);
-      D_T2   : constant Entity_Id  := Make_Defining_Identifier
-                                        (Loc, New_Internal_Name ('D'));
-      E_T    : constant Entity_Id  := Make_Defining_Identifier
-                                        (Loc, New_Internal_Name ('E'));
+      D_T2   : constant Entity_Id  := Make_Defining_Identifier (Loc,
+                                        Chars => New_Internal_Name ('D'));
+      E_T    : constant Entity_Id  := Make_Defining_Identifier (Loc,
+                                        Chars => New_Internal_Name ('E'));
       P_List : constant List_Id    := Build_Protected_Spec
                                         (N, RTE (RE_Address), False, D_T);
       Decl1  : Node_Id;
@@ -4099,8 +4284,8 @@ package body Exp_Ch9 is
       Analyze (Decl1);
       Insert_After (N, Decl1);
 
-      --  Create Equivalent_Type, a record with two components for an
-      --  access to object and an access to subprogram.
+      --  Create Equivalent_Type, a record with two components for an access to
+      --  object and an access to subprogram.
 
       Comps := New_List (
         Make_Component_Declaration (Loc,
@@ -4154,12 +4339,12 @@ package body Exp_Ch9 is
          return;
       end if;
 
-      --  The body of the entry barrier must be analyzed in the context of
-      --  the protected object, but its scope is external to it, just as any
-      --  other unprotected version of a protected operation. The specification
-      --  has been produced when the protected type declaration was elaborated.
-      --  We build the body, insert it in the enclosing scope, but analyze it
-      --  in the current context. A more uniform approach would be to treat a
+      --  The body of the entry barrier must be analyzed in the context of the
+      --  protected object, but its scope is external to it, just as any other
+      --  unprotected version of a protected operation. The specification has
+      --  been produced when the protected type declaration was elaborated. We
+      --  build the body, insert it in the enclosing scope, but analyze it in
+      --  the current context. A more uniform approach would be to treat
       --  barrier just as a protected function, and discard the protected
       --  version of it because it is never called.
 
@@ -4178,7 +4363,7 @@ package body Exp_Ch9 is
 
          Update_Prival_Subtypes (B_F);
 
-         Set_Privals (Spec_Decl, N, Loc);
+         Set_Privals (Spec_Decl, N, Loc, After_Barrier => True);
          Set_Discriminals (Spec_Decl);
          Set_Scope (Func, Scope (Prot));
 
@@ -4186,16 +4371,16 @@ package body Exp_Ch9 is
          Analyze_And_Resolve (Cond, Any_Boolean);
       end if;
 
-      --  The Ravenscar profile restricts barriers to simple variables
-      --  declared within the protected object. We also allow Boolean
-      --  constants, since these appear in several published examples
-      --  and are also allowed by the Aonix compiler.
+      --  The Ravenscar profile restricts barriers to simple variables declared
+      --  within the protected object. We also allow Boolean constants, since
+      --  these appear in several published examples and are also allowed by
+      --  the Aonix compiler.
 
-      --  Note that after analysis variables in this context will be
-      --  replaced by the corresponding prival, that is to say a renaming
-      --  of a selected component of the form _Object.Var. If expansion is
-      --  disabled, as within a generic, we check that the entity appears in
-      --  the current scope.
+      --  Note that after analysis variables in this context will be replaced
+      --  by the corresponding prival, that is to say a renaming of a selected
+      --  component of the form _Object.Var. If expansion is disabled, as
+      --  within a generic, we check that the entity appears in the current
+      --  scope.
 
       if Is_Entity_Name (Cond) then
 
@@ -4278,11 +4463,37 @@ package body Exp_Ch9 is
 
       while Present (Tasknm) loop
          Count := Count + 1;
-         Append_To (Component_Associations (Aggr),
-           Make_Component_Association (Loc,
-             Choices => New_List (
-               Make_Integer_Literal (Loc, Count)),
-             Expression => Concurrent_Ref (Tasknm)));
+
+         --  A task interface class-wide type object is being aborted.
+         --  Retrieve its _task_id by calling a dispatching routine.
+
+         if Ada_Version >= Ada_05
+           and then Ekind (Etype (Tasknm)) = E_Class_Wide_Type
+           and then Is_Interface      (Etype (Tasknm))
+           and then Is_Task_Interface (Etype (Tasknm))
+         then
+            Append_To (Component_Associations (Aggr),
+              Make_Component_Association (Loc,
+                Choices => New_List (
+                  Make_Integer_Literal (Loc, Count)),
+                Expression =>
+
+                  --  Tasknm._disp_get_task_id
+
+                    Make_Selected_Component (Loc,
+                      Prefix =>
+                        New_Copy_Tree (Tasknm),
+                      Selector_Name =>
+                        Make_Identifier (Loc, Name_uDisp_Get_Task_Id))));
+
+         else
+            Append_To (Component_Associations (Aggr),
+              Make_Component_Association (Loc,
+                Choices => New_List (
+                  Make_Integer_Literal (Loc, Count)),
+                Expression => Concurrent_Ref (Tasknm)));
+         end if;
+
          Next (Tasknm);
       end loop;
 
@@ -4340,10 +4551,10 @@ package body Exp_Ch9 is
    --          Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
    --    end;
 
-   --  The first three declarations were already inserted ahead of the
-   --  accept statement by the Expand_Accept_Declarations procedure, which
-   --  was called directly from the semantics during analysis of the accept.
-   --  statement, before analyzing its contained statements.
+   --  The first three declarations were already inserted ahead of the accept
+   --  statement by the Expand_Accept_Declarations procedure, which was called
+   --  directly from the semantics during analysis of the accept. statement,
+   --  before analyzing its contained statements.
 
    --  The declarations from the N_Accept_Statement, as noted in Sinfo, come
    --  from possible expansion activity (the original source of course does
@@ -4372,7 +4583,11 @@ package body Exp_Ch9 is
 
       function Null_Statements (Stats : List_Id) return Boolean;
       --  Check for null statement sequence (i.e a list of labels and
-      --  null statements)
+      --  null statements).
+
+      ---------------------
+      -- Null_Statements --
+      ---------------------
 
       function Null_Statements (Stats : List_Id) return Boolean is
          Stmt : Node_Id;
@@ -4475,11 +4690,11 @@ package body Exp_Ch9 is
              Declarations               => Declarations (N),
              Handled_Statement_Sequence => Build_Accept_Body (N));
 
-         --  Prepend call to Accept_Call to main statement sequence
-         --  If the accept has exception handlers, the statement sequence
-         --  is wrapped in a block. Insert call and renaming declarations
-         --  in the declarations of the block, so they are elaborated before
-         --  the handlers.
+         --  Prepend call to Accept_Call to main statement sequence If the
+         --  accept has exception handlers, the statement sequence is wrapped
+         --  in a block. Insert call and renaming declarations in the
+         --  declarations of the block, so they are elaborated before the
+         --  handlers.
 
          Call :=
            Make_Procedure_Call_Statement (Loc,
@@ -4504,28 +4719,28 @@ package body Exp_Ch9 is
             D      : Node_Id;
             Next_D : Node_Id;
             Typ    : Entity_Id;
+
          begin
             D := First (Declarations (N));
-
             while Present (D) loop
                Next_D := Next (D);
 
                if Nkind (D) = N_Object_Renaming_Declaration then
-                  --  The renaming declarations for the formals were
-                  --  created during analysis of the accept statement,
-                  --  and attached to the list of declarations. Place
-                  --  them now in the context of the accept block or
-                  --  subprogram.
+
+                  --  The renaming declarations for the formals were created
+                  --  during analysis of the accept statement, and attached to
+                  --  the list of declarations. Place them now in the context
+                  --  of the accept block or subprogram.
 
                   Remove (D);
                   Typ := Entity (Subtype_Mark (D));
                   Insert_After (Call, D);
                   Analyze (D);
 
-                  --  If the formal is class_wide, it does not have an
-                  --  actual subtype. The analysis of the renaming declaration
-                  --  creates one, but we need to retain the class-wide
-                  --  nature of the entity.
+                  --  If the formal is class_wide, it does not have an actual
+                  --  subtype. The analysis of the renaming declaration creates
+                  --  one, but we need to retain the class-wide nature of the
+                  --  entity.
 
                   if Is_Class_Wide_Type (Typ) then
                      Set_Etype (Defining_Identifier (D), Typ);
@@ -4691,16 +4906,6 @@ package body Exp_Ch9 is
    --     S   : constant Integer := DT_Position (<dispatching-call>);
    --     U   : Boolean;
 
-   --     procedure <temp>A is
-   --     begin
-   --        <abortable-statements>
-   --     end <temp>A;
-
-   --     procedure <temp>T is
-   --     begin
-   --        <triggered-statements>
-   --     end <temp>T;
-
    --  begin
    --     disp_get_prim_op_kind (<object>, S, C);
 
@@ -4723,7 +4928,7 @@ package body Exp_Ch9 is
    --              ParamN := P.ParamN;
 
    --              if Enqueued (Bnn) then
-   --                 <temp>A;
+   --                 <abortable-statements>
    --              end if;
    --           at end
    --              _clean;
@@ -4733,7 +4938,7 @@ package body Exp_Ch9 is
    --        end;
 
    --        if not Cancelled (Bnn) then
-   --           <temp>T;
+   --           <triggering-statements>
    --        end if;
 
    --     elsif C = POK_Task_Entry then
@@ -4756,7 +4961,7 @@ package body Exp_Ch9 is
    --           begin
    --              begin
    --                 Abort_Undefer;
-   --                 <temp>A;
+   --                 <abortable-statements>
    --              at end
    --                 _clean;
    --              end;
@@ -4765,13 +4970,13 @@ package body Exp_Ch9 is
    --           end;
 
    --           if not U then
-   --              <temp>T;
+   --              <triggering-statements>
    --           end if;
    --        end;
 
    --     else
    --        <dispatching-call>;
-   --        <temp>T;
+   --        <triggering-statements>
    --     end if;
 
    --  The job is to convert this to the asynchronous form
@@ -4795,46 +5000,46 @@ package body Exp_Ch9 is
       Trig   : constant Node_Id    := Triggering_Alternative (N);
       Tstats : constant List_Id    := Statements (Trig);
 
-      Abortable_Block : Node_Id;
-      Actuals         : List_Id;
-      Aproc           : Entity_Id;
-      Blk_Ent         : Entity_Id;
-      Blk_Typ         : Entity_Id;
-      Call            : Node_Id;
-      Call_Ent        : Entity_Id;
-      Cancel_Param    : Entity_Id;
-      Cleanup_Block   : Node_Id;
-      Cleanup_Stmts   : List_Id;
-      Concval         : Node_Id;
-      Dblock_Ent      : Entity_Id;
-      Decl            : Node_Id;
-      Decls           : List_Id;
-      Ecall           : Node_Id;
-      Ename           : Node_Id;
-      Enqueue_Call    : Node_Id;
-      Formals         : List_Id;
-      Hdle            : List_Id;
-      Index           : Node_Id;
-      N_Orig          : Node_Id;
-      Obj             : Entity_Id;
-      Param           : Node_Id;
-      Params          : List_Id;
-      Pdef            : Entity_Id;
-      ProtE_Stmts     : List_Id;
-      ProtP_Stmts     : List_Id;
-      Stmt            : Node_Id;
-      Stmts           : List_Id;
-      Target_Undefer  : RE_Id;
-      TaskE_Stmts     : List_Id;
-      Tproc           : Entity_Id;
-      Undefer_Args    : List_Id := No_List;
+      Abort_Block_Ent   : Entity_Id;
+      Abortable_Block   : Node_Id;
+      Actuals           : List_Id;
+      Blk_Ent           : Entity_Id;
+      Blk_Typ           : Entity_Id;
+      Call              : Node_Id;
+      Call_Ent          : Entity_Id;
+      Cancel_Param      : Entity_Id;
+      Cleanup_Block     : Node_Id;
+      Cleanup_Block_Ent : Entity_Id;
+      Cleanup_Stmts     : List_Id;
+      Concval           : Node_Id;
+      Dblock_Ent        : Entity_Id;
+      Decl              : Node_Id;
+      Decls             : List_Id;
+      Ecall             : Node_Id;
+      Ename             : Node_Id;
+      Enqueue_Call      : Node_Id;
+      Formals           : List_Id;
+      Hdle              : List_Id;
+      Index             : Node_Id;
+      N_Orig            : Node_Id;
+      Obj               : Entity_Id;
+      Param             : Node_Id;
+      Params            : List_Id;
+      Pdef              : Entity_Id;
+      ProtE_Stmts       : List_Id;
+      ProtP_Stmts       : List_Id;
+      Stmt              : Node_Id;
+      Stmts             : List_Id;
+      Target_Undefer    : RE_Id;
+      TaskE_Stmts       : List_Id;
+      Undefer_Args      : List_Id := No_List;
 
       B   : Entity_Id;  --  Call status flag
       Bnn : Entity_Id;  --  Communication block
       C   : Entity_Id;  --  Call kind
-      P   : Node_Id;    --  Parameter block
+      P   : Entity_Id;  --  Parameter block
       S   : Entity_Id;  --  Primitive operation slot
-      U   : Entity_Id;  --  Additional status flag
+      T   : Entity_Id;  --  Additional status flag
 
    begin
       Blk_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
@@ -4900,50 +5105,37 @@ package body Exp_Ch9 is
 
             --  Dispatch table slot processing, generate:
             --    S : constant Integer :=
-            --          DT_Position (<dispatching-procedure>);
+            --          Ada.Tags.Get_Offset_Index (
+            --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
+            --            DT_Position (<dispatching-procedure>));
 
-            S := SEU.Build_S (Loc, Decls, Call_Ent);
+            S := SEU.Build_S (Loc, Decls, Obj, Call_Ent);
 
             --  Additional status flag processing, generate:
 
-            U := Make_Defining_Identifier (Loc, Name_uU);
+            T := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
 
             Append_To (Decls,
               Make_Object_Declaration (Loc,
                 Defining_Identifier =>
-                  U,
+                  T,
                 Object_Definition =>
                   New_Reference_To (Standard_Boolean, Loc)));
 
-            --  Generate:
-            --    procedure <temp>A is
-            --    begin
-            --       Astmts
-            --    end <temp>A;
-
-            Aproc := SEU.Build_Wrapping_Procedure (Loc, 'A', Decls, Astats);
-
-            --  Generate:
-            --    procedure <temp>T is
-            --    begin
-            --       Tstmts
-            --    end <temp>T;
-
-            Tproc := SEU.Build_Wrapping_Procedure (Loc, 'T', Decls, Tstats);
-
-            --  Generate:
-            --    _dispatching_get_prim_op_kind (<object>, S, C);
-
             Append_To (Stmts,
               Make_Procedure_Call_Statement (Loc,
                 Name =>
-                  Make_Identifier (Loc, Name_uDisp_Get_Prim_Op_Kind),
+                  New_Reference_To (
+                    Find_Prim_Op (Etype (Etype (Obj)),
+                      Name_uDisp_Get_Prim_Op_Kind),
+                  Loc),
                 Parameter_Associations =>
                   New_List (
                     New_Copy_Tree    (Obj),
                     New_Reference_To (S, Loc),
                     New_Reference_To (C, Loc))));
 
+            --  ---------------------------------------------------------------
             --  Protected entry handling
 
             --  Generate:
@@ -4951,7 +5143,7 @@ package body Exp_Ch9 is
             --    ...
             --    ParamN := P.ParamN;
 
-            Cleanup_Stmts := Parameter_Block_Unpack (Loc, Actuals, Formals);
+            Cleanup_Stmts := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
 
             --  Generate:
             --    _dispatching_asynchronous_select
@@ -4960,22 +5152,25 @@ package body Exp_Ch9 is
             Prepend_To (Cleanup_Stmts,
               Make_Procedure_Call_Statement (Loc,
                 Name =>
-                  Make_Identifier (Loc, Name_uDisp_Asynchronous_Select),
+                  New_Reference_To (
+                    Find_Prim_Op (Etype (Etype (Obj)),
+                      Name_uDisp_Asynchronous_Select),
+                  Loc),
                 Parameter_Associations =>
                   New_List (
                     New_Copy_Tree    (Obj),
                     New_Reference_To (S, Loc),
-                    P,
+                    Make_Attribute_Reference (Loc,
+                      Prefix => New_Reference_To (P, Loc),
+                      Attribute_Name => Name_Address),
                     New_Reference_To (Bnn, Loc),
                     New_Reference_To (B, Loc))));
 
             --  Generate:
             --    if Enqueued (Bnn) then
-            --       <temp>A
+            --       <abortable-statements>
             --    end if;
 
-            --  where <temp>A is the abort statements wrapping procedure
-
             Append_To (Cleanup_Stmts,
               Make_If_Statement (Loc,
                 Condition =>
@@ -4987,12 +5182,7 @@ package body Exp_Ch9 is
                         New_Reference_To (Bnn, Loc))),
 
                 Then_Statements =>
-                  New_List (
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To (Aproc, Loc),
-                      Parameter_Associations =>
-                        No_List))));
+                  New_Copy_List_Tree (Astats)));
 
             --  Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
             --  will then generate a _clean for the communication block Bnn.
@@ -5011,10 +5201,13 @@ package body Exp_Ch9 is
             --       _clean;
             --    end;
 
-            Cleanup_Block :=
-              SEU.Build_Cleanup_Block (Loc, Blk_Ent, Cleanup_Stmts, Bnn);
+            Cleanup_Block_Ent :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
+
+            Cleanup_Block := SEU.Build_Cleanup_Block (Loc,
+              Cleanup_Block_Ent, Cleanup_Stmts, Bnn);
 
-            --  Wrap the cleanup block in an exception handling block.
+            --  Wrap the cleanup block in an exception handling block
 
             --  Generate:
             --    begin
@@ -5023,17 +5216,22 @@ package body Exp_Ch9 is
             --       when Abort_Signal => Abort_Undefer;
             --    end;
 
+            Abort_Block_Ent :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+
             ProtE_Stmts :=
               New_List (
-                SEU.Build_Abort_Block (Loc, Blk_Ent, Cleanup_Block));
+                Make_Implicit_Label_Declaration (Loc,
+                  Defining_Identifier => Abort_Block_Ent),
+
+                SEU.Build_Abort_Block (Loc,
+                  Abort_Block_Ent, Cleanup_Block_Ent, Cleanup_Block));
 
             --  Generate:
             --    if not Cancelled (Bnn) then
-            --       <temp>T
+            --       <triggering-statements>
             --    end if;
 
-            --  there <temp>T is the triggering statements wrapping procedure
-
             Append_To (ProtE_Stmts,
               Make_If_Statement (Loc,
                 Condition =>
@@ -5047,14 +5245,9 @@ package body Exp_Ch9 is
                             New_Reference_To (Bnn, Loc)))),
 
                 Then_Statements =>
-                  New_List (
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To (Tproc, Loc),
-                      Parameter_Associations =>
-                        No_List))));
+                  New_Copy_List_Tree (Tstats)));
 
-            -------------------------------------------------------------------
+            --  ---------------------------------------------------------------
             --  Task entry handling
 
             --  Generate:
@@ -5062,7 +5255,7 @@ package body Exp_Ch9 is
             --    ...
             --    ParamN := P.ParamN;
 
-            TaskE_Stmts := Parameter_Block_Unpack (Loc, Actuals, Formals);
+            TaskE_Stmts := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
 
             --  Generate:
             --    _dispatching_asynchronous_select
@@ -5071,12 +5264,17 @@ package body Exp_Ch9 is
             Prepend_To (TaskE_Stmts,
               Make_Procedure_Call_Statement (Loc,
                 Name =>
-                  Make_Identifier (Loc, Name_uDisp_Asynchronous_Select),
+                  New_Reference_To (
+                    Find_Prim_Op (Etype (Etype (Obj)),
+                      Name_uDisp_Asynchronous_Select),
+                  Loc),
                 Parameter_Associations =>
                   New_List (
                     New_Copy_Tree    (Obj),
                     New_Reference_To (S, Loc),
-                    New_Copy_Tree    (P),
+                    Make_Attribute_Reference (Loc,
+                      Prefix => New_Reference_To (P, Loc),
+                      Attribute_Name => Name_Address),
                     New_Reference_To (Bnn, Loc),
                     New_Reference_To (B, Loc))));
 
@@ -5092,23 +5290,16 @@ package body Exp_Ch9 is
 
             --  Generate:
             --    Abort_Undefer;
-            --    <temp>A
-
-            --  where <temp>A is the abortable statements wrapping procedure
+            --    <abortable-statements>
 
-            Cleanup_Stmts :=
-              New_List (
-                Make_Procedure_Call_Statement (Loc,
-                  Name =>
-                    New_Reference_To (RTE (RE_Abort_Undefer), Loc),
-                  Parameter_Associations =>
-                    No_List),
+            Cleanup_Stmts := New_Copy_List_Tree (Astats);
 
-                Make_Procedure_Call_Statement (Loc,
-                  Name =>
-                    New_Reference_To (Aproc, Loc),
-                  Parameter_Associations =>
-                    No_List));
+            Prepend_To (Cleanup_Stmts,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  New_Reference_To (RTE (RE_Abort_Undefer), Loc),
+                Parameter_Associations =>
+                  No_List));
 
             --  Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
             --  will generate a _clean for the additional status flag.
@@ -5125,10 +5316,11 @@ package body Exp_Ch9 is
             --       _clean;
             --    end;
 
-            Blk_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+            Cleanup_Block_Ent :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
 
-            Cleanup_Block :=
-              SEU.Build_Cleanup_Block (Loc, Blk_Ent, Cleanup_Stmts, U);
+            Cleanup_Block := SEU.Build_Cleanup_Block (Loc,
+              Cleanup_Block_Ent, Cleanup_Stmts, T);
 
             --  Wrap the cleanup block in an exception handling block
 
@@ -5139,48 +5331,41 @@ package body Exp_Ch9 is
             --       when Abort_Signal => Abort_Undefer;
             --    end;
 
+            Abort_Block_Ent :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+
             Append_To (TaskE_Stmts,
-              SEU.Build_Abort_Block (Loc, Blk_Ent, Cleanup_Block));
+              Make_Implicit_Label_Declaration (Loc,
+                Defining_Identifier => Abort_Block_Ent));
+
+            Append_To (TaskE_Stmts,
+              SEU.Build_Abort_Block (Loc,
+                Abort_Block_Ent, Cleanup_Block_Ent, Cleanup_Block));
 
             --  Generate:
-            --    if not U then
-            --       <temp>T
+            --    if not T then
+            --       <triggering-statements>
             --    end if;
 
-            --  where <temp>T is the triggering statements wrapping procedure
-
             Append_To (TaskE_Stmts,
               Make_If_Statement (Loc,
                 Condition =>
                   Make_Op_Not (Loc,
                     Right_Opnd =>
-                      New_Reference_To (U, Loc)),
+                      New_Reference_To (T, Loc)),
+
                 Then_Statements =>
-                  New_List (
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To (Tproc, Loc),
-                      Parameter_Associations =>
-                        No_List))));
+                  New_Copy_List_Tree (Tstats)));
 
             -------------------------------------------------------------------
             --  Protected procedure handling
 
             --  Generate:
             --    <dispatching-call>;
-            --    <temp>T;
+            --    <triggering-statements>
 
-            --  where <temp>T is the triggering statements wrapping procedure
-
-            ProtP_Stmts :=
-              New_List (
-                New_Copy_Tree (Ecall),
-
-                Make_Procedure_Call_Statement (Loc,
-                  Name =>
-                    New_Reference_To (Tproc, Loc),
-                  Parameter_Associations =>
-                    No_List));
+            ProtP_Stmts := New_Copy_List_Tree (Tstats);
+            Prepend_To (ProtP_Stmts, New_Copy_Tree (Ecall));
 
             --  Generate:
             --    if C = POK_Procedure_Entry then
@@ -5212,6 +5397,7 @@ package body Exp_Ch9 is
                             New_Reference_To (C, Loc),
                           Right_Opnd =>
                             New_Reference_To (RTE (RE_POK_Task_Entry), Loc)),
+
                       Then_Statements =>
                         TaskE_Stmts)),
 
@@ -5331,6 +5517,7 @@ package body Exp_Ch9 is
             Analyze (N);
             return;
          end if;
+
       else
          N_Orig := N;
       end if;
@@ -5725,10 +5912,11 @@ package body Exp_Ch9 is
       Params   : List_Id;
       Stmt     : Node_Id;
       Stmts    : List_Id;
+      Unpack   : List_Id;
 
       B        : Entity_Id;  --  Call status flag
       C        : Entity_Id;  --  Call kind
-      P        : Node_Id;    --  Parameter block
+      P        : Entity_Id;  --  Parameter block
       S        : Entity_Id;  --  Primitive operation slot
 
    begin
@@ -5758,9 +5946,11 @@ package body Exp_Ch9 is
 
          --  Dispatch table slot processing, generate:
          --    S : constant Integer :=
-         --          DT_Position (<dispatching-procedure>);
+         --          Ada.Tags.Get_Offset_Index (
+         --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
+         --            DT_Position (<dispatching-procedure>));
 
-         S := SEU.Build_S (Loc, Decls, Call_Ent);
+         S := SEU.Build_S (Loc, Decls, Obj, Call_Ent);
 
          --  Generate:
          --    _dispatching_conditional_select (<object>, S, P'address, C, B);
@@ -5768,12 +5958,17 @@ package body Exp_Ch9 is
          Append_To (Stmts,
            Make_Procedure_Call_Statement (Loc,
              Name =>
-               Make_Identifier (Loc, Name_uDisp_Conditional_Select),
+               New_Reference_To (
+                 Find_Prim_Op (Etype (Etype (Obj)),
+                   Name_uDisp_Conditional_Select),
+                 Loc),
              Parameter_Associations =>
                New_List (
                  New_Copy_Tree    (Obj),
                  New_Reference_To (S, Loc),
-                 P,
+                 Make_Attribute_Reference (Loc,
+                   Prefix => New_Reference_To (P, Loc),
+                   Attribute_Name => Name_Address),
                  New_Reference_To (C, Loc),
                  New_Reference_To (B, Loc))));
 
@@ -5786,26 +5981,33 @@ package body Exp_Ch9 is
          --       ParamN := P.ParamN;
          --    end if;
 
-         Append_To (Stmts,
-           Make_If_Statement (Loc,
+         Unpack := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
 
-             Condition =>
-               Make_Or_Else (Loc,
-                 Left_Opnd =>
-                   Make_Op_Eq (Loc,
-                     Left_Opnd =>
-                       New_Reference_To (C, Loc),
-                     Right_Opnd =>
-                       New_Reference_To (RTE (RE_POK_Protected_Entry), Loc)),
-                 Right_Opnd =>
-                   Make_Op_Eq (Loc,
-                     Left_Opnd =>
-                       New_Reference_To (C, Loc),
-                     Right_Opnd =>
-                       New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
+         --  Generate the if statement only when the packed parameters need
+         --  explicit assignments to their corresponding actuals.
 
-             Then_Statements =>
-               Parameter_Block_Unpack (Loc, Actuals, Formals)));
+         if Present (Unpack) then
+            Append_To (Stmts,
+              Make_If_Statement (Loc,
+
+                Condition =>
+                  Make_Or_Else (Loc,
+                    Left_Opnd =>
+                      Make_Op_Eq (Loc,
+                        Left_Opnd =>
+                          New_Reference_To (C, Loc),
+                        Right_Opnd =>
+                          New_Reference_To (RTE (
+                            RE_POK_Protected_Entry), Loc)),
+                    Right_Opnd =>
+                      Make_Op_Eq (Loc,
+                        Left_Opnd =>
+                          New_Reference_To (C, Loc),
+                        Right_Opnd =>
+                          New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
+
+                 Then_Statements => Unpack));
+         end if;
 
          --  Generate:
          --    if B then
@@ -5820,7 +6022,7 @@ package body Exp_Ch9 is
          --       <else-statements>
          --    end if;
 
-         N_Stats := New_Copy_List (Statements (Alt));
+         N_Stats := New_Copy_List_Tree (Statements (Alt));
 
          Prepend_To (N_Stats,
            Make_If_Statement (Loc,
@@ -6060,10 +6262,9 @@ package body Exp_Ch9 is
          end if;
       end if;
 
-      --  Associate privals and discriminals with the next protected
-      --  operation body to be expanded. These are used to expand
-      --  references to private data objects and discriminants,
-      --  respectively.
+      --  Associate privals and discriminals with the next protected operation
+      --  body to be expanded. These are used to expand references to private
+      --  data objects and discriminants, respectively.
 
       Next_Op := Next_Protected_Operation (N);
 
@@ -6091,16 +6292,15 @@ package body Exp_Ch9 is
          return;
       end if;
 
-      --  If this entry call is part of an asynchronous select, don't
-      --  expand it here; it will be expanded with the select statement.
-      --  Don't expand timed entry calls either, as they are translated
-      --  into asynchronous entry calls.
+      --  If this entry call is part of an asynchronous select, don't expand it
+      --  here; it will be expanded with the select statement. Don't expand
+      --  timed entry calls either, as they are translated into asynchronous
+      --  entry calls.
 
-      --  ??? This whole approach is questionable; it may be better
-      --  to go back to allowing the expansion to take place and then
-      --  attempting to fix it up in Expand_N_Asynchronous_Select.
-      --  The tricky part is figuring out whether the expanded
-      --  call is on a task or protected entry.
+      --  ??? This whole approach is questionable; it may be better to go back
+      --  to allowing the expansion to take place and then attempting to fix it
+      --  up in Expand_N_Asynchronous_Select. The tricky part is figuring out
+      --  whether the expanded call is on a task or protected entry.
 
       if (Nkind (Parent (N)) /= N_Triggering_Alternative
            or else N /= Triggering_Statement (Parent (N)))
@@ -6117,17 +6317,17 @@ package body Exp_Ch9 is
    -- Expand_N_Entry_Declaration --
    --------------------------------
 
-   --  If there are parameters, then first, each of the formals is marked
-   --  by setting Is_Entry_Formal. Next a record type is built which is
-   --  used to hold the parameter values. The name of this record type is
-   --  entryP where entry is the name of the entry, with an additional
-   --  corresponding access type called entryPA. The record type has matching
-   --  components for each formal (the component names are the same as the
-   --  formal names). For elementary types, the component type matches the
-   --  formal type. For composite types, an access type is declared (with
-   --  the name formalA) which designates the formal type, and the type of
-   --  the component is this access type. Finally the Entry_Component of
-   --  each formal is set to reference the corresponding record component.
+   --  If there are parameters, then first, each of the formals is marked by
+   --  setting Is_Entry_Formal. Next a record type is built which is used to
+   --  hold the parameter values. The name of this record type is entryP where
+   --  entry is the name of the entry, with an additional corresponding access
+   --  type called entryPA. The record type has matching components for each
+   --  formal (the component names are the same as the formal names). For
+   --  elementary types, the component type matches the formal type. For
+   --  composite types, an access type is declared (with the name formalA)
+   --  which designates the formal type, and the type of the component is this
+   --  access type. Finally the Entry_Component of each formal is set to
+   --  reference the corresponding record component.
 
    procedure Expand_N_Entry_Declaration (N : Node_Id) is
       Loc        : constant Source_Ptr := Sloc (N);
@@ -6231,11 +6431,11 @@ package body Exp_Ch9 is
    -----------------------------
 
    --  Protected bodies are expanded to the completion of the subprograms
-   --  created for the corresponding protected type. These are a protected
-   --  and unprotected version of each protected subprogram in the object,
-   --  a function to calculate each entry barrier, and a procedure to
-   --  execute the sequence of statements of each protected entry body.
-   --  For example, for protected type ptype:
+   --  created for the corresponding protected type. These are a protected and
+   --  unprotected version of each protected subprogram in the object, a
+   --  function to calculate each entry barrier, and a procedure to execute the
+   --  sequence of statements of each protected entry body. For example, for
+   --  protected type ptype:
 
    --  function entB
    --    (O : System.Address;
@@ -6379,7 +6579,6 @@ package body Exp_Ch9 is
 
          Actuals := New_List;
          Formal  := First (Parameter_Specifications (Spec));
-
          while Present (Formal) loop
             Append_To (Actuals,
               Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
@@ -6581,10 +6780,9 @@ package body Exp_Ch9 is
          Analyze (New_Op_Body);
       end if;
 
-      --  Ada 2005 (AI-345): Construct the primitive entry wrapper bodies
-      --  after the protected body. At this point the entry specs have been
-      --  created, frozen and included in the dispatch table for the
-      --  protected type.
+      --  Ada 2005 (AI-345): Construct the primitive entry wrapper bodies after
+      --  the protected body. At this point the entry specs have been created,
+      --  frozen and included in the dispatch table for the protected type.
 
       pragma Assert (Present (Corresponding_Record_Type (Pid)));
 
@@ -6600,10 +6798,10 @@ package body Exp_Ch9 is
             Wrap_Body : Node_Id;
 
          begin
-            --  Examine the visible declarations of the protected type,
-            --  looking for an entry declaration. We do not consider
-            --  entry families since they can not have dispatching
-            --  operations, thus they do not need entry wrappers.
+            --  Examine the visible declarations of the protected type, looking
+            --  for an entry declaration. We do not consider entry families
+            --  since they cannot have dispatching operations, thus they do not
+            --  need entry wrappers.
 
             while Present (Vis_Decl) loop
                if Nkind (Vis_Decl) = N_Entry_Declaration then
@@ -6658,57 +6856,55 @@ package body Exp_Ch9 is
    --      <private data fields>
    --    end record;
 
-   --  The discriminants are present only if the corresponding protected
-   --  type has discriminants, and they exactly mirror the protected type
-   --  discriminants. The private data fields similarly mirror the
-   --  private declarations of the protected type.
+   --  The discriminants are present only if the corresponding protected type
+   --  has discriminants, and they exactly mirror the protected type
+   --  discriminants. The private data fields similarly mirror the private
+   --  declarations of the protected type.
 
-   --  The Object field is always present. It contains RTS specific data
-   --  used to control the protected object. It is declared as Aliased
-   --  so that it can be passed as a pointer to the RTS. This allows the
-   --  protected record to be referenced within RTS data structures.
-   --  An appropriate Protection type and discriminant are generated.
+   --  The Object field is always present. It contains RTS specific data used
+   --  to control the protected object. It is declared as Aliased so that it
+   --  can be passed as a pointer to the RTS. This allows the protected record
+   --  to be referenced within RTS data structures. An appropriate Protection
+   --  type and discriminant are generated.
 
    --  The Service field is present for protected objects with entries. It
-   --  contains sufficient information to allow the entry service procedure
-   --  for this object to be called when the object is not known till runtime.
+   --  contains sufficient information to allow the entry service procedure for
+   --  this object to be called when the object is not known till runtime.
 
    --  One entry_family component is present for each entry family in the
    --  task definition (see Expand_N_Task_Type_Declaration).
 
    --  When a protected object is declared, an instance of the protected type
-   --  value record is created. The elaboration of this declaration creates
-   --  the correct bounds for the entry families, and also evaluates the
-   --  priority expression if needed. The initialization routine for
-   --  the protected type itself then calls Initialize_Protection with
-   --  appropriate parameters to initialize the value of the Task_Id field.
-   --  Install_Handlers may be also called if a pragma Attach_Handler applies.
-
-   --  Note: this record is passed to the subprograms created by the
-   --  expansion of protected subprograms and entries. It is an in parameter
-   --  to protected functions and an in out parameter to procedures and
-   --  entry bodies. The Entity_Id for this created record type is placed
-   --  in the Corresponding_Record_Type field of the associated protected
-   --  type entity.
-
-   --  Next we create a procedure specifications for protected subprograms
-   --  and entry bodies. For each protected subprograms two subprograms are
-   --  created, an unprotected and a protected version. The unprotected
-   --  version is called from within other operations of the same protected
-   --  object.
+   --  value record is created. The elaboration of this declaration creates the
+   --  correct bounds for the entry families, and also evaluates the priority
+   --  expression if needed. The initialization routine for the protected type
+   --  itself then calls Initialize_Protection with appropriate parameters to
+   --  initialize the value of the Task_Id field. Install_Handlers may be also
+   --  called if a pragma Attach_Handler applies.
+
+   --  Note: this record is passed to the subprograms created by the expansion
+   --  of protected subprograms and entries. It is an in parameter to protected
+   --  functions and an in out parameter to procedures and entry bodies. The
+   --  Entity_Id for this created record type is placed in the
+   --  Corresponding_Record_Type field of the associated protected type entity.
+
+   --  Next we create a procedure specifications for protected subprograms and
+   --  entry bodies. For each protected subprograms two subprograms are
+   --  created, an unprotected and a protected version. The unprotected version
+   --  is called from within other operations of the same protected object.
 
    --  We also build the call to register the procedure if a pragma
    --  Interrupt_Handler applies.
 
    --  A single subprogram is created to service all entry bodies; it has an
-   --  additional boolean out parameter indicating that the previous entry
-   --  call made by the current task was serviced immediately, i.e. not by
-   --  proxy. The O parameter contains a pointer to a record object of the
-   --  type described above. An untyped interface is used here to allow this
+   --  additional boolean out parameter indicating that the previous entry call
+   --  made by the current task was serviced immediately, i.e. not by proxy.
+   --  The O parameter contains a pointer to a record object of the type
+   --  described above. An untyped interface is used here to allow this
    --  procedure to be called in places where the type of the object to be
-   --  serviced is not known. This must be done, for example, when a call
-   --  that may have been requeued is cancelled; the corresponding object
-   --  must be serviced, but which object that is not known till runtime.
+   --  serviced is not known. This must be done, for example, when a call that
+   --  may have been requeued is cancelled; the corresponding object must be
+   --  serviced, but which object that is not known till runtime.
 
    --  procedure ptypeS
    --    (O : System.Address; P : out Boolean);
@@ -6724,9 +6920,8 @@ package body Exp_Ch9 is
    procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
       Loc     : constant Source_Ptr := Sloc (N);
       Prottyp : constant Entity_Id  := Defining_Identifier (N);
-      Protnm  : constant Name_Id    := Chars (Prottyp);
 
-      Pdef : constant Node_Id    := Protected_Definition (N);
+      Pdef : constant Node_Id := Protected_Definition (N);
       --  This contains two lists; one for visible and one for private decls
 
       Rec_Decl     : Node_Id;
@@ -6748,7 +6943,7 @@ package body Exp_Ch9 is
       Object_Comp  : Node_Id;
 
       procedure Register_Handler;
-      --  for a protected operation that is an interrupt handler, add the
+      --  For a protected operation that is an interrupt handler, add the
       --  freeze action that will register it as such.
 
       ----------------------
@@ -6803,7 +6998,8 @@ package body Exp_Ch9 is
       --  corresponding record type must refer to the discriminants of that
       --  record, so we must apply a new renaming to subtypes_indications:
 
-      --     protected discriminant => discriminal => record discriminant.
+      --     protected discriminant => discriminal => record discriminant
+
       --  This replacement is not applied to default expressions, for which
       --  the discriminal is correct.
 
@@ -6811,11 +7007,9 @@ package body Exp_Ch9 is
          declare
             Disc : Entity_Id;
             Decl : Node_Id;
-
          begin
             Disc := First_Discriminant (Prottyp);
             Decl := First (Discriminant_Specifications (Rec_Decl));
-
             while Present (Disc) loop
                Append_Elmt (Discriminal (Disc), Discr_Map);
                Append_Elmt (Defining_Identifier (Decl), Discr_Map);
@@ -6827,15 +7021,14 @@ package body Exp_Ch9 is
 
       --  Fill in the component declarations
 
-      --  Add components for entry families. For each entry family,
-      --  create an anonymous type declaration with the same size, and
-      --  analyze the type.
+      --  Add components for entry families. For each entry family, create an
+      --  anonymous type declaration with the same size, and analyze the type.
 
       Collect_Entry_Families (Loc, Cdecls, Current_Node, Prottyp);
 
-      --  Prepend the _Object field with the right type to the component
-      --  list. We need to compute the number of entries, and in some cases
-      --  the number of Attach_Handler pragmas.
+      --  Prepend the _Object field with the right type to the component list.
+      --  We need to compute the number of entries, and in some cases the
+      --  number of Attach_Handler pragmas.
 
       declare
          Ritem              : Node_Id;
@@ -6892,8 +7085,7 @@ package body Exp_Ch9 is
                      Sloc => Loc,
                      Constraints => New_List (Entry_Count_Expr)));
 
-         --  The type has explicit entries or generated primitive entry
-         --  wrappers.
+         --  Type has explicit entries or generated primitive entry wrappers
 
          elsif Has_Entries (Prottyp)
            or else (Ada_Version >= Ada_05
@@ -7039,7 +7231,7 @@ package body Exp_Ch9 is
          begin
             --  Examine the visible declarations of the protected type, looking
             --  for declarations of entries, and subprograms. We do not
-            --  consider entry families since they can not have dispatching
+            --  consider entry families since they cannot have dispatching
             --  operations, thus they do not need entry wrappers.
 
             Vis_Decl := First (Visible_Declarations (Pdef));
@@ -7096,12 +7288,12 @@ package body Exp_Ch9 is
          Entries_Aggr := Empty;
       end if;
 
-      --  Build two new procedure specifications for each protected
-      --  subprogram; one to call from outside the object and one to
-      --  call from inside. Build a barrier function and an entry
-      --  body action procedure specification for each protected entry.
-      --  Initialize the entry body array. If subprogram is flagged as
-      --  eliminated, do not generate any internal operations.
+      --  Build two new procedure specifications for each protected subprogram;
+      --  one to call from outside the object and one to call from inside.
+      --  Build a barrier function and an entry body action procedure
+      --  specification for each protected entry. Initialize the entry body
+      --  array. If subprogram is flagged as eliminated, do not generate any
+      --  internal operations.
 
       E_Count := 0;
 
@@ -7124,8 +7316,8 @@ package body Exp_Ch9 is
               (Defining_Unit_Name (Specification (Comp)),
                Defining_Unit_Name (Specification (Sub)));
 
-            --  Make the protected version of the subprogram available
-            --  for expansion of external calls.
+            --  Make the protected version of the subprogram available for
+            --  expansion of external calls.
 
             Current_Node := Sub;
 
@@ -7160,9 +7352,10 @@ package body Exp_Ch9 is
                Current_Node := Sub;
             end if;
 
-            --  If a pragma Interrupt_Handler applies, build and add
-            --  a call to Register_Interrupt_Handler to the freezing actions
-            --  of the protected version (Current_Node) of the subprogram:
+            --  If a pragma Interrupt_Handler applies, build and add a call to
+            --  Register_Interrupt_Handler to the freezing actions of the
+            --  protected version (Current_Node) of the subprogram:
+
             --    system.interrupts.register_interrupt_handler
             --       (prot_procP'address);
 
@@ -7179,10 +7372,7 @@ package body Exp_Ch9 is
             Set_Privals_Chain (Comp_Id, New_Elmt_List);
             Edef :=
               Make_Defining_Identifier (Loc,
-                Build_Selected_Name
-                 (Protnm,
-                  New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
-                  'E'));
+                Build_Selected_Name (Prottyp, Comp_Id, 'E'));
             Sub :=
               Make_Subprogram_Declaration (Loc,
                 Specification =>
@@ -7199,10 +7389,7 @@ package body Exp_Ch9 is
 
             Bdef :=
               Make_Defining_Identifier (Loc,
-                Build_Selected_Name
-                 (Protnm,
-                  New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
-                  'B'));
+                Build_Selected_Name (Prottyp, Comp_Id, 'B'));
             Sub :=
               Make_Subprogram_Declaration (Loc,
                 Specification =>
@@ -7246,10 +7433,7 @@ package body Exp_Ch9 is
                Set_Privals_Chain (Comp_Id, New_Elmt_List);
                Edef :=
                  Make_Defining_Identifier (Loc,
-                  Build_Selected_Name
-                   (Protnm,
-                    New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
-                    'E'));
+                  Build_Selected_Name (Prottyp, Comp_Id, 'E'));
 
                Sub :=
                  Make_Subprogram_Declaration (Loc,
@@ -7267,10 +7451,8 @@ package body Exp_Ch9 is
 
                Bdef :=
                  Make_Defining_Identifier (Loc,
-                  Build_Selected_Name
-                   (Protnm,
-                    New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
-                    'B'));
+                    Build_Selected_Name (Prottyp, Comp_Id, 'E'));
+
                Sub :=
                  Make_Subprogram_Declaration (Loc,
                    Specification =>
@@ -7283,9 +7465,8 @@ package body Exp_Ch9 is
                Set_Scope (Bdef, Scope (Comp_Id));
                Current_Node := Sub;
 
-               --  Collect pointers to the protected subprogram and the
-               --  barrier of the current entry, for insertion into
-               --  Entry_Bodies_Array.
+               --  Collect pointers to the protected subprogram and the barrier
+               --  of the current entry, for insertion into Entry_Bodies_Array.
 
                Append (
                  Make_Aggregate (Loc,
@@ -7345,9 +7526,8 @@ package body Exp_Ch9 is
                       Attribute_Name => Name_Unrestricted_Access))));
          end if;
 
-         --  A pointer to this array will be placed in the corresponding
-         --  record by its initialization procedure, so this needs to be
-         --  analyzed here.
+         --  A pointer to this array will be placed in the corresponding record
+         --  by its initialization procedure so this needs to be analyzed here.
 
          Insert_After (Current_Node, Body_Arr);
          Current_Node := Body_Arr;
@@ -7378,11 +7558,11 @@ package body Exp_Ch9 is
    --------------------------------
 
    --  A requeue statement is expanded into one of four GNARLI operations,
-   --  depending on the source and destination (task or protected object).
-   --  In addition, code must be generated to jump around the remainder of
-   --  processing for the original entry and, if the destination is a
-   --  (different) protected object, to attempt to service it.
-   --  The following illustrates the various cases:
+   --  depending on the source and destination (task or protected object). In
+   --  addition, code must be generated to jump around the remainder of
+   --  processing for the original entry and, if the destination is (different)
+   --  protected object, to attempt to service it. The following illustrates
+   --  the various cases:
 
    --  procedure entE
    --    (O : System.Address;
@@ -7539,8 +7719,8 @@ package body Exp_Ch9 is
             Prepend (Self_Param, Params);
             exit;
 
-         --  If neither task type or protected type, must be in some
-         --  inner enclosing block, so move on out
+         --  If neither task type or protected type, must be in some inner
+         --  enclosing block, so move on out
 
          else
             Oldtyp := Scope (Oldtyp);
@@ -7573,8 +7753,8 @@ package body Exp_Ch9 is
          end loop;
 
          --  The last statement is the second label, used for completing the
-         --  rendezvous the usual way.
-         --  The label we are looking for is right before it.
+         --  rendezvous the usual way. The label we are looking for is right
+         --  before it.
 
          Lab_Node :=
            Prev (Last (Statements (Handled_Statement_Sequence (Acc_Stat))));
@@ -7825,9 +8005,9 @@ package body Exp_Ch9 is
 
             --  During the analysis of the body of the accept statement, any
             --  zero cost exception handler records were collected in the
-            --  Accept_Handler_Records field of the N_Accept_Alternative
-            --  node. This is where we move them to where they belong,
-            --  namely the newly created procedure.
+            --  Accept_Handler_Records field of the N_Accept_Alternative node.
+            --  This is where we move them to where they belong, namely the
+            --  newly created procedure.
 
             Set_Handler_Records (PB_Ent, Accept_Handler_Records (Alt));
             Append (Proc_Body, Body_List);
@@ -7835,8 +8015,8 @@ package body Exp_Ch9 is
          else
             Null_Body := New_Reference_To (Standard_True,  Loc);
 
-            --  if accept statement has declarations, insert above, given
-            --  that we are not creating a body for the accept.
+            --  if accept statement has declarations, insert above, given that
+            --  we are not creating a body for the accept.
 
             if Present (Declarations (Acc_Stm)) then
                Insert_Actions (N, Declarations (Acc_Stm));
@@ -7931,9 +8111,9 @@ package body Exp_Ch9 is
                Alt_Stats := New_List;
             end if;
 
-            --  After the call, if any, branch to to trailing statements.
-            --  We create a label for each, as well as the corresponding
-            --  label declaration.
+            --  After the call, if any, branch to to trailing statements. We
+            --  create a label for each, as well as the corresponding label
+            --  declaration.
 
             Lab := Make_And_Declare_Label (Index);
             Append_To (Alt_Stats,
@@ -8067,8 +8247,8 @@ package body Exp_Ch9 is
 
          Append_List (Delay_Alt, Delay_List);
 
-         --  If the delay alternative has a statement part, add a
-         --  choice to the case statements for delays.
+         --  If the delay alternative has a statement part, add choice to the
+         --  case statements for delays.
 
          if Present (Statements (Alt)) then
 
@@ -8437,14 +8617,12 @@ package body Exp_Ch9 is
           Discrete_Choices => Choices,
           Statements => Alt_Stats));
 
-      --  We make use of the fact that Accept_Index is an integer type,
-      --  and generate successive literals for entries for each accept.
-      --  Only those for which there is a body or trailing statements are
-      --  given a case entry.
+      --  We make use of the fact that Accept_Index is an integer type, and
+      --  generate successive literals for entries for each accept. Only those
+      --  for which there is a body or trailing statements get a case entry.
 
       Alt := First (Select_Alternatives (N));
       Proc := First (Body_List);
-
       while Present (Alt) loop
 
          if Nkind (Alt) = N_Accept_Alternative then
@@ -8587,8 +8765,8 @@ package body Exp_Ch9 is
                 Name => New_Reference_To (RTE (RE_Timed_Selective_Wait), Loc),
                 Parameter_Associations => Parms));
 
-            --  This new call should follow the calculation of the
-            --  minimum delay.
+            --  This new call should follow the calculation of the minimum
+            --  delay.
 
             Insert_List_Before (Select_Call, Delay_List);
 
@@ -8652,9 +8830,9 @@ package body Exp_Ch9 is
    --------------------------------------
 
    --  Single task declarations should never be present after semantic
-   --  analysis, since we expect them to be replaced by a declaration of
-   --  an anonymous task type, followed by a declaration of the task
-   --  object. We include this routine to make sure that is happening!
+   --  analysis, since we expect them to be replaced by a declaration of an
+   --  anonymous task type, followed by a declaration of the task object. We
+   --  include this routine to make sure that is happening!
 
    procedure Expand_N_Single_Task_Declaration (N : Node_Id) is
    begin
@@ -8699,16 +8877,16 @@ package body Exp_Ch9 is
 
    --    tnameE := True;
 
-   --  In addition, if the task body is an activator, then a call to
-   --  activate tasks is added at the start of the statements, before
-   --  the call to Complete_Activation, and if in addition the task is
-   --  a master then it must be established as a master. These calls are
-   --  inserted and analyzed in Expand_Cleanup_Actions, when the
-   --  Handled_Sequence_Of_Statements is expanded.
+   --  In addition, if the task body is an activator, then a call to activate
+   --  tasks is added at the start of the statements, before the call to
+   --  Complete_Activation, and if in addition the task is a master then it
+   --  must be established as a master. These calls are inserted and analyzed
+   --  in Expand_Cleanup_Actions, when the Handled_Sequence_Of_Statements is
+   --  expanded.
 
    --  There is one discriminal declaration line generated for each
-   --  discriminant that is present to provide an easy reference point
-   --  for discriminant references inside the body (see Exp_Ch2.Expand_Name).
+   --  discriminant that is present to provide an easy reference point for
+   --  discriminant references inside the body (see Exp_Ch2.Expand_Name).
 
    --  Note on relationship to GNARLI definition. In the GNARLI definition,
    --  task body procedures have a profile (Arg : System.Address). That is
@@ -8777,9 +8955,8 @@ package body Exp_Ch9 is
       Rewrite (N, New_N);
       Analyze (N);
 
-      --  Set elaboration flag immediately after task body. If the body
-      --  is a subunit, the flag is set in  the declarative part that
-      --  contains the stub.
+      --  Set elaboration flag immediately after task body. If the body is a
+      --  subunit, the flag is set in the declarative part containing the stub.
 
       if Nkind (Parent (N)) /= N_Subunit then
          Insert_After (N,
@@ -8789,10 +8966,9 @@ package body Exp_Ch9 is
              Expression => New_Reference_To (Standard_True, Loc)));
       end if;
 
-      --  Ada 2005 (AI-345): Construct the primitive entry wrapper bodies
-      --  after the task body. At this point the entry specs have been
-      --  created, frozen and included in the dispatch table for the task
-      --  type.
+      --  Ada 2005 (AI-345): Construct the primitive entry wrapper bodies after
+      --  the task body. At this point the entry specs have been created,
+      --  frozen and included in the dispatch table for the task type.
 
       pragma Assert (Present (Corresponding_Record_Type (Ttyp)));
 
@@ -8814,10 +8990,10 @@ package body Exp_Ch9 is
                Current_Node := N;
             end if;
 
-            --  Examine the visible declarations of the task type,
-            --  looking for an entry declaration. We do not consider
-            --  entry families since they can not have dispatching
-            --  operations, thus they do not need entry wrappers.
+            --  Examine the visible declarations of the task type, looking for
+            --  an entry declaration. We do not consider entry families since
+            --  they cannot have dispatching operations, thus they do not need
+            --  entry wrappers.
 
             while Present (Vis_Decl) loop
                if Nkind (Vis_Decl) = N_Entry_Declaration
@@ -8858,8 +9034,8 @@ package body Exp_Ch9 is
 
    --    taskE : aliased Boolean := False;
 
-   --  Next a variable is declared to hold the task stack size (either
-   --  the default : Unspecified_Size, or a value that is set by a pragma
+   --  Next a variable is declared to hold the task stack size (either the
+   --  default : Unspecified_Size, or a value that is set by a pragma
    --  Storage_Size). If the value of the pragma Storage_Size is static, then
    --  the variable is initialized with this value:
 
@@ -8881,28 +9057,28 @@ package body Exp_Ch9 is
    --  The discriminants are present only if the corresponding task type has
    --  discriminants, and they exactly mirror the task type discriminants.
 
-   --  The Id field is always present. It contains the Task_Id value, as
-   --  set by the call to Create_Task. Note that although the task is
-   --  limited, the task value record type is not limited, so there is no
-   --  problem in passing this field as an out parameter to Create_Task.
+   --  The Id field is always present. It contains the Task_Id value, as set by
+   --  the call to Create_Task. Note that although the task is limited, the
+   --  task value record type is not limited, so there is no problem in passing
+   --  this field as an out parameter to Create_Task.
 
-   --  One entry_family component is present for each entry family in the
-   --  task definition. The bounds correspond to the bounds of the entry
-   --  family (which may depend on discriminants). The element type is
-   --  void, since we only need the bounds information for determining
-   --  the entry index. Note that the use of an anonymous array would
-   --  normally be illegal in this context, but this is a parser check,
-   --  and the semantics is quite prepared to handle such a case.
-
-   --  The _Size field is present only if a Storage_Size pragma appears in
-   --  the task definition. The expression captures the argument that was
-   --  present in the pragma, and is used to override the task stack size
-   --  otherwise associated with the task type.
+   --  One entry_family component is present for each entry family in the task
+   --  definition. The bounds correspond to the bounds of the entry family
+   --  (which may depend on discriminants). The element type is void, since we
+   --  only need the bounds information for determining the entry index. Note
+   --  that the use of an anonymous array would normally be illegal in this
+   --  context, but this is a parser check, and the semantics is quite prepared
+   --  to handle such a case.
+
+   --  The _Size field is present only if a Storage_Size pragma appears in the
+   --  task definition. The expression captures the argument that was present
+   --  in the pragma, and is used to override the task stack size otherwise
+   --  associated with the task type.
 
    --  The _Priority field is present only if a Priority or Interrupt_Priority
    --  pragma appears in the task definition. The expression captures the
-   --  argument that was present in the pragma, and is used to provide
-   --  the Size parameter to the call to Create_Task.
+   --  argument that was present in the pragma, and is used to provide the Size
+   --  parameter to the call to Create_Task.
 
    --  The _Task_Info field is present only if a Task_Info pragma appears in
    --  the task definition. The expression captures the argument that was
@@ -8910,18 +9086,18 @@ package body Exp_Ch9 is
    --  to the call to Create_Task.
 
    --  When a task is declared, an instance of the task value record is
-   --  created. The elaboration of this declaration creates the correct
-   --  bounds for the entry families, and also evaluates the size, priority,
-   --  and task_Info expressions if needed. The initialization routine for
-   --  the task type itself then calls Create_Task with appropriate
-   --  parameters to initialize the value of the Task_Id field.
+   --  created. The elaboration of this declaration creates the correct bounds
+   --  for the entry families, and also evaluates the size, priority, and
+   --  task_Info expressions if needed. The initialization routine for the task
+   --  type itself then calls Create_Task with appropriate parameters to
+   --  initialize the value of the Task_Id field.
 
    --  Note: the address of this record is passed as the "Discriminants"
-   --  parameter for Create_Task. Since Create_Task merely passes this onto
-   --  the body procedure, it does not matter that it does not quite match
-   --  the GNARLI model of what is being passed (the record contains more
-   --  than just the discriminants, but the discriminants can be found from
-   --  the record value).
+   --  parameter for Create_Task. Since Create_Task merely passes this onto the
+   --  body procedure, it does not matter that it does not quite match the
+   --  GNARLI model of what is being passed (the record contains more than just
+   --  the discriminants, but the discriminants can be found from the record
+   --  value).
 
    --  The Entity_Id for this created record type is placed in the
    --  Corresponding_Record_Type field of the associated task type entity.
@@ -9023,9 +9199,9 @@ package body Exp_Ch9 is
 
       Insert_After (Elab_Decl, Size_Decl);
 
-      --  Next build the rest of the corresponding record declaration.
-      --  This is done last, since the corresponding record initialization
-      --  procedure will reference the previously created entities.
+      --  Next build the rest of the corresponding record declaration. This is
+      --  done last, since the corresponding record initialization procedure
+      --  will reference the previously created entities.
 
       --  Fill in the component declarations -- first the _Task_Id field
 
@@ -9039,8 +9215,8 @@ package body Exp_Ch9 is
               Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_Id),
                                     Loc))));
 
-      --  Declare static ATCB (that is, created by the expander) if we
-      --  are using the Restricted run time.
+      --  Declare static ATCB (that is, created by the expander) if we are
+      --  using the Restricted run time.
 
       if Restricted_Profile then
          Append_To (Cdecls,
@@ -9062,8 +9238,8 @@ package body Exp_Ch9 is
 
       end if;
 
-      --  Declare static stack (that is, created by the expander) if we
-      --  are using the Restricted run time on a bare board configuration.
+      --  Declare static stack (that is, created by the expander) if we are
+      --  using the Restricted run time on a bare board configuration.
 
       if Restricted_Profile
         and then Preallocated_Stacks_On_Target
@@ -9102,8 +9278,8 @@ package body Exp_Ch9 is
 
          Append_To (Cdecls, Decl_Stack);
 
-         --  The appropriate alignment for the stack is ensured by the
-         --  run-time code in charge of task creation.
+         --  The appropriate alignment for the stack is ensured by the run-time
+         --  code in charge of task creation.
 
       end if;
 
@@ -9218,14 +9394,14 @@ package body Exp_Ch9 is
 
       Insert_After (Rec_Decl, Body_Decl);
 
-      --  The subprogram does not comes from source, so we have to indicate
-      --  the need for debugging information explicitly.
+      --  The subprogram does not comes from source, so we have to indicate the
+      --  need for debugging information explicitly.
 
       Set_Needs_Debug_Info
         (Defining_Entity (Proc_Spec), Comes_From_Source (Original_Node (N)));
 
-      --  Ada 2005 (AI-345): Construct the primitive entry wrapper specs
-      --  before the corresponding record has been frozen.
+      --  Ada 2005 (AI-345): Construct the primitive entry wrapper specs before
+      --  the corresponding record has been frozen.
 
       if Ada_Version >= Ada_05
         and then Present (Taskdef)
@@ -9242,10 +9418,10 @@ package body Exp_Ch9 is
             New_N        : Node_Id;
 
          begin
-            --  Examine the visible declarations of the task type,
-            --  looking for an entry declaration. We do not consider
-            --  entry families since they can not have dispatching
-            --  operations, thus they do not need entry wrappers.
+            --  Examine the visible declarations of the task type, looking for
+            --  an entry declaration. We do not consider entry families since
+            --  they cannot have dispatching operations, thus they do not need
+            --  entry wrappers.
 
             while Present (Vis_Decl) loop
                if Nkind (Vis_Decl) = N_Entry_Declaration
@@ -9295,8 +9471,8 @@ package body Exp_Ch9 is
          end;
       end if;
 
-      --  Complete the expansion of access types to the current task
-      --  type, if any were declared.
+      --  Complete the expansion of access types to the current task type, if
+      --  any were declared.
 
       Expand_Previous_Access_Type (Tasktyp);
    end Expand_N_Task_Type_Declaration;
@@ -9305,8 +9481,8 @@ package body Exp_Ch9 is
    -- Expand_N_Timed_Entry_Call --
    -------------------------------
 
-   --  A timed entry call in normal case is not implemented using ATC
-   --  mechanism anymore for efficiency reason.
+   --  A timed entry call in normal case is not implemented using ATC mechanism
+   --  anymore for efficiency reason.
 
    --     select
    --        T.E;
@@ -9421,12 +9597,13 @@ package body Exp_Ch9 is
       Params   : List_Id;
       Stmt     : Node_Id;
       Stmts    : List_Id;
+      Unpack   : List_Id;
 
       B : Entity_Id;  --  Call status flag
       C : Entity_Id;  --  Call kind
       D : Entity_Id;  --  Delay
       M : Entity_Id;  --  Delay mode
-      P : Node_Id;    --  Parameter block
+      P : Entity_Id;  --  Parameter block
       S : Entity_Id;  --  Primitive operation slot
 
    begin
@@ -9576,9 +9753,11 @@ package body Exp_Ch9 is
 
          --  Dispatch table slot processing, generate:
          --    S : constant Integer :=
-         --          DT_Prosition (<dispatching-procedure>)
+         --          Ada.Tags.Get_Offset_Index (
+         --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
+         --            DT_Position (<dispatching-procedure>));
 
-         S := SEU.Build_S (Loc, Decls, Call_Ent);
+         S := SEU.Build_S (Loc, Decls, Obj, Call_Ent);
 
          --  Generate:
          --    _dispatching_timed_select (Obj, S, P'address, D, M, C, B);
@@ -9592,7 +9771,9 @@ package body Exp_Ch9 is
 
          Append_To (Params, New_Copy_Tree    (Obj));
          Append_To (Params, New_Reference_To (S, Loc));
-         Append_To (Params, P);
+         Append_To (Params, Make_Attribute_Reference (Loc,
+                              Prefix => New_Reference_To (P, Loc),
+                              Attribute_Name => Name_Address));
          Append_To (Params, New_Reference_To (D, Loc));
          Append_To (Params, New_Reference_To (M, Loc));
          Append_To (Params, New_Reference_To (C, Loc));
@@ -9601,7 +9782,10 @@ package body Exp_Ch9 is
          Append_To (Stmts,
            Make_Procedure_Call_Statement (Loc,
              Name =>
-               Make_Identifier (Loc, Name_uDisp_Timed_Select),
+               New_Reference_To (
+                 Find_Prim_Op (Etype (Etype (Obj)),
+                   Name_uDisp_Timed_Select),
+                 Loc),
              Parameter_Associations =>
                Params));
 
@@ -9614,28 +9798,36 @@ package body Exp_Ch9 is
          --       ParamN := P.ParamN;
          --    end if;
 
-         Append_To (Stmts,
-           Make_If_Statement (Loc,
+         Unpack := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
 
-             Condition =>
-               Make_Or_Else (Loc,
-                 Left_Opnd =>
-                   Make_Op_Eq (Loc,
-                     Left_Opnd =>
-                       New_Reference_To (C, Loc),
-                     Right_Opnd =>
-                       New_Reference_To (RTE (RE_POK_Protected_Entry), Loc)),
-                 Right_Opnd =>
-                   Make_Op_Eq (Loc,
-                     Left_Opnd =>
-                       New_Reference_To (C, Loc),
-                     Right_Opnd =>
-                       New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
+         --  Generate the if statement only when the packed parameters need
+         --  explicit assignments to their corresponding actuals.
 
-             Then_Statements =>
-               Parameter_Block_Unpack (Loc, Actuals, Formals)));
+         if Present (Unpack) then
+            Append_To (Stmts,
+              Make_If_Statement (Loc,
+
+                Condition =>
+                  Make_Or_Else (Loc,
+                    Left_Opnd =>
+                      Make_Op_Eq (Loc,
+                        Left_Opnd =>
+                          New_Reference_To (C, Loc),
+                        Right_Opnd =>
+                          New_Reference_To (RTE (
+                            RE_POK_Protected_Entry), Loc)),
+                    Right_Opnd =>
+                      Make_Op_Eq (Loc,
+                        Left_Opnd =>
+                          New_Reference_To (C, Loc),
+                        Right_Opnd =>
+                          New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
+
+                Then_Statements => Unpack));
+         end if;
 
          --  Generate:
+
          --    if B then
          --       if C = POK_Procedure
          --         or else C = POK_Protected_Procedure
@@ -9648,7 +9840,7 @@ package body Exp_Ch9 is
          --       <delay-statements>
          --    end if;
 
-         N_Stats := New_Copy_List (E_Stats);
+         N_Stats := New_Copy_List_Tree (E_Stats);
 
          Prepend_To (N_Stats,
            Make_If_Statement (Loc,
@@ -9802,18 +9994,18 @@ package body Exp_Ch9 is
    -- Expand_Protected_Body_Declarations --
    ----------------------------------------
 
-   --  Part of the expansion of a protected body involves the creation of
-   --  a declaration that can be referenced from the statement sequences of
-   --  the entry bodies:
+   --  Part of the expansion of a protected body involves the creation of a
+   --  declaration that can be referenced from the statement sequences of the
+   --  entry bodies:
 
    --    A : Address;
 
-   --  This declaration is inserted in the declarations of the service
-   --  entries procedure for the protected body, and it is important that
-   --  it be inserted before the statements of the entry body statement
-   --  sequences are analyzed. Thus it would be too late to create this
-   --  declaration in the Expand_N_Protected_Body routine, which is why
-   --  there is a separate procedure to be called directly from Sem_Ch9.
+   --  This declaration is inserted in the declarations of the service entries
+   --  procedure for the protected body, and it is important that it be
+   --  inserted before the statements of the entry body statement sequences are
+   --  analyzed. Thus it would be too late to create this declaration in the
+   --  Expand_N_Protected_Body routine, which is why there is a separate
+   --  procedure to be called directly from Sem_Ch9.
 
    --  Ann is used to hold the address of the record containing the parameters
    --  (see Expand_N_Entry_Call for more details on how this record is built).
@@ -9824,14 +10016,14 @@ package body Exp_Ch9 is
    --  Accept_Address stack in the corresponding entry entity, and this element
    --  must be set in place  before the statements are processed.
 
-   --  No stack is needed for entry bodies, since they cannot be nested, but
-   --  it is kept for consistency between protected and task entries. The
-   --  stack will never contain more than one element. There is also only one
-   --  such variable for a given protected body, but this is placed on the
+   --  No stack is needed for entry bodies, since they cannot be nested, but it
+   --  is kept for consistency between protected and task entries. The stack
+   --  will never contain more than one element. There is also only one such
+   --  variable for a given protected body, but this is placed on the
    --  Accept_Address stack of all of the entries, again for consistency.
 
-   --  To expand the requeue statement, a label is provided at the end of
-   --  the loop in the entry service routine created by the expander (see
+   --  To expand the requeue statement, a label is provided at the end of the
+   --  loop in the entry service routine created by the expander (see
    --  Expand_N_Protected_Body for details), so that the statement can be
    --  skipped after the requeue is complete. This label is created during the
    --  expansion of the entry body, which will take place after the expansion
@@ -9859,9 +10051,9 @@ package body Exp_Ch9 is
 
       elsif Expander_Active then
 
-         --  Associate privals with the first subprogram or entry
-         --  body to be expanded. These are used to expand references
-         --  to private data objects.
+         --  Associate privals with the first subprogram or entry body to be
+         --  expanded. These are used to expand references to private data
+         --  objects.
 
          Op := First_Protected_Operation (Declarations (N));
 
@@ -9991,12 +10183,11 @@ package body Exp_Ch9 is
       Ttyp : Entity_Id) return Node_Id
    is
       function Convert_Discriminant_Ref (Bound : Node_Id) return Node_Id;
-      --  If one of the bounds is a reference to a discriminant, replace
-      --  with corresponding discriminal of type. Within the body of a task
-      --  retrieve the renamed discriminant by simple visibility, using its
-      --  generated name. Within a protected object, find the original dis-
-      --  criminant and replace it with the discriminal of the current prot-
-      --  ected operation.
+      --  If one of the bounds is a reference to a discriminant, replace with
+      --  corresponding discriminal of type. Within the body of a task retrieve
+      --  the renamed discriminant by simple visibility, using its generated
+      --  name. Within a protected object, find the original dis- criminant and
+      --  replace it with the discriminal of the current prot- ected operation.
 
       ------------------------------
       -- Convert_Discriminant_Ref --
@@ -10019,7 +10210,6 @@ package body Exp_Ch9 is
 
             elsif Is_Protected_Type (Ttyp) then
                D := First_Discriminant (Ttyp);
-
                while Chars (D) /= Chars (Entity (Bound)) loop
                   Next_Discriminant (D);
                end loop;
@@ -10097,7 +10287,6 @@ package body Exp_Ch9 is
 
    begin
       N := First (Visible_Declarations (T));
-
       while Present (N) loop
          if Nkind (N) = N_Pragma then
             if Chars (N) = P then
@@ -10118,7 +10307,6 @@ package body Exp_Ch9 is
       end loop;
 
       N := First (Private_Declarations (T));
-
       while Present (N) loop
          if Nkind (N) = N_Pragma then
             if  Chars (N) = P then
@@ -10178,10 +10366,9 @@ package body Exp_Ch9 is
       Lo : Node_Id := Type_Low_Bound  (Etype (Index_Id));
 
       function Replace_Discriminant (Bound : Node_Id) return Node_Id;
-      --  The bounds of the entry index may depend on discriminants, so
-      --  each declaration of an entry_index_constant must have its own
-      --  subtype declaration, using the local renaming of the object discri-
-      --  minant.
+      --  The bounds of the entry index may depend on discriminants, so each
+      --  declaration of an entry_index_constant must have its own subtype
+      --  declaration, using the local renaming of the object discriminant.
 
       --------------------------
       -- Replace_Discriminant --
@@ -10285,22 +10472,20 @@ package body Exp_Ch9 is
       Restricted  : constant Boolean := Restricted_Profile;
 
    begin
-      --  We may need two calls to properly initialize the object, one
-      --  to Initialize_Protection, and possibly one to Install_Handlers
-      --  if we have a pragma Attach_Handler.
+      --  We may need two calls to properly initialize the object, one to
+      --  Initialize_Protection, and possibly one to Install_Handlers if we
+      --  have a pragma Attach_Handler.
 
       --  Get protected declaration. In the case of a task type declaration,
-      --  this is simply the parent of the protected type entity.
-      --  In the single protected object
-      --  declaration, this parent will be the implicit type, and we can find
-      --  the corresponding single protected object declaration by
-      --  searching forward in the declaration list in the tree.
-      --  ??? I am not sure that the test for N_Single_Protected_Declaration
-      --      is needed here. Nodes of this type should have been removed
-      --      during semantic analysis.
+      --  this is simply the parent of the protected type entity. In the single
+      --  protected object declaration, this parent will be the implicit type,
+      --  and we can find the corresponding single protected object declaration
+      --  by searching forward in the declaration list in the tree.
 
-      Pdec := Parent (Ptyp);
+      --  Is the test for N_Single_Protected_Declaration needed here??? Nodes
+      --  of this type should have been removed during semantic analysis.
 
+      Pdec := Parent (Ptyp);
       while Nkind (Pdec) /= N_Protected_Type_Declaration
         and then Nkind (Pdec) /= N_Single_Protected_Declaration
       loop
@@ -10378,10 +10563,11 @@ package body Exp_Ch9 is
          end if;
 
          if Has_Entry then
+
             --  Entry_Bodies parameter. This is a pointer to an array of
-            --  pointers to the entry body procedures and barrier functions
-            --  of the object. If the protected type has no entries this
-            --  object will not exist; in this case, pass a null.
+            --  pointers to the entry body procedures and barrier functions of
+            --  the object. If the protected type has no entries this object
+            --  will not exist; in this case, pass a null.
 
             P_Arr := Entry_Bodies_Array (Ptyp);
 
@@ -10446,11 +10632,14 @@ package body Exp_Ch9 is
 
       if Has_Attach_Handler (Ptyp) then
 
-         --  We have a list of N Attach_Handler (ProcI, ExprI),
-         --  and we have to make the following call:
+         --  We have a list of N Attach_Handler (ProcI, ExprI), and we have to
+         --  make the following call:
+
          --  Install_Handlers (_object,
          --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
+
          --  or, in the case of Ravenscar:
+
          --  Install_Handlers
          --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
 
@@ -10461,6 +10650,7 @@ package body Exp_Ch9 is
 
          begin
             if not Restricted then
+
                --  Appends the _object argument
 
                Append_To (Args,
@@ -10536,17 +10726,16 @@ package body Exp_Ch9 is
       Ttyp := Corresponding_Concurrent_Type (Task_Rec);
       Tnam := Chars (Ttyp);
 
-      --  Get task declaration. In the case of a task type declaration, this
-      --  is simply the parent of the task type entity. In the single task
+      --  Get task declaration. In the case of a task type declaration, this is
+      --  simply the parent of the task type entity. In the single task
       --  declaration, this parent will be the implicit type, and we can find
-      --  the corresponding single task declaration by searching forward in
-      --  the declaration list in the tree.
-      --  ??? I am not sure that the test for N_Single_Task_Declaration
-      --      is needed here. Nodes of this type should have been removed
-      --      during semantic analysis.
+      --  the corresponding single task declaration by searching forward in the
+      --  declaration list in the tree.
 
-      Tdec := Parent (Ttyp);
+      --  Is the test for N_Single_Task_Declaration needed here??? Nodes of
+      --  this type should have been removed during semantic analysis.
 
+      Tdec := Parent (Ttyp);
       while Nkind (Tdec) /= N_Task_Type_Declaration
         and then Nkind (Tdec) /= N_Single_Task_Declaration
       loop
@@ -10741,7 +10930,6 @@ package body Exp_Ch9 is
 
    begin
       Next_Op := Next (N);
-
       while Present (Next_Op)
         and then Nkind (Next_Op) /= N_Subprogram_Body
         and then Nkind (Next_Op) /= N_Entry_Body
@@ -10764,12 +10952,14 @@ package body Exp_Ch9 is
       Decls   : List_Id;
       Stmts   : List_Id) return Node_Id
    is
-      Actual   : Entity_Id;
-      Blk_Nam  : Node_Id;
-      Formal   : Entity_Id;
-      Params   : List_Id;
-      Temp_Asn : Node_Id;
-      Temp_Nam : Node_Id;
+      Actual    : Entity_Id;
+      Expr      : Node_Id := Empty;
+      Formal    : Entity_Id;
+      Has_Param : Boolean := False;
+      P         : Entity_Id;
+      Params    : List_Id;
+      Temp_Asn  : Node_Id;
+      Temp_Nam  : Node_Id;
 
    begin
       Actual := First (Actuals);
@@ -10820,41 +11010,46 @@ package body Exp_Ch9 is
                   Name_Unchecked_Access,
                 Prefix =>
                   New_Reference_To (Temp_Nam, Loc)));
+
+            Has_Param := True;
+
+         --  The controlling parameter is omitted
+
          else
-            Append_To (Params,
-              Make_Reference (Loc, New_Copy_Tree (Actual)));
+            if not Is_Controlling_Actual (Actual) then
+               Append_To (Params,
+                 Make_Reference (Loc, New_Copy_Tree (Actual)));
+
+               Has_Param := True;
+            end if;
          end if;
 
          Next_Actual (Actual);
          Next_Formal_With_Extras (Formal);
       end loop;
 
+      if Has_Param then
+         Expr := Make_Aggregate (Loc, Params);
+      end if;
+
       --  Generate:
       --    P : Ann := (
       --      J1'unchecked_access;
       --      <actual2>'reference;
       --      ...);
 
-      Blk_Nam := Make_Defining_Identifier (Loc, Name_uP);
+      P := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
 
       Append_To (Decls,
         Make_Object_Declaration (Loc,
           Defining_Identifier =>
-            Blk_Nam,
+            P,
           Object_Definition =>
             New_Reference_To (Blk_Typ, Loc),
           Expression =>
-            Make_Aggregate (Loc, Params)));
-
-      --  Return:
-      --    P'address
+            Expr));
 
-      return
-        Make_Attribute_Reference (Loc,
-          Attribute_Name =>
-            Name_Address,
-          Prefix =>
-            New_Reference_To (Blk_Nam, Loc));
+      return P;
    end Parameter_Block_Pack;
 
    ----------------------------
@@ -10863,26 +11058,23 @@ package body Exp_Ch9 is
 
    function Parameter_Block_Unpack
      (Loc     : Source_Ptr;
+      P       : Entity_Id;
       Actuals : List_Id;
       Formals : List_Id) return List_Id
    is
-      Actual : Entity_Id;
-      Asnmt  : Node_Id;
-      Formal : Entity_Id;
-      Result : constant List_Id := New_List;
-
-      At_Least_One_Asnmt : Boolean := False;
+      Actual    : Entity_Id;
+      Asnmt     : Node_Id;
+      Formal    : Entity_Id;
+      Has_Asnmt : Boolean := False;
+      Result    : constant List_Id := New_List;
 
    begin
       Actual := First (Actuals);
       Formal := Defining_Identifier (First (Formals));
-
       while Present (Actual) loop
          if Is_By_Copy_Type (Etype (Actual))
            and then Ekind (Formal) /= E_In_Parameter
          then
-            At_Least_One_Asnmt := True;
-
             --  Generate:
             --    <actual> := P.<formal>;
 
@@ -10894,24 +11086,25 @@ package body Exp_Ch9 is
                   Make_Explicit_Dereference (Loc,
                     Make_Selected_Component (Loc,
                       Prefix =>
-                        Make_Identifier (Loc, Name_uP),
+                        New_Reference_To (P, Loc),
                       Selector_Name =>
                         Make_Identifier (Loc, Chars (Formal)))));
 
             Set_Assignment_OK (Name (Asnmt));
-
             Append_To (Result, Asnmt);
+
+            Has_Asnmt := True;
          end if;
 
          Next_Actual (Actual);
          Next_Formal_With_Extras (Formal);
       end loop;
 
-      if At_Least_One_Asnmt then
+      if Has_Asnmt then
          return Result;
+      else
+         return New_List (Make_Null_Statement (Loc));
       end if;
-
-      return New_List (Make_Null_Statement (Loc));
    end Parameter_Block_Unpack;
 
    ----------------------
@@ -10950,15 +11143,19 @@ package body Exp_Ch9 is
    -----------------
 
    procedure Set_Privals
-      (Dec : Node_Id;
-       Op  : Node_Id;
-       Loc : Source_Ptr)
+      (Dec           : Node_Id;
+       Op            : Node_Id;
+       Loc           : Source_Ptr;
+       After_Barrier : Boolean := False)
    is
-      P_Decl    : Node_Id;
-      P_Id      : Entity_Id;
-      Priv      : Entity_Id;
-      Def       : Node_Id;
-      Body_Ent  : Entity_Id;
+      P_Decl      : Node_Id;
+      P_Id        : Entity_Id;
+      Priv        : Entity_Id;
+      Def         : Node_Id;
+      Body_Ent    : Entity_Id;
+      For_Barrier : constant Boolean :=
+                      Nkind (Op) = N_Entry_Body and then not After_Barrier;
+
       Prec_Decl : constant Node_Id :=
                     Parent (Corresponding_Record_Type
                              (Defining_Identifier (Dec)));
@@ -10976,15 +11173,20 @@ package body Exp_Ch9 is
       Def := Protected_Definition (Dec);
 
       if Present (Private_Declarations (Def)) then
-
          P_Decl := First (Private_Declarations (Def));
-
          while Present (P_Decl) loop
             if Nkind (P_Decl) = N_Component_Declaration then
                P_Id := Defining_Identifier (P_Decl);
-               Priv :=
-                 Make_Defining_Identifier (Loc,
-                   New_External_Name (Chars (P_Id), 'P'));
+
+               if For_Barrier then
+                  Priv :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => New_External_Name (Chars (P_Id), 'P'));
+               else
+                  Priv :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => New_External_Name (Chars (P_Id)));
+               end if;
 
                Set_Ekind     (Priv, E_Variable);
                Set_Etype     (Priv, Etype (P_Id));
@@ -11075,7 +11277,6 @@ package body Exp_Ch9 is
          if Is_Entity_Name (N)  then
             declare
                E : constant Entity_Id := Entity (N);
-
             begin
                if Present (E)
                  and then (Ekind (E) = E_Constant
diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads
index 044f56d..baa5036 100644
--- a/gcc/ada/exp_ch9.ads
+++ b/gcc/ada/exp_ch9.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -311,13 +311,21 @@ package Exp_Ch9 is
    --  protected type.
 
    procedure Set_Privals
-      (Dec : Node_Id;
-       Op  : Node_Id;
-       Loc : Source_Ptr);
+      (Dec           : Node_Id;
+       Op            : Node_Id;
+       Loc           : Source_Ptr;
+       After_Barrier : Boolean := False);
    --  Associates a new set of privals (placeholders for later access to
    --  private components of protected objects) with the private object
    --  declarations of a protected object. These will be used to expand
    --  the references to private objects in the next protected
    --  subprogram or entry body to be expanded.
+   --
+   --  The flag After_Barrier indicates whether this is called after building
+   --  the barrier function for an entry body. This flag determines whether
+   --  the privals should have source names (which simplifies debugging) or
+   --  internally generated names. Entry barriers contain no debuggable code,
+   --  and there may be visibility conflicts between an entry index and a
+   --  a prival, so  privals for barrier function have internal names.
 
 end Exp_Ch9;
diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index e7bdcc4..8281f15 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2005, 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- --
@@ -134,7 +134,7 @@ package body Exp_Dbug is
    --  used to determine whether encoding is required for a discrete type.
 
    procedure Output_Homonym_Numbers_Suffix;
-   --  If homonym numbers are stored, then output them into Name_Buffer.
+   --  If homonym numbers are stored, then output them into Name_Buffer
 
    procedure Prepend_String_To_Buffer (S : String);
    --  Prepend given string to the contents of the string buffer, updating
@@ -250,9 +250,9 @@ package body Exp_Dbug is
       then
          return True;
 
-      --  Here we check if the static bounds match the natural size, which
-      --  is the size passed through with the debugging information. This
-      --  is the Esize rounded up to 8, 16, 32 or 64 as appropriate.
+      --  Here we check if the static bounds match the natural size, which is
+      --  the size passed through with the debugging information. This is the
+      --  Esize rounded up to 8, 16, 32 or 64 as appropriate.
 
       else
          declare
@@ -305,12 +305,12 @@ package body Exp_Dbug is
       Def : Entity_Id;
 
       function Output_Subscript (N : Node_Id; S : String) return Boolean;
-      --  Outputs a single subscript value as ?nnn (subscript is compile
-      --  time known value with value nnn) or as ?e (subscript is local
-      --  constant with name e), where S supplies the proper string to
-      --  use for ?. Returns False if the subscript is not of an appropriate
-      --  type to output in one of these two forms. The result is prepended
-      --  to the name stored in Name_Buffer.
+      --  Outputs a single subscript value as ?nnn (subscript is compile time
+      --  known value with value nnn) or as ?e (subscript is local constant
+      --  with name e), where S supplies the proper string to use for ?.
+      --  Returns False if the subscript is not of an appropriate type to
+      --  output in one of these two forms. The result is prepended to the
+      --  name stored in Name_Buffer.
 
       ----------------------
       -- Output_Subscript --
@@ -358,9 +358,9 @@ package body Exp_Dbug is
          when N_Package_Renaming_Declaration =>
             Add_Str_To_Name_Buffer ("___XRP");
 
-            --  If it is a child unit create a fully qualified name,
-            --  to disambiguate multiple child units with the same
-            --  name and different parents.
+            --  If it is a child unit create a fully qualified name, to
+            --  disambiguate multiple child units with the same name and
+            --  different parents.
 
             if Is_Child_Unit (Ent) then
                Prepend_String_To_Buffer ("__");
@@ -386,8 +386,8 @@ package body Exp_Dbug is
 
             when N_Expanded_Name =>
 
-               --  The entity field for an N_Expanded_Name is on the
-               --  expanded name node itself, so we are done here too.
+               --  The entity field for an N_Expanded_Name is on the expanded
+               --  name node itself, so we are done here too.
 
                exit;
 
@@ -713,6 +713,7 @@ package body Exp_Dbug is
          --  If this is a library level subprogram (i.e. a subprogram that is a
          --  compilation unit other than a subunit), then we prepend _ada_ to
          --  ensure distinctions required as described in the spec.
+
          --  Check explicitly for child units, because those are not flagged
          --  as Compilation_Units by lib. Should they be ???
 
@@ -880,6 +881,39 @@ package body Exp_Dbug is
       end if;
    end Get_Variant_Encoding;
 
+   ------------------------------------
+   -- Get_Secondary_DT_External_Name --
+   ------------------------------------
+
+   procedure Get_Secondary_DT_External_Name
+     (Typ             : Entity_Id;
+      Ancestor_Typ    : Entity_Id;
+      Suffix_Index    : Int) is
+   begin
+      Get_External_Name (Typ, Has_Suffix => False);
+
+      if Ancestor_Typ /= Typ then
+         declare
+            Len      : constant Natural := Name_Len;
+            Save_Str : constant String (1 .. Name_Len)
+                         := Name_Buffer (1 .. Name_Len);
+         begin
+            Get_External_Name (Ancestor_Typ, Has_Suffix => False);
+
+            --  Append the extended name of the ancestor to the
+            --  extended name of Typ
+
+            Name_Buffer (Len + 2 .. Len + Name_Len + 1) :=
+              Name_Buffer (1 .. Name_Len);
+            Name_Buffer (1 .. Len) := Save_Str;
+            Name_Buffer (Len + 1) := '_';
+            Name_Len := Len + Name_Len + 1;
+         end;
+      end if;
+
+      Add_Nat_To_Name_Buffer (Suffix_Index);
+   end Get_Secondary_DT_External_Name;
+
    ---------------------------------
    -- Make_Packed_Array_Type_Name --
    ---------------------------------
@@ -1166,7 +1200,6 @@ package body Exp_Dbug is
          else
             Add_Char_To_Name_Buffer ('X');
          end if;
-
       end Set_BNPE_Suffix;
 
       ---------------------
@@ -1338,7 +1371,6 @@ package body Exp_Dbug is
             exit;
          end if;
       end loop;
-
    end Strip_Suffixes;
 
 end Exp_Dbug;
diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads
index 9100d9c..ccd80f3 100644
--- a/gcc/ada/exp_dbug.ads
+++ b/gcc/ada/exp_dbug.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2005, 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- --
@@ -360,7 +360,7 @@ package Exp_Dbug is
       --  Operations generated for protected entries follow the same encoding.
       --  Each entry results in two suprograms: a procedure that holds the
       --  entry body, and a function that holds the evaluation of the barrier.
-      --  The names of these subprograms include the prefix 'E' or 'B' res-
+      --  The names of these subprograms include the prefix '_E' or '_B' res-
       --  pectively. The names also include a numeric suffix to render them
       --  unique in the presence of overloaded entries.
 
@@ -382,8 +382,8 @@ package Exp_Dbug is
       --    lock_setN
       --    lock_setP
 
-      --    lock_update1sE
-      --    lock_udpate2sB
+      --    lock_update_E1s
+      --    lock_udpate_B2s
 
       --  If the protected type implements at least one interface, the
       --  following additional operations are created:
@@ -538,6 +538,12 @@ package Exp_Dbug is
       --  field, and neither the outer structure name, nor the field name
       --  should appear when the value is printed.
 
+      --  When the debugger sees a record named REP being a field inside
+      --  another record, it should treat the fields inside REP as being
+      --  part of the outer record (this REP field is only present for
+      --  code generation purposes). The REP record should not appear in
+      --  the values printed by the debugger.
+
       -----------------------
       -- Fixed-Point Types --
       -----------------------
@@ -1432,6 +1438,66 @@ package Exp_Dbug is
    --  the second enumeration literal would be named QU43 and the
    --  value assigned to it would be 1.
 
+   -----------------------------------------------
+   -- Secondary Dispatch tables of tagged types --
+   -----------------------------------------------
+
+   procedure Get_Secondary_DT_External_Name
+     (Typ          : Entity_Id;
+      Ancestor_Typ : Entity_Id;
+      Suffix_Index : Int);
+   --  Set Name_Buffer and Name_Len to the external name of one secondary
+   --  dispatch table of Typ. If the interface has been inherited from some
+   --  ancestor then Ancestor_Typ is such node (in this case the secondary
+   --  DT is needed to handle overriden primitives); if there is no such
+   --  ancestor then  Ancestor_Typ is equal to Typ.
+   --
+   --  Internal rule followed for the generation of the external name:
+   --
+   --  Case 1. If the secondary dispatch has not been inherited from some
+   --          ancestor of Typ then the external name is composed as
+   --          follows:
+   --             External_Name (Typ) + Suffix_Number + 'P'
+   --
+   --  Case 2. if the secondary dispatch table has been inherited from some
+   --          ancestor then the external name is composed as follows:
+   --             External_Name (Typ) + '_' + External_Name (Ancestor_Typ)
+   --               + Suffix_Number + 'P'
+   --
+   --  Note: We have to use the external names (instead of simply their
+   --  names) to protect the frontend against programs that give the same
+   --  name to all the interfaces and use the expanded name to reference
+   --  them. The Suffix_Number is used to differentiate all the secondary
+   --  dispatch tables of a given type.
+   --
+   --  Examples:
+   --
+   --        package Pkg1 is | package Pkg2 is | package Pkg3 is
+   --          type Typ is   |   type Typ is   |   type Typ is
+   --            interface;  |     interface;  |     interface;
+   --        end Pkg1;       | end Pkg;        | end Pkg3;
+   --
+   --  with Pkg1, Pkg2, Pkg3;
+   --  package Case_1 is
+   --    type Typ is new Pkg1.Typ and Pkg2.Typ and Pkg3.Typ with ...
+   --  end Case_1;
+   --
+   --  with Case_1;
+   --  package Case_2 is
+   --    type Typ is new Case_1.Typ with ...
+   --  end Case_2;
+   --
+   --  These are the external names generated for Case_1.Typ (note that
+   --  Pkg1.Typ is associated with the Primary Dispatch Table, because it
+   --  is the the parent of this type, and hence no external name is
+   --  generated for it).
+   --      case_1__typ0P   (associated with Pkg2.Typ)
+   --      case_1__typ1P   (associated with Pkg3.Typ)
+   --
+   --  These are the external names generated for Case_2.Typ:
+   --      case_2__typ_case_1__typ0P
+   --      case_2__typ_case_1__typ1P
+
    ----------------------------
    -- Effect of Optimization --
    ----------------------------
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 524d6de..20e769e 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-2005, 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- --
@@ -31,6 +31,7 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch7;  use Exp_Ch7;
+with Exp_Dbug; use Exp_Dbug;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Itypes;   use Itypes;
@@ -74,9 +75,10 @@ package body Exp_Disp is
       --    C : out Prim_Op_Kind
 
       procedure Build_Common_Dispatching_Select_Statements
-        (Loc   : Source_Ptr;
-         Typ   : Entity_Id;
-         Stmts : List_Id);
+        (Loc    : Source_Ptr;
+         Typ    : Entity_Id;
+         DT_Ptr : Entity_Id;
+         Stmts  : List_Id);
       --  Ada 2005 (AI-345): Generate statements that are common between
       --  asynchronous, conditional and timed select expansion.
 
@@ -151,21 +153,10 @@ package body Exp_Disp is
       procedure Build_Common_Dispatching_Select_Statements
         (Loc   : Source_Ptr;
          Typ   : Entity_Id;
+         DT_Ptr : Entity_Id;
          Stmts : List_Id)
       is
-         DT_Ptr     : Entity_Id;
-         DT_Ptr_Typ : Entity_Id := Typ;
-
       begin
-         --  Typ may be a derived type, climb the derivation chain in order to
-         --  find the root.
-
-         while Present (Parent_Subtype (DT_Ptr_Typ)) loop
-            DT_Ptr_Typ := Parent_Subtype (DT_Ptr_Typ);
-         end loop;
-
-         DT_Ptr := Node (First_Elmt (Access_Disp_Table (DT_Ptr_Typ)));
-
          --  Generate:
          --    C := get_prim_op_kind (tag! (<type>VP), S);
 
@@ -187,6 +178,7 @@ package body Exp_Disp is
                      Make_Identifier (Loc, Name_uS)))));
 
          --  Generate:
+
          --    if C = POK_Procedure
          --      or else C = POK_Protected_Procedure
          --      or else C = POK_Task_Procedure;
@@ -317,6 +309,7 @@ package body Exp_Disp is
        Get_Access_Level        => RE_Get_Access_Level,
        Get_Entry_Index         => RE_Get_Entry_Index,
        Get_External_Tag        => RE_Get_External_Tag,
+       Get_Offset_Index        => RE_Get_Offset_Index,
        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,
@@ -329,10 +322,13 @@ package body Exp_Disp is
        Set_Entry_Index         => RE_Set_Entry_Index,
        Set_Expanded_Name       => RE_Set_Expanded_Name,
        Set_External_Tag        => RE_Set_External_Tag,
+       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,
        TSD_Entry_Size          => RE_TSD_Entry_Size,
        TSD_Prologue_Size       => RE_TSD_Prologue_Size);
@@ -345,6 +341,7 @@ package body Exp_Disp is
        Get_Access_Level        => False,
        Get_Entry_Index         => False,
        Get_External_Tag        => False,
+       Get_Offset_Index        => False,
        Get_Prim_Op_Address     => False,
        Get_Prim_Op_Kind        => False,
        Get_Remotely_Callable   => False,
@@ -357,10 +354,13 @@ package body Exp_Disp is
        Set_Entry_Index         => True,
        Set_Expanded_Name       => True,
        Set_External_Tag        => 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,
        TSD_Entry_Size          => False,
        TSD_Prologue_Size       => False);
@@ -373,6 +373,7 @@ package body Exp_Disp is
        Get_Access_Level        => 1,
        Get_Entry_Index         => 2,
        Get_External_Tag        => 1,
+       Get_Offset_Index        => 2,
        Get_Prim_Op_Address     => 2,
        Get_Prim_Op_Kind        => 2,
        Get_RC_Offset           => 1,
@@ -385,10 +386,13 @@ package body Exp_Disp is
        Set_Entry_Index         => 3,
        Set_Expanded_Name       => 2,
        Set_External_Tag        => 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,
        TSD_Entry_Size          => 0,
        TSD_Prologue_Size       => 0);
@@ -552,21 +556,25 @@ package body Exp_Disp is
       elsif TSS_Name = TSS_Deep_Finalize then
          return Uint_10;
 
-      elsif Chars (E) = Name_uDisp_Asynchronous_Select then
-         return Uint_11;
+      elsif Ada_Version >= Ada_05 then
+         if Chars (E) = Name_uDisp_Asynchronous_Select then
+            return Uint_11;
 
-      elsif Chars (E) = Name_uDisp_Conditional_Select then
-         return Uint_12;
+         elsif Chars (E) = Name_uDisp_Conditional_Select then
+            return Uint_12;
 
-      elsif Chars (E) = Name_uDisp_Get_Prim_Op_Kind then
-         return Uint_13;
+         elsif Chars (E) = Name_uDisp_Get_Prim_Op_Kind then
+            return Uint_13;
 
-      elsif Chars (E) = Name_uDisp_Timed_Select then
-         return Uint_14;
+         elsif Chars (E) = Name_uDisp_Get_Task_Id then
+            return Uint_14;
 
-      else
-         raise Program_Error;
+         elsif Chars (E) = Name_uDisp_Timed_Select then
+            return Uint_15;
+         end if;
       end if;
+
+      raise Program_Error;
    end Default_Prim_Op_Position;
 
    -----------------------------
@@ -1527,7 +1535,6 @@ package body Exp_Disp is
              (Etype (First_Entity (Target)),
               Make_Explicit_Dereference (Loc,
                 New_Reference_To (Defining_Identifier (Decl_2), Loc))));
-
       end if;
 
       Formal := Next (First (Formals));
@@ -1650,7 +1657,6 @@ package body Exp_Disp is
 
    function Get_Remotely_Callable (Obj : Node_Id) return Node_Id is
       Loc : constant Source_Ptr := Sloc (Obj);
-
    begin
       return Make_DT_Access_Action
         (Typ    => Etype (Obj),
@@ -1675,14 +1681,16 @@ package body Exp_Disp is
       AI     : Elmt_Id;
 
    begin
-      --  No need to inherit primitives if it an abstract interface type
+      --  No need to inherit primitives if we have an abstract interface
+      --  type or a concurrent type.
 
-      if Is_Interface (Typ) then
+      if Is_Interface (Typ) or else Is_Concurrent_Record_Type (Typ) then
          return Result;
       end if;
 
       AI := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
       while Present (AI) loop
+
          --  All the secondary tables inherit the dispatch table entries
          --  associated with predefined primitives.
 
@@ -1704,759 +1712,6 @@ package body Exp_Disp is
       return Result;
    end Init_Predefined_Interface_Primitives;
 
-   -------------
-   -- Make_DT --
-   -------------
-
-   function Make_DT (Typ : Entity_Id) return List_Id is
-      Loc         : constant Source_Ptr := Sloc (Typ);
-      Result      : constant List_Id    := New_List;
-      Elab_Code   : constant List_Id    := New_List;
-
-      Tname       : constant Name_Id := Chars (Typ);
-      Name_DT     : constant Name_Id := New_External_Name (Tname, 'T');
-      Name_DT_Ptr : constant Name_Id := New_External_Name (Tname, 'P');
-      Name_TSD    : constant Name_Id := New_External_Name (Tname, 'B');
-      Name_Exname : constant Name_Id := New_External_Name (Tname, 'E');
-      Name_No_Reg : constant Name_Id := New_External_Name (Tname, 'F');
-
-      DT     : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT);
-      DT_Ptr : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT_Ptr);
-      TSD    : constant Node_Id := Make_Defining_Identifier (Loc, Name_TSD);
-      Exname : constant Node_Id := Make_Defining_Identifier (Loc, Name_Exname);
-      No_Reg : constant Node_Id := Make_Defining_Identifier (Loc, Name_No_Reg);
-
-      Generalized_Tag : constant Entity_Id := RTE (RE_Tag);
-      I_Depth         : Int;
-      Size_Expr_Node  : Node_Id;
-      Old_Tag1        : Node_Id;
-      Old_Tag2        : Node_Id;
-      Num_Ifaces      : Int;
-      Nb_Prim         : Int;
-      TSD_Num_Entries : Int;
-      Typ_Copy        : constant Entity_Id := New_Copy (Typ);
-      AI              : Elmt_Id;
-
-   begin
-      if not RTE_Available (RE_Tag) then
-         Error_Msg_CRT ("tagged types", Typ);
-         return New_List;
-      end if;
-
-      --  Collect the full list of directly and indirectly implemented
-      --  interfaces
-
-      Set_Parent              (Typ_Copy, Parent (Typ));
-      Set_Abstract_Interfaces (Typ_Copy, New_Elmt_List);
-      Collect_All_Interfaces  (Typ_Copy);
-
-      --  Calculate the number of entries required in the table of interfaces
-
-      Num_Ifaces := 0;
-      AI := First_Elmt (Abstract_Interfaces (Typ_Copy));
-      while Present (AI) loop
-         Num_Ifaces := Num_Ifaces + 1;
-         Next_Elmt (AI);
-      end loop;
-
-      --  Count ancestors to compute the inheritance depth. For private
-      --  extensions, always go to the full view in order to compute the real
-      --  inheritance depth.
-
-      declare
-         Parent_Type : Entity_Id := Typ;
-         P           : Entity_Id;
-
-      begin
-         I_Depth := 0;
-         loop
-            P := Etype (Parent_Type);
-
-            if Is_Private_Type (P) then
-               P := Full_View (Base_Type (P));
-            end if;
-
-            exit when P = Parent_Type;
-
-            I_Depth := I_Depth + 1;
-            Parent_Type := P;
-         end loop;
-      end;
-
-      Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ)));
-
-      --  Ada 2005 (AI-345): The size of the TSD is increased to accomodate
-      --  the two tables used for dispatching in asynchronous, conditional
-      --  and timed selects. The tables are solely generated for limited
-      --  types that implement a limited interface.
-
-      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 Implements_Limited_Interface (Typ)
-      then
-         TSD_Num_Entries := I_Depth + Num_Ifaces + 1 +
-                              2 * (Nb_Prim - Default_Prim_Op_Count);
-      else
-         TSD_Num_Entries := I_Depth + Num_Ifaces + 1;
-      end if;
-
-      --  ----------------------------------------------------------------
-      --  Dispatch table and related entities are allocated statically
-
-      Set_Ekind (DT, E_Variable);
-      Set_Is_Statically_Allocated (DT);
-
-      Set_Ekind (DT_Ptr, E_Variable);
-      Set_Is_Statically_Allocated (DT_Ptr);
-
-      Set_Ekind (TSD, E_Variable);
-      Set_Is_Statically_Allocated (TSD);
-
-      Set_Ekind (Exname, E_Variable);
-      Set_Is_Statically_Allocated (Exname);
-
-      Set_Ekind (No_Reg, E_Variable);
-      Set_Is_Statically_Allocated (No_Reg);
-
-      --  Generate code to create the storage for the Dispatch_Table object:
-
-      --   DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
-      --   for DT'Alignment use Address'Alignment
-
-      Size_Expr_Node :=
-        Make_Op_Add (Loc,
-          Left_Opnd  => Make_DT_Access_Action (Typ, DT_Prologue_Size, No_List),
-          Right_Opnd =>
-            Make_Op_Multiply (Loc,
-              Left_Opnd  =>
-                Make_DT_Access_Action (Typ, DT_Entry_Size, No_List),
-              Right_Opnd =>
-                Make_Integer_Literal (Loc, Nb_Prim)));
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => DT,
-          Aliased_Present     => True,
-          Object_Definition   =>
-            Make_Subtype_Indication (Loc,
-              Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
-              Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
-                Constraints => New_List (
-                  Make_Range (Loc,
-                    Low_Bound  => Make_Integer_Literal (Loc, 1),
-                    High_Bound => Size_Expr_Node))))));
-
-      Append_To (Result,
-        Make_Attribute_Definition_Clause (Loc,
-          Name       => New_Reference_To (DT, Loc),
-          Chars      => Name_Alignment,
-          Expression =>
-            Make_Attribute_Reference (Loc,
-              Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
-              Attribute_Name => Name_Alignment)));
-
-      --  Generate code to create the pointer to the dispatch table
-
-      --    DT_Ptr : Tag := Tag!(DT'Address);
-
-      --  According to the C++ ABI, the base of the vtable is located after a
-      --  prologue containing Offset_To_Top, and Typeinfo_Ptr. Hence, we move
-      --  down the pointer to the real base of the vtable
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => DT_Ptr,
-          Constant_Present    => True,
-          Object_Definition   => New_Reference_To (Generalized_Tag, Loc),
-          Expression          =>
-            Unchecked_Convert_To (Generalized_Tag,
-              Make_Op_Add (Loc,
-                Left_Opnd =>
-                  Unchecked_Convert_To (RTE (RE_Storage_Offset),
-                    Make_Attribute_Reference (Loc,
-                      Prefix         => New_Reference_To (DT, Loc),
-                      Attribute_Name => Name_Address)),
-                Right_Opnd =>
-                  Make_DT_Access_Action (Typ,
-                    DT_Prologue_Size, No_List)))));
-
-      --  Generate code to define the boolean that controls registration, in
-      --  order to avoid multiple registrations for tagged types defined in
-      --  multiple-called scopes.
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => No_Reg,
-          Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
-          Expression          => New_Reference_To (Standard_True, Loc)));
-
-      --  Set Access_Disp_Table field to be the dispatch table pointer
-
-      if not Present (Access_Disp_Table (Typ)) then
-         Set_Access_Disp_Table (Typ, New_Elmt_List);
-      end if;
-
-      Prepend_Elmt (DT_Ptr, Access_Disp_Table (Typ));
-
-      --  Generate code to create the storage for the type specific data object
-      --  with enough space to store the tags of the ancestors plus the tags
-      --  of all the implemented interfaces (as described in a-tags.adb).
-      --
-      --   TSD: Storage_Array
-      --     (1..TSD_Prologue_Size+TSD_Num_Entries*TSD_Entry_Size);
-      --   for TSD'Alignment use Address'Alignment
-
-      Size_Expr_Node :=
-        Make_Op_Add (Loc,
-          Left_Opnd  =>
-            Make_DT_Access_Action (Typ, TSD_Prologue_Size, No_List),
-          Right_Opnd =>
-            Make_Op_Multiply (Loc,
-              Left_Opnd  =>
-                Make_DT_Access_Action (Typ, TSD_Entry_Size, No_List),
-              Right_Opnd =>
-                Make_Integer_Literal (Loc, TSD_Num_Entries)));
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => TSD,
-          Aliased_Present     => True,
-          Object_Definition   =>
-            Make_Subtype_Indication (Loc,
-              Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
-              Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
-                Constraints => New_List (
-                  Make_Range (Loc,
-                    Low_Bound  => Make_Integer_Literal (Loc, 1),
-                    High_Bound => Size_Expr_Node))))));
-
-      Append_To (Result,
-        Make_Attribute_Definition_Clause (Loc,
-          Name       => New_Reference_To (TSD, Loc),
-          Chars      => Name_Alignment,
-          Expression =>
-            Make_Attribute_Reference (Loc,
-              Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
-              Attribute_Name => Name_Alignment)));
-
-      --  Generate code to put the Address of the TSD in the dispatch table
-      --    Set_TSD (DT_Ptr, TSD);
-
-      Append_To (Elab_Code,
-        Make_DT_Access_Action (Typ,
-          Action => Set_TSD,
-          Args   => New_List (
-            New_Reference_To (DT_Ptr, Loc),                  -- DTptr
-              Make_Attribute_Reference (Loc,                 -- Value
-              Prefix          => New_Reference_To (TSD, Loc),
-              Attribute_Name  => Name_Address))));
-
-      --  Generate: Exname : constant String := full_qualified_name (typ);
-      --  The type itself may be an anonymous parent type, so use the first
-      --  subtype to have a user-recognizable name.
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Exname,
-          Constant_Present    => True,
-          Object_Definition   => New_Reference_To (Standard_String, Loc),
-          Expression =>
-            Make_String_Literal (Loc,
-              Full_Qualified_Name (First_Subtype (Typ)))));
-
-      --  Generate: Set_Expanded_Name (DT_Ptr, exname'Address);
-
-      Append_To (Elab_Code,
-        Make_DT_Access_Action (Typ,
-          Action => Set_Expanded_Name,
-          Args   => New_List (
-            Node1 => New_Reference_To (DT_Ptr, Loc),
-            Node2 =>
-              Make_Attribute_Reference (Loc,
-                Prefix => New_Reference_To (Exname, Loc),
-                Attribute_Name => Name_Address))));
-
-      --  Generate: Set_Access_Level (DT_Ptr, <type's accessibility level>);
-
-      Append_To (Elab_Code,
-        Make_DT_Access_Action (Typ,
-          Action => Set_Access_Level,
-          Args   => New_List (
-            Node1 => New_Reference_To (DT_Ptr, Loc),
-            Node2 => Make_Integer_Literal (Loc, Type_Access_Level (Typ)))));
-
-      --  Generate:
-      --    Set_Offset_To_Top (DT_Ptr, 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 (DT_Ptr, Loc),
-            Make_Integer_Literal (Loc, Uint_0))));
-
-      if Typ = Etype (Typ)
-        or else Is_CPP_Class (Etype (Typ))
-      then
-         Old_Tag1 :=
-           Unchecked_Convert_To (Generalized_Tag,
-             Make_Integer_Literal (Loc, 0));
-         Old_Tag2 :=
-           Unchecked_Convert_To (Generalized_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 Is_Interface (Etype (Typ))
-      then
-         --  Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
-
-         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)))))));
-
-         --  Inherit the secondary dispatch tables of the ancestor
-
-         if not Is_CPP_Class (Etype (Typ)) then
-            declare
-               Sec_DT_Ancestor : Elmt_Id :=
-                                   Next_Elmt
-                                     (First_Elmt
-                                        (Access_Disp_Table (Etype (Typ))));
-               Sec_DT_Typ      : Elmt_Id :=
-                                   Next_Elmt
-                                     (First_Elmt
-                                        (Access_Disp_Table (Typ)));
-
-               procedure Copy_Secondary_DTs (Typ : Entity_Id);
-               --  Local procedure required to climb through the ancestors and
-               --  copy the contents of all their secondary dispatch tables.
-
-               ------------------------
-               -- Copy_Secondary_DTs --
-               ------------------------
-
-               procedure Copy_Secondary_DTs (Typ : Entity_Id) is
-                  E : Entity_Id;
-
-               begin
-                  if Etype (Typ) /= Typ then
-                     Copy_Secondary_DTs (Etype (Typ));
-                  end if;
-
-                  if Present (Abstract_Interfaces (Typ))
-                    and then not Is_Empty_Elmt_List
-                                   (Abstract_Interfaces (Typ))
-                  then
-                     E := First_Entity (Typ);
-                     while Present (E)
-                       and then Present (Node (Sec_DT_Ancestor))
-                     loop
-                        if Is_Tag (E) and then Chars (E) /= Name_uTag then
-                           Append_To (Elab_Code,
-                             Make_DT_Access_Action (Typ,
-                               Action => Inherit_DT,
-                               Args   => New_List (
-                                 Node1 => Unchecked_Convert_To
-                                            (RTE (RE_Tag),
-                                             New_Reference_To
-                                               (Node (Sec_DT_Ancestor), Loc)),
-                                 Node2 => Unchecked_Convert_To
-                                            (RTE (RE_Tag),
-                                             New_Reference_To
-                                               (Node (Sec_DT_Typ), Loc)),
-                                 Node3 => Make_Integer_Literal (Loc,
-                                            DT_Entry_Count (E)))));
-
-                           Next_Elmt (Sec_DT_Ancestor);
-                           Next_Elmt (Sec_DT_Typ);
-                        end if;
-
-                        Next_Entity (E);
-                     end loop;
-                  end if;
-               end Copy_Secondary_DTs;
-
-            begin
-               if Present (Node (Sec_DT_Ancestor)) then
-                  Copy_Secondary_DTs (Typ);
-               end if;
-            end;
-         end if;
-      end if;
-
-      --  Generate:
-      --    Inherit_TSD (parent'tag, DT_Ptr);
-
-      Append_To (Elab_Code,
-        Make_DT_Access_Action (Typ,
-          Action => Inherit_TSD,
-          Args   => New_List (
-            Node1 => Old_Tag2,
-            Node2 => New_Reference_To (DT_Ptr, Loc))));
-
-      --  For types with no controlled components, generate:
-      --    Set_RC_Offset (DT_Ptr, 0);
-
-      --  For simple types with controlled components, generate:
-      --    Set_RC_Offset (DT_Ptr, type._record_controller'position);
-
-      --  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.
-
-      declare
-         Position : Node_Id;
-
-      begin
-         if not Has_Controlled_Component (Typ) then
-            Position := Make_Integer_Literal (Loc, 0);
-
-         elsif Etype (Typ) /= Typ and then Has_Discriminants (Etype (Typ)) then
-            if Has_New_Controlled_Component (Typ) then
-               Position := Make_Integer_Literal (Loc, -1);
-            else
-               Position := Make_Integer_Literal (Loc, -2);
-            end if;
-         else
-            Position :=
-              Make_Attribute_Reference (Loc,
-                Prefix =>
-                  Make_Selected_Component (Loc,
-                    Prefix => New_Reference_To (Typ, Loc),
-                    Selector_Name =>
-                      New_Reference_To (Controller_Component (Typ), Loc)),
-                Attribute_Name => Name_Position);
-
-            --  This is not proper Ada code to use the attribute 'Position
-            --  on something else than an object but this is supported by
-            --  the back end (see comment on the Bit_Component attribute in
-            --  sem_attr). So we avoid semantic checking here.
-
-            --  Is this documented in sinfo.ads??? it should be!
-
-            Set_Analyzed (Position);
-            Set_Etype (Prefix (Position), RTE (RE_Record_Controller));
-            Set_Etype (Prefix (Prefix (Position)), Typ);
-            Set_Etype (Selector_Name (Prefix (Position)),
-              RTE (RE_Record_Controller));
-            Set_Etype (Position, RTE (RE_Storage_Offset));
-         end if;
-
-         Append_To (Elab_Code,
-           Make_DT_Access_Action (Typ,
-             Action => Set_RC_Offset,
-             Args   => New_List (
-               Node1 => New_Reference_To (DT_Ptr, Loc),
-               Node2 => Position)));
-      end;
-
-      --  Generate: Set_Remotely_Callable (DT_Ptr, Status); where Status is
-      --  described in E.4 (18)
-
-      declare
-         Status : Entity_Id;
-
-      begin
-         Status :=
-           Boolean_Literals
-             (Is_Pure (Typ)
-                or else Is_Shared_Passive (Typ)
-                or else
-                  ((Is_Remote_Types (Typ)
-                      or else Is_Remote_Call_Interface (Typ))
-                   and then Original_View_In_Visible_Part (Typ))
-                or else not Comes_From_Source (Typ));
-
-         Append_To (Elab_Code,
-           Make_DT_Access_Action (Typ,
-             Action => Set_Remotely_Callable,
-             Args   => New_List (
-               New_Occurrence_Of (DT_Ptr, Loc),
-               New_Occurrence_Of (Status, Loc))));
-      end;
-
-      --  Generate: Set_External_Tag (DT_Ptr, exname'Address);
-      --  Should be the external name not the qualified name???
-
-      if not Has_External_Tag_Rep_Clause (Typ) then
-         Append_To (Elab_Code,
-           Make_DT_Access_Action (Typ,
-             Action => Set_External_Tag,
-             Args   => New_List (
-               Node1 => New_Reference_To (DT_Ptr, Loc),
-               Node2 =>
-                 Make_Attribute_Reference (Loc,
-                   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.
-
-      --        Register_Tag (Dt_Ptr);
-
-      --  Skip this if routine not available, or in No_Run_Time mode
-
-         if RTE_Available (RE_Register_Tag)
-           and then Is_RTE (Generalized_Tag, RE_Tag)
-           and then not No_Run_Time_Mode
-         then
-            Append_To (Elab_Code,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Reference_To (RTE (RE_Register_Tag), Loc),
-                Parameter_Associations =>
-                  New_List (New_Reference_To (DT_Ptr, Loc))));
-         end if;
-      end if;
-
-      --  Generate:
-      --     if No_Reg then
-      --        <elab_code>
-      --        No_Reg := False;
-      --     end if;
-
-      Append_To (Elab_Code,
-        Make_Assignment_Statement (Loc,
-          Name       => New_Reference_To (No_Reg, Loc),
-          Expression => New_Reference_To (Standard_False, Loc)));
-
-      Append_To (Result,
-        Make_Implicit_If_Statement (Typ,
-          Condition       => New_Reference_To (No_Reg, Loc),
-          Then_Statements => Elab_Code));
-
-      --  Ada 2005 (AI-251): Register the tag of the interfaces into
-      --  the table of implemented interfaces
-
-      if Present (Abstract_Interfaces (Typ_Copy))
-        and then not Is_Empty_Elmt_List (Abstract_Interfaces (Typ_Copy))
-      then
-         AI := First_Elmt (Abstract_Interfaces (Typ_Copy));
-         while Present (AI) loop
-
-            --  Generate:
-            --    Register_Interface (DT_Ptr, Interface'Tag);
-
-            Append_To (Result,
-              Make_DT_Access_Action (Typ,
-                Action => Register_Interface_Tag,
-                Args   => New_List (
-                  Node1 => New_Reference_To (DT_Ptr, Loc),
-                  Node2 => New_Reference_To
-                             (Node
-                              (First_Elmt
-                               (Access_Disp_Table (Node (AI)))),
-                              Loc))));
-
-            Next_Elmt (AI);
-         end loop;
-      end if;
-
-      return Result;
-   end Make_DT;
-
-   --------------------------------
-   -- Make_Abstract_Interface_DT --
-   --------------------------------
-
-   procedure Make_Abstract_Interface_DT
-     (AI_Tag          : Entity_Id;
-      Acc_Disp_Tables : in out Elist_Id;
-      Result          : out List_Id)
-   is
-      Loc         : constant Source_Ptr := Sloc (AI_Tag);
-      Name_DT     : constant Name_Id := New_Internal_Name ('T');
-      Name_DT_Ptr : constant Name_Id := New_Internal_Name ('P');
-
-      Iface_DT     : constant Node_Id :=
-                       Make_Defining_Identifier (Loc, Name_DT);
-      Iface_DT_Ptr : constant Node_Id :=
-                       Make_Defining_Identifier (Loc, Name_DT_Ptr);
-
-      Generalized_Tag : constant Entity_Id := RTE (RE_Interface_Tag);
-      Size_Expr_Node  : Node_Id;
-      Nb_Prim         : Int;
-
-   begin
-      Result := New_List;
-
-      --  Dispatch table and related entities are allocated statically
-
-      Set_Ekind (Iface_DT, E_Variable);
-      Set_Is_Statically_Allocated (Iface_DT);
-
-      Set_Ekind (Iface_DT_Ptr, E_Variable);
-      Set_Is_Statically_Allocated (Iface_DT_Ptr);
-
-      --  Generate code to create the storage for the Dispatch_Table object
-
-      --    DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
-      --    for DT'Alignment use Address'Alignment
-
-      Nb_Prim := UI_To_Int (DT_Entry_Count (AI_Tag));
-
-      Size_Expr_Node :=
-        Make_Op_Add (Loc,
-          Left_Opnd  => Make_DT_Access_Action (Etype (AI_Tag),
-                          DT_Prologue_Size,
-                          No_List),
-          Right_Opnd =>
-            Make_Op_Multiply (Loc,
-              Left_Opnd  =>
-                Make_DT_Access_Action (Etype (AI_Tag),
-                                       DT_Entry_Size,
-                                       No_List),
-              Right_Opnd =>
-                Make_Integer_Literal (Loc, Nb_Prim)));
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Iface_DT,
-          Aliased_Present     => True,
-          Object_Definition   =>
-            Make_Subtype_Indication (Loc,
-              Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
-              Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
-                Constraints => New_List (
-                  Make_Range (Loc,
-                    Low_Bound  => Make_Integer_Literal (Loc, 1),
-                    High_Bound => Size_Expr_Node)))),
-
-            --  Initialize the signature of the interface tag. It is currently
-            --  a sequence of four bytes located in the unused Typeinfo_Ptr
-            --  field of the prologue). Its current value is the following
-            --  sequence: (80, Nb_Prim, 0, 80)
-
-          Expression =>
-            Make_Aggregate (Loc,
-              Component_Associations => New_List (
-                Make_Component_Association (Loc,
-
-                  --  -80, 0, 0, -80
-
-                  Choices => New_List (
-                    Make_Integer_Literal (Loc, Uint_5),
-                    Make_Integer_Literal (Loc, Uint_8)),
-                  Expression =>
-                    Make_Integer_Literal (Loc, Uint_80)),
-
-                Make_Component_Association (Loc,
-                  Choices => New_List (
-                    Make_Integer_Literal (Loc, Uint_2)),
-                  Expression =>
-                    Make_Integer_Literal (Loc, Nb_Prim)),
-
-                Make_Component_Association (Loc,
-                  Choices => New_List (
-                    Make_Others_Choice (Loc)),
-                  Expression => Make_Integer_Literal (Loc, Uint_0))))));
-
-      Append_To (Result,
-        Make_Attribute_Definition_Clause (Loc,
-          Name       => New_Reference_To (Iface_DT, Loc),
-          Chars      => Name_Alignment,
-          Expression =>
-            Make_Attribute_Reference (Loc,
-              Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
-              Attribute_Name => Name_Alignment)));
-
-      --  Generate code to create the pointer to the dispatch table
-
-      --    Iface_DT_Ptr : Tag := Tag!(DT'Address);
-
-      --  According to the C++ ABI, the base of the vtable is located
-      --  after the following prologue: Offset_To_Top, and Typeinfo_Ptr.
-      --  Hence, move the pointer down to the real base of the vtable.
-
-      Append_To (Result,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Iface_DT_Ptr,
-          Constant_Present    => True,
-          Object_Definition   => New_Reference_To (Generalized_Tag, Loc),
-          Expression          =>
-            Unchecked_Convert_To (Generalized_Tag,
-              Make_Op_Add (Loc,
-                Left_Opnd =>
-                  Unchecked_Convert_To (RTE (RE_Storage_Offset),
-                    Make_Attribute_Reference (Loc,
-                      Prefix         => New_Reference_To (Iface_DT, Loc),
-                      Attribute_Name => Name_Address)),
-                Right_Opnd =>
-                  Make_DT_Access_Action (Etype (AI_Tag),
-                    DT_Prologue_Size, No_List)))));
-
-      --  Note: Offset_To_Top will be initialized by the init subprogram
-
-      --  Set Access_Disp_Table field to be the dispatch table pointer
-
-      if not (Present (Acc_Disp_Tables)) then
-         Acc_Disp_Tables := New_Elmt_List;
-      end if;
-
-      Append_Elmt (Iface_DT_Ptr, Acc_Disp_Tables);
-   end Make_Abstract_Interface_DT;
-
-   ---------------------------
-   -- Make_DT_Access_Action --
-   ---------------------------
-
-   function Make_DT_Access_Action
-     (Typ    : Entity_Id;
-      Action : DT_Access_Action;
-      Args   : List_Id) return Node_Id
-   is
-      Action_Name : constant Entity_Id := RTE (Ada_Actions (Action));
-      Loc         : Source_Ptr;
-
-   begin
-      if No (Args) then
-
-         --  This is a constant
-
-         return New_Reference_To (Action_Name, Sloc (Typ));
-      end if;
-
-      pragma Assert (List_Length (Args) = Action_Nb_Arg (Action));
-
-      Loc := Sloc (First (Args));
-
-      if Action_Is_Proc (Action) then
-         return
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (Action_Name, Loc),
-             Parameter_Associations => Args);
-
-      else
-         return
-           Make_Function_Call (Loc,
-             Name => New_Reference_To (Action_Name, Loc),
-             Parameter_Associations => Args);
-      end if;
-   end Make_DT_Access_Action;
-
    ----------------------------------------
    -- Make_Disp_Asynchronous_Select_Body --
    ----------------------------------------
@@ -2464,27 +1719,30 @@ package body Exp_Disp is
    function Make_Disp_Asynchronous_Select_Body
      (Typ : Entity_Id) return Node_Id
    is
-      Conc_Typ   : Entity_Id           := Empty;
-      Decls      : constant List_Id    := New_List;
-      DT_Ptr     : Entity_Id;
-      DT_Ptr_Typ : Entity_Id;
-      Loc        : constant Source_Ptr := Sloc (Typ);
-      Stmts      : constant List_Id    := New_List;
+      Conc_Typ : Entity_Id           := Empty;
+      Decls    : constant List_Id    := New_List;
+      DT_Ptr   : Entity_Id;
+      Loc      : constant Source_Ptr := Sloc (Typ);
+      Stmts    : constant List_Id    := New_List;
 
    begin
+      if Is_Interface (Typ) then
+         return
+           Make_Subprogram_Body (Loc,
+             Specification =>
+               Make_Disp_Asynchronous_Select_Spec (Typ),
+             Declarations =>
+               New_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 New_List (Make_Null_Statement (Loc))));
+      end if;
+
       if Is_Concurrent_Record_Type (Typ) then
          Conc_Typ := Corresponding_Concurrent_Type (Typ);
       end if;
 
-      --  Typ may be a derived type, climb the derivation chain in order to
-      --  find the root.
-
-      DT_Ptr_Typ := Typ;
-      while Present (Parent_Subtype (DT_Ptr_Typ)) loop
-         DT_Ptr_Typ := Parent_Subtype (DT_Ptr_Typ);
-      end loop;
-
-      DT_Ptr := Node (First_Elmt (Access_Disp_Table (DT_Ptr_Typ)));
+      DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
 
       if Present (Conc_Typ) then
 
@@ -2590,11 +1848,11 @@ package body Exp_Disp is
                     Make_Identifier (Loc, Name_uF))));    --  status flag
          end if;
 
-      --  Null implementation for limited tagged types
+      --  Implementation for limited tagged types
 
       else
          Append_To (Stmts,
-           Make_Null_Statement (Loc));
+           Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
       end if;
 
       return
@@ -2615,6 +1873,9 @@ package body Exp_Disp is
      (Typ : Entity_Id) return Node_Id
    is
       Loc    : constant Source_Ptr := Sloc (Typ);
+      Def_Id : constant Node_Id    :=
+                 Make_Defining_Identifier (Loc,
+                   Name_uDisp_Asynchronous_Select);
       Params : constant List_Id    := New_List;
 
    begin
@@ -2630,12 +1891,12 @@ package body Exp_Disp is
       SEU.Build_B (Loc, Params);
       SEU.Build_F (Loc, Params);
 
+      Set_Is_Internal (Def_Id);
+
       return
          Make_Procedure_Specification (Loc,
-           Defining_Unit_Name =>
-             Make_Defining_Identifier (Loc, Name_uDisp_Asynchronous_Select),
-           Parameter_Specifications =>
-             Params);
+           Defining_Unit_Name       => Def_Id,
+           Parameter_Specifications => Params);
    end Make_Disp_Asynchronous_Select_Spec;
 
    ---------------------------------------
@@ -2645,30 +1906,34 @@ package body Exp_Disp is
    function Make_Disp_Conditional_Select_Body
      (Typ : Entity_Id) return Node_Id
    is
-      Blk_Nam    : Entity_Id;
-      Conc_Typ   : Entity_Id         := Empty;
-      Decls      : constant List_Id  := New_List;
-      DT_Ptr     : Entity_Id;
-      DT_Ptr_Typ : Entity_Id;
-      Loc        : constant Source_Ptr := Sloc (Typ);
-      Stmts      : constant List_Id  := New_List;
+      Loc      : constant Source_Ptr := Sloc (Typ);
+      Blk_Nam  : Entity_Id;
+      Conc_Typ : Entity_Id           := Empty;
+      Decls    : constant List_Id    := New_List;
+      DT_Ptr   : Entity_Id;
+      Stmts    : constant List_Id    := New_List;
 
    begin
+      if Is_Interface (Typ) then
+         return
+           Make_Subprogram_Body (Loc,
+             Specification =>
+               Make_Disp_Conditional_Select_Spec (Typ),
+             Declarations =>
+               No_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 New_List (Make_Null_Statement (Loc))));
+      end if;
+
       if Is_Concurrent_Record_Type (Typ) then
          Conc_Typ := Corresponding_Concurrent_Type (Typ);
       end if;
 
-      --  Typ may be a derived type, climb the derivation chain in order to
-      --  find the root.
-
-      DT_Ptr_Typ := Typ;
-      while Present (Parent_Subtype (DT_Ptr_Typ)) loop
-         DT_Ptr_Typ := Parent_Subtype (DT_Ptr_Typ);
-      end loop;
-
-      DT_Ptr := Node (First_Elmt (Access_Disp_Table (DT_Ptr_Typ)));
+      DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
 
       if Present (Conc_Typ) then
+
          --  Generate:
          --    I : Integer;
 
@@ -2694,7 +1959,7 @@ package body Exp_Disp is
       --       return;
       --    end if;
 
-      SEU.Build_Common_Dispatching_Select_Statements (Loc, Typ, Stmts);
+      SEU.Build_Common_Dispatching_Select_Statements (Loc, Typ, DT_Ptr, Stmts);
 
       if Present (Conc_Typ) then
 
@@ -2716,7 +1981,7 @@ package body Exp_Disp is
          --  Generate:
          --    I := get_entry_index (tag! (<type>VP), S);
 
-         --  where I is the entry index and S is the dispatch table slot.
+         --  I is the entry index and S is the dispatch table slot
 
          Append_To (Stmts,
            Make_Assignment_Statement (Loc,
@@ -2833,11 +2098,11 @@ package body Exp_Disp is
                     Make_Identifier (Loc, Name_uF))));    --  status flag
          end if;
 
-      --  Null implementation for limited tagged types
+      --  Implementation for limited tagged types
 
       else
          Append_To (Stmts,
-           Make_Null_Statement (Loc));
+           Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
       end if;
 
       return
@@ -2858,6 +2123,9 @@ package body Exp_Disp is
      (Typ : Entity_Id) return Node_Id
    is
       Loc    : constant Source_Ptr := Sloc (Typ);
+      Def_Id : constant Node_Id    :=
+                 Make_Defining_Identifier (Loc,
+                   Name_uDisp_Conditional_Select);
       Params : constant List_Id    := New_List;
 
    begin
@@ -2873,12 +2141,12 @@ package body Exp_Disp is
       SEU.Build_C (Loc, Params);
       SEU.Build_F (Loc, Params);
 
+      Set_Is_Internal (Def_Id);
+
       return
         Make_Procedure_Specification (Loc,
-          Defining_Unit_Name =>
-            Make_Defining_Identifier (Loc, Name_uDisp_Conditional_Select),
-          Parameter_Specifications =>
-            Params);
+          Defining_Unit_Name       => Def_Id,
+          Parameter_Specifications => Params);
    end Make_Disp_Conditional_Select_Spec;
 
    -------------------------------------
@@ -2888,20 +2156,23 @@ package body Exp_Disp is
    function Make_Disp_Get_Prim_Op_Kind_Body
      (Typ : Entity_Id) return Node_Id
    is
-      Loc        : constant Source_Ptr := Sloc (Typ);
-      DT_Ptr     : Entity_Id;
-      DT_Ptr_Typ : Entity_Id;
+      Loc    : constant Source_Ptr := Sloc (Typ);
+      DT_Ptr : Entity_Id;
 
    begin
-      --  Typ may be a derived type, climb the derivation chain in order to
-      --  find the root.
-
-      DT_Ptr_Typ := Typ;
-      while Present (Parent_Subtype (DT_Ptr_Typ)) loop
-         DT_Ptr_Typ := Parent_Subtype (DT_Ptr_Typ);
-      end loop;
+      if Is_Interface (Typ) then
+         return
+           Make_Subprogram_Body (Loc,
+             Specification =>
+               Make_Disp_Get_Prim_Op_Kind_Spec (Typ),
+             Declarations =>
+               New_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 New_List (Make_Null_Statement (Loc))));
+      end if;
 
-      DT_Ptr := Node (First_Elmt (Access_Disp_Table (DT_Ptr_Typ)));
+      DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
 
       --  Generate:
       --    C := get_prim_op_kind (tag! (<type>VP), S);
@@ -2914,7 +2185,7 @@ package body Exp_Disp is
           Specification =>
             Make_Disp_Get_Prim_Op_Kind_Spec (Typ),
           Declarations =>
-            No_List,
+            New_List,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc,
               New_List (
@@ -2940,6 +2211,9 @@ package body Exp_Disp is
      (Typ : Entity_Id) return Node_Id
    is
       Loc    : constant Source_Ptr := Sloc (Typ);
+      Def_Id : constant Node_Id    :=
+                 Make_Defining_Identifier (Loc,
+                   Name_uDisp_Get_Prim_Op_Kind);
       Params : constant List_Id    := New_List;
 
    begin
@@ -2951,109 +2225,84 @@ package body Exp_Disp is
       SEU.Build_S (Loc, Params);
       SEU.Build_C (Loc, Params);
 
+      Set_Is_Internal (Def_Id);
+
       return
         Make_Procedure_Specification (Loc,
-           Defining_Unit_Name =>
-             Make_Defining_Identifier (Loc, Name_uDisp_Get_Prim_Op_Kind),
-           Parameter_Specifications =>
-             Params);
+           Defining_Unit_Name       => Def_Id,
+           Parameter_Specifications => Params);
    end Make_Disp_Get_Prim_Op_Kind_Spec;
 
-   -----------------------------
-   -- Make_Disp_Select_Tables --
-   -----------------------------
+   --------------------------------
+   -- Make_Disp_Get_Task_Id_Body --
+   --------------------------------
 
-   function Make_Disp_Select_Tables
-     (Typ : Entity_Id) return List_Id
+   function Make_Disp_Get_Task_Id_Body
+     (Typ : Entity_Id) return Node_Id
    is
-      Assignments : constant List_Id    := New_List;
-      DT_Ptr      : Entity_Id;
-      DT_Ptr_Typ  : Entity_Id;
-      Index       : Uint                := Uint_1;
-      Loc         : constant Source_Ptr := Sloc (Typ);
-      Prim        : Entity_Id;
-      Prim_Als    : Entity_Id;
-      Prim_Elmt   : Elmt_Id;
-      Prim_Pos    : Uint;
+      Loc : constant Source_Ptr := Sloc (Typ);
+      Ret : Node_Id;
 
    begin
-      pragma Assert (Present (Primitive_Operations (Typ)));
-
-      --  Typ may be a derived type, climb the derivation chain in order to
-      --  find the root.
-
-      DT_Ptr_Typ := Typ;
-      while Present (Parent_Subtype (DT_Ptr_Typ)) loop
-         DT_Ptr_Typ := Parent_Subtype (DT_Ptr_Typ);
-      end loop;
-
-      DT_Ptr := Node (First_Elmt (Access_Disp_Table (DT_Ptr_Typ)));
-
-      Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
-      while Present (Prim_Elmt) loop
-         Prim := Node (Prim_Elmt);
-
-         --  Retrieve the root of the alias chain
-
-         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;
-
-         --  We either have a procedure or a wrapper. Set the primitive
-         --  operation kind for both cases and set the entry index for
-         --  wrappers.
-
-         if Ekind (Prim) = E_Procedure
-           and then Present (Prim_Als)
-           and then Is_Primitive_Wrapper (Prim_Als)
-         then
-            Prim_Pos := DT_Position (Prim);
-
-            --  Generate:
-            --    set_prim_op_kind (<tag>, <position>, <kind>);
+      if Is_Concurrent_Record_Type (Typ)
+        and then Ekind (Corresponding_Concurrent_Type (Typ)) = E_Task_Type
+      then
+         Ret :=
+           Make_Return_Statement (Loc,
+             Expression =>
+               Make_Selected_Component (Loc,
+                 Prefix =>
+                   Make_Identifier (Loc, Name_uT),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Name_uTask_Id)));
 
-            Append_To (Assignments,
-              Make_DT_Access_Action (Typ,
-                Action =>
-                  Set_Prim_Op_Kind,
-                Args =>
-                  New_List (
-                    Unchecked_Convert_To (RTE (RE_Tag),
-                      New_Reference_To (DT_Ptr, Loc)),
-                    Make_Integer_Literal (Loc, Prim_Pos),
-                    Prim_Op_Kind (Prim, Typ))));
+      --  A null body is constructed for non-task types
 
-            --  The wrapped entity of the alias is an entry
+      else
+         Ret :=
+           Make_Return_Statement (Loc,
+             Expression =>
+               New_Reference_To (RTE (RO_ST_Null_Task), Loc));
+      end if;
 
-            if Ekind (Wrapped_Entity (Prim_Als)) = E_Entry then
-               --  Generate:
-               --    set_entry_index (<tag>, <position>, <index>);
+      return
+        Make_Subprogram_Body (Loc,
+          Specification =>
+            Make_Disp_Get_Task_Id_Spec (Typ),
+          Declarations =>
+            New_List,
+          Handled_Statement_Sequence =>
+            Make_Handled_Sequence_Of_Statements (Loc,
+              New_List (Ret)));
+   end Make_Disp_Get_Task_Id_Body;
 
-               Append_To (Assignments,
-                 Make_DT_Access_Action (Typ,
-                   Action =>
-                     Set_Entry_Index,
-                   Args =>
-                     New_List (
-                       Unchecked_Convert_To (RTE (RE_Tag),
-                         New_Reference_To (DT_Ptr, Loc)),
-                       Make_Integer_Literal (Loc, Prim_Pos),
-                       Make_Integer_Literal (Loc, Index))));
+   --------------------------------
+   -- Make_Disp_Get_Task_Id_Spec --
+   --------------------------------
 
-               Index := Index + 1;
-            end if;
-         end if;
+   function Make_Disp_Get_Task_Id_Spec
+     (Typ : Entity_Id) return Node_Id
+   is
+      Loc    : constant Source_Ptr := Sloc (Typ);
+      Def_Id : constant Node_Id    :=
+                 Make_Defining_Identifier (Loc,
+                   Name_uDisp_Get_Task_Id);
 
-         Next_Elmt (Prim_Elmt);
-      end loop;
+   begin
+      Set_Is_Internal (Def_Id);
 
-      return Assignments;
-   end Make_Disp_Select_Tables;
+      return
+        Make_Function_Specification (Loc,
+          Defining_Unit_Name       => Def_Id,
+          Parameter_Specifications => New_List (
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uT),
+              Parameter_Type =>
+                New_Reference_To (Typ, Loc))),
+          Result_Definition =>
+            New_Reference_To (RTE (RO_ST_Task_Id), Loc));
+   end Make_Disp_Get_Task_Id_Spec;
 
    ---------------------------------
    -- Make_Disp_Timed_Select_Body --
@@ -3062,27 +2311,30 @@ package body Exp_Disp is
    function Make_Disp_Timed_Select_Body
      (Typ : Entity_Id) return Node_Id
    is
-      Loc        : constant Source_Ptr   := Sloc (Typ);
-      Conc_Typ   : Entity_Id             := Empty;
-      Decls      : constant List_Id      := New_List;
-      DT_Ptr     : Entity_Id;
-      DT_Ptr_Typ : Entity_Id;
-      Stmts      : constant List_Id      := New_List;
+      Loc      : constant Source_Ptr := Sloc (Typ);
+      Conc_Typ : Entity_Id           := Empty;
+      Decls    : constant List_Id    := New_List;
+      DT_Ptr   : Entity_Id;
+      Stmts    : constant List_Id    := New_List;
 
    begin
+      if Is_Interface (Typ) then
+         return
+           Make_Subprogram_Body (Loc,
+             Specification =>
+               Make_Disp_Timed_Select_Spec (Typ),
+             Declarations =>
+               New_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 New_List (Make_Null_Statement (Loc))));
+      end if;
+
       if Is_Concurrent_Record_Type (Typ) then
          Conc_Typ := Corresponding_Concurrent_Type (Typ);
       end if;
 
-      --  Typ may be a derived type, climb the derivation chain in order to
-      --  find the root.
-
-      DT_Ptr_Typ := Typ;
-      while Present (Parent_Subtype (DT_Ptr_Typ)) loop
-         DT_Ptr_Typ := Parent_Subtype (DT_Ptr_Typ);
-      end loop;
-
-      DT_Ptr := Node (First_Elmt (Access_Disp_Table (DT_Ptr_Typ)));
+      DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
 
       if Present (Conc_Typ) then
 
@@ -3111,14 +2363,14 @@ package body Exp_Disp is
       --       return;
       --    end if;
 
-      SEU.Build_Common_Dispatching_Select_Statements (Loc, Typ, Stmts);
+      SEU.Build_Common_Dispatching_Select_Statements (Loc, Typ, DT_Ptr, Stmts);
 
       if Present (Conc_Typ) then
 
          --  Generate:
          --    I := get_entry_index (tag! (<type>VP), S);
 
-         --  where I is the entry index and S is the dispatch table slot.
+         --  I is the entry index and S is the dispatch table slot
 
          Append_To (Stmts,
            Make_Assignment_Statement (Loc,
@@ -3218,11 +2470,11 @@ package body Exp_Disp is
                     Make_Identifier (Loc, Name_uF))));    --  status flag
          end if;
 
-      --  Null implementation for limited tagged types
+      --  Implementation for limited tagged types
 
       else
          Append_To (Stmts,
-           Make_Null_Statement (Loc));
+           Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
       end if;
 
       return
@@ -3243,6 +2495,9 @@ package body Exp_Disp is
      (Typ : Entity_Id) return Node_Id
    is
       Loc    : constant Source_Ptr := Sloc (Typ);
+      Def_Id : constant Node_Id    :=
+                 Make_Defining_Identifier (Loc,
+                   Name_uDisp_Timed_Select);
       Params : constant List_Id    := New_List;
 
    begin
@@ -3275,14 +2530,1189 @@ package body Exp_Disp is
       SEU.Build_C (Loc, Params);
       SEU.Build_F (Loc, Params);
 
+      Set_Is_Internal (Def_Id);
+
       return
         Make_Procedure_Specification (Loc,
-          Defining_Unit_Name =>
-            Make_Defining_Identifier (Loc, Name_uDisp_Timed_Select),
-          Parameter_Specifications =>
-            Params);
+          Defining_Unit_Name       => Def_Id,
+          Parameter_Specifications => Params);
    end Make_Disp_Timed_Select_Spec;
 
+   -------------
+   -- Make_DT --
+   -------------
+
+   function Make_DT (Typ : Entity_Id) return List_Id is
+      Loc         : constant Source_Ptr := Sloc (Typ);
+      Result      : constant List_Id    := New_List;
+      Elab_Code   : constant List_Id    := New_List;
+
+      Tname       : constant Name_Id := Chars (Typ);
+      Name_DT     : constant Name_Id := New_External_Name (Tname, 'T');
+      Name_DT_Ptr : constant Name_Id := New_External_Name (Tname, 'P');
+      Name_SSD    : constant Name_Id := New_External_Name (Tname, 'S');
+      Name_TSD    : constant Name_Id := New_External_Name (Tname, 'B');
+      Name_Exname : constant Name_Id := New_External_Name (Tname, 'E');
+      Name_No_Reg : constant Name_Id := New_External_Name (Tname, 'F');
+
+      DT     : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT);
+      DT_Ptr : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT_Ptr);
+      SSD    : constant Node_Id := Make_Defining_Identifier (Loc, Name_SSD);
+      TSD    : constant Node_Id := Make_Defining_Identifier (Loc, Name_TSD);
+      Exname : constant Node_Id := Make_Defining_Identifier (Loc, Name_Exname);
+      No_Reg : constant Node_Id := Make_Defining_Identifier (Loc, Name_No_Reg);
+
+      Generalized_Tag : constant Entity_Id := RTE (RE_Tag);
+      I_Depth         : Int;
+      Size_Expr_Node  : Node_Id;
+      Old_Tag1        : Node_Id;
+      Old_Tag2        : Node_Id;
+      Num_Ifaces      : Int;
+      Nb_Prim         : Int;
+      TSD_Num_Entries : Int;
+      Typ_Copy        : constant Entity_Id := New_Copy (Typ);
+      AI              : Elmt_Id;
+
+   begin
+      if not RTE_Available (RE_Tag) then
+         Error_Msg_CRT ("tagged types", Typ);
+         return New_List;
+      end if;
+
+      --  Collect full list of directly and indirectly implemented interfaces
+
+      Set_Parent              (Typ_Copy, Parent (Typ));
+      Set_Abstract_Interfaces (Typ_Copy, New_Elmt_List);
+      Collect_All_Interfaces  (Typ_Copy);
+
+      --  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 is the tag of this abstract interface
+         --  type.
+
+         Nb_Prim         := 1;
+         TSD_Num_Entries := 0;
+
+      else
+         --  Calculate the number of entries for the table of interfaces
+
+         Num_Ifaces := 0;
+         AI := First_Elmt (Abstract_Interfaces (Typ_Copy));
+         while Present (AI) loop
+            Num_Ifaces := Num_Ifaces + 1;
+            Next_Elmt (AI);
+         end loop;
+
+         --  Count ancestors to compute the inheritance depth. For private
+         --  extensions, always go to the full view in order to compute the
+         --  real inheritance depth.
+
+         declare
+            Parent_Type : Entity_Id := Typ;
+            P           : Entity_Id;
+
+         begin
+            I_Depth := 0;
+            loop
+               P := Etype (Parent_Type);
+
+               if Is_Private_Type (P) then
+                  P := Full_View (Base_Type (P));
+               end if;
+
+               exit when P = Parent_Type;
+
+               I_Depth := I_Depth + 1;
+               Parent_Type := P;
+            end loop;
+         end;
+
+         TSD_Num_Entries := I_Depth + Num_Ifaces + 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 Nb_Prim < Default_Prim_Op_Count then
+            Nb_Prim := Default_Prim_Op_Count;
+         end if;
+      end if;
+
+      --  Dispatch table and related entities are allocated statically
+
+      Set_Ekind (DT, E_Variable);
+      Set_Is_Statically_Allocated (DT);
+
+      Set_Ekind (DT_Ptr, E_Variable);
+      Set_Is_Statically_Allocated (DT_Ptr);
+
+      Set_Ekind (SSD, E_Variable);
+      Set_Is_Statically_Allocated (SSD);
+
+      Set_Ekind (TSD, E_Variable);
+      Set_Is_Statically_Allocated (TSD);
+
+      Set_Ekind (Exname, E_Variable);
+      Set_Is_Statically_Allocated (Exname);
+
+      Set_Ekind (No_Reg, E_Variable);
+      Set_Is_Statically_Allocated (No_Reg);
+
+      --  Generate code to create the storage for the Dispatch_Table object:
+
+      --   DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
+      --   for DT'Alignment use Address'Alignment
+
+      Size_Expr_Node :=
+        Make_Op_Add (Loc,
+          Left_Opnd  => Make_DT_Access_Action (Typ, DT_Prologue_Size, No_List),
+          Right_Opnd =>
+            Make_Op_Multiply (Loc,
+              Left_Opnd  =>
+                Make_DT_Access_Action (Typ, DT_Entry_Size, No_List),
+              Right_Opnd =>
+                Make_Integer_Literal (Loc, Nb_Prim)));
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => DT,
+          Aliased_Present     => True,
+          Object_Definition   =>
+            Make_Subtype_Indication (Loc,
+              Subtype_Mark => New_Reference_To
+                                (RTE (RE_Storage_Array), Loc),
+              Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
+                Constraints => New_List (
+                  Make_Range (Loc,
+                    Low_Bound  => Make_Integer_Literal (Loc, 1),
+                    High_Bound => Size_Expr_Node))))));
+
+      Append_To (Result,
+        Make_Attribute_Definition_Clause (Loc,
+          Name       => New_Reference_To (DT, Loc),
+          Chars      => Name_Alignment,
+          Expression =>
+            Make_Attribute_Reference (Loc,
+              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);
+
+      --  According to the C++ ABI, the base of the vtable is located after a
+      --  prologue containing Offset_To_Top, and Typeinfo_Ptr. Hence, we move
+      --  down the pointer to the real base of the vtable
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => DT_Ptr,
+          Constant_Present    => True,
+          Object_Definition   => New_Reference_To (Generalized_Tag, Loc),
+          Expression          =>
+            Unchecked_Convert_To (Generalized_Tag,
+              Make_Op_Add (Loc,
+                Left_Opnd =>
+                  Unchecked_Convert_To (RTE (RE_Storage_Offset),
+                    Make_Attribute_Reference (Loc,
+                      Prefix         => New_Reference_To (DT, Loc),
+                      Attribute_Name => Name_Address)),
+                Right_Opnd =>
+                  Make_DT_Access_Action (Typ,
+                    DT_Prologue_Size, No_List)))));
+
+      --  Generate code to define the boolean that controls registration, in
+      --  order to avoid multiple registrations for tagged types defined in
+      --  multiple-called scopes.
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => No_Reg,
+          Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
+          Expression          => New_Reference_To (Standard_True, Loc)));
+
+      --  Set Access_Disp_Table field to be the dispatch table pointer
+
+      if not Present (Access_Disp_Table (Typ)) then
+         Set_Access_Disp_Table (Typ, New_Elmt_List);
+      end if;
+
+      Prepend_Elmt (DT_Ptr, Access_Disp_Table (Typ));
+
+      --  Generate code to create the storage for the type specific data object
+      --  with enough space to store the tags of the ancestors plus the tags
+      --  of all the implemented interfaces (as described in a-tags.adb).
+
+      --   TSD: Storage_Array
+      --     (1..TSD_Prologue_Size+TSD_Num_Entries*TSD_Entry_Size);
+      --   for TSD'Alignment use Address'Alignment
+
+      Size_Expr_Node :=
+        Make_Op_Add (Loc,
+          Left_Opnd  =>
+            Make_DT_Access_Action (Typ, TSD_Prologue_Size, No_List),
+          Right_Opnd =>
+            Make_Op_Multiply (Loc,
+              Left_Opnd  =>
+                Make_DT_Access_Action (Typ, TSD_Entry_Size, No_List),
+              Right_Opnd =>
+                Make_Integer_Literal (Loc, TSD_Num_Entries)));
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => TSD,
+          Aliased_Present     => True,
+          Object_Definition   =>
+            Make_Subtype_Indication (Loc,
+              Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
+              Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
+                Constraints => New_List (
+                  Make_Range (Loc,
+                    Low_Bound  => Make_Integer_Literal (Loc, 1),
+                    High_Bound => Size_Expr_Node))))));
+
+      Append_To (Result,
+        Make_Attribute_Definition_Clause (Loc,
+          Name       => New_Reference_To (TSD, Loc),
+          Chars      => Name_Alignment,
+          Expression =>
+            Make_Attribute_Reference (Loc,
+              Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
+              Attribute_Name => Name_Alignment)));
+
+      --  Generate code to put the Address of the TSD in the dispatch table
+      --    Set_TSD (DT_Ptr, TSD);
+
+      Append_To (Elab_Code,
+        Make_DT_Access_Action (Typ,
+          Action => Set_TSD,
+          Args   => New_List (
+            New_Reference_To (DT_Ptr, Loc),                  -- DTptr
+              Make_Attribute_Reference (Loc,                 -- Value
+                Prefix          => New_Reference_To (TSD, Loc),
+                Attribute_Name  => Name_Address))));
+
+      --  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)
+        and then Implements_Interface (
+          Typ  => Typ,
+          Kind => Any_Limited_Interface,
+          Check_Parent => True)
+        and then (Nb_Prim - Default_Prim_Op_Count) > 0
+      then
+         --  Generate the Select Specific Data table for tagged types that
+         --  implement a synchronized interface. The size of the table is
+         --  constrained by the number of non-predefined primitive operations.
+
+         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
+
+         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;
+
+      --  Generate: Exname : constant String := full_qualified_name (typ);
+      --  The type itself may be an anonymous parent type, so use the first
+      --  subtype to have a user-recognizable name.
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Exname,
+          Constant_Present    => True,
+          Object_Definition   => New_Reference_To (Standard_String, Loc),
+          Expression =>
+            Make_String_Literal (Loc,
+              Full_Qualified_Name (First_Subtype (Typ)))));
+
+      --  Generate: Set_Expanded_Name (DT_Ptr, exname'Address);
+
+      Append_To (Elab_Code,
+        Make_DT_Access_Action (Typ,
+          Action => Set_Expanded_Name,
+          Args   => New_List (
+            Node1 => New_Reference_To (DT_Ptr, Loc),
+            Node2 =>
+              Make_Attribute_Reference (Loc,
+                Prefix => New_Reference_To (Exname, Loc),
+                Attribute_Name => Name_Address))));
+
+      if not Is_Interface (Typ) then
+         --  Generate: Set_Access_Level (DT_Ptr, <type's accessibility level>);
+
+         Append_To (Elab_Code,
+           Make_DT_Access_Action (Typ,
+             Action => Set_Access_Level,
+             Args   => New_List (
+               Node1 => New_Reference_To (DT_Ptr, Loc),
+               Node2 => Make_Integer_Literal (Loc, Type_Access_Level (Typ)))));
+      end if;
+
+      if Typ = Etype (Typ)
+        or else Is_CPP_Class (Etype (Typ))
+        or else Is_Interface (Typ)
+      then
+         Old_Tag1 :=
+           Unchecked_Convert_To (Generalized_Tag,
+             Make_Integer_Literal (Loc, 0));
+         Old_Tag2 :=
+           Unchecked_Convert_To (Generalized_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)
+      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)))))));
+         end if;
+
+         --  Inherit the secondary dispatch tables of the ancestor
+
+         if not Is_CPP_Class (Etype (Typ)) then
+            declare
+               Sec_DT_Ancestor : Elmt_Id :=
+                                   Next_Elmt
+                                     (First_Elmt
+                                        (Access_Disp_Table (Etype (Typ))));
+               Sec_DT_Typ      : Elmt_Id :=
+                                   Next_Elmt
+                                     (First_Elmt
+                                        (Access_Disp_Table (Typ)));
+
+               procedure Copy_Secondary_DTs (Typ : Entity_Id);
+               --  Local procedure required to climb through the ancestors and
+               --  copy the contents of all their secondary dispatch tables.
+
+               ------------------------
+               -- Copy_Secondary_DTs --
+               ------------------------
+
+               procedure Copy_Secondary_DTs (Typ : Entity_Id) is
+                  E              : Entity_Id;
+                  Iface          : Elmt_Id;
+
+               begin
+                  --  Climb to the ancestor (if any) handling private types
+
+                  if Present (Full_View (Etype (Typ))) then
+                     if Full_View (Etype (Typ)) /= Typ then
+                        Copy_Secondary_DTs (Full_View (Etype (Typ)));
+                     end if;
+
+                  elsif Etype (Typ) /= Typ then
+                     Copy_Secondary_DTs (Etype (Typ));
+                  end if;
+
+                  if Present (Abstract_Interfaces (Typ))
+                    and then not Is_Empty_Elmt_List
+                                   (Abstract_Interfaces (Typ))
+                  then
+                     Iface := First_Elmt (Abstract_Interfaces (Typ));
+                     E     := First_Entity (Typ);
+
+                     while Present (E)
+                       and then Present (Node (Sec_DT_Ancestor))
+                     loop
+                        if Is_Tag (E) and then Chars (E) /= Name_uTag then
+                           if not Is_Interface (Etype (Typ)) then
+                              Append_To (Elab_Code,
+                                Make_DT_Access_Action (Typ,
+                                  Action => Inherit_DT,
+                                  Args   => New_List (
+                                    Node1 => Unchecked_Convert_To
+                                               (RTE (RE_Tag),
+                                                New_Reference_To
+                                                  (Node (Sec_DT_Ancestor),
+                                                   Loc)),
+                                    Node2 => Unchecked_Convert_To
+                                               (RTE (RE_Tag),
+                                                New_Reference_To
+                                                  (Node (Sec_DT_Typ), Loc)),
+                                    Node3 => Make_Integer_Literal (Loc,
+                                               DT_Entry_Count (E)))));
+                           end if;
+
+                           Next_Elmt (Sec_DT_Ancestor);
+                           Next_Elmt (Sec_DT_Typ);
+                           Next_Elmt (Iface);
+                        end if;
+
+                        Next_Entity (E);
+                     end loop;
+                  end if;
+               end Copy_Secondary_DTs;
+
+            begin
+               if Present (Node (Sec_DT_Ancestor)) then
+
+                  --  Handle private types
+
+                  if Present (Full_View (Typ)) then
+                     Copy_Secondary_DTs (Full_View (Typ));
+                  else
+                     Copy_Secondary_DTs (Typ);
+                  end if;
+               end if;
+            end;
+         end if;
+      end if;
+
+      --  Generate:
+      --    Inherit_TSD (parent'tag, DT_Ptr);
+
+      Append_To (Elab_Code,
+        Make_DT_Access_Action (Typ,
+          Action => Inherit_TSD,
+          Args   => New_List (
+            Node1 => Old_Tag2,
+            Node2 => New_Reference_To (DT_Ptr, Loc))));
+
+      --  For types with no controlled components, generate:
+      --    Set_RC_Offset (DT_Ptr, 0);
+
+      --  For simple types with controlled components, generate:
+      --    Set_RC_Offset (DT_Ptr, type._record_controller'position);
+
+      --  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;
+
+         begin
+            if not Has_Controlled_Component (Typ) then
+               Position := Make_Integer_Literal (Loc, 0);
+
+            elsif Etype (Typ) /= Typ
+              and then Has_Discriminants (Etype (Typ))
+            then
+               if Has_New_Controlled_Component (Typ) then
+                  Position := Make_Integer_Literal (Loc, -1);
+               else
+                  Position := Make_Integer_Literal (Loc, -2);
+               end if;
+            else
+               Position :=
+                 Make_Attribute_Reference (Loc,
+                   Prefix =>
+                     Make_Selected_Component (Loc,
+                       Prefix => New_Reference_To (Typ, Loc),
+                       Selector_Name =>
+                         New_Reference_To (Controller_Component (Typ), Loc)),
+                   Attribute_Name => Name_Position);
+
+               --  This is not proper Ada code to use the attribute 'Position
+               --  on something else than an object but this is supported by
+               --  the back end (see comment on the Bit_Component attribute in
+               --  sem_attr). So we avoid semantic checking here.
+
+               --  Is this documented in sinfo.ads??? it should be!
+
+               Set_Analyzed (Position);
+               Set_Etype (Prefix (Position), RTE (RE_Record_Controller));
+               Set_Etype (Prefix (Prefix (Position)), Typ);
+               Set_Etype (Selector_Name (Prefix (Position)),
+                 RTE (RE_Record_Controller));
+               Set_Etype (Position, RTE (RE_Storage_Offset));
+            end if;
+
+            Append_To (Elab_Code,
+              Make_DT_Access_Action (Typ,
+                Action => Set_RC_Offset,
+                Args   => New_List (
+                  Node1 => New_Reference_To (DT_Ptr, Loc),
+                  Node2 => Position)));
+         end;
+
+         --  Generate: Set_Remotely_Callable (DT_Ptr, Status); where Status is
+         --  described in E.4 (18)
+
+         declare
+            Status : Entity_Id;
+
+         begin
+            Status :=
+              Boolean_Literals
+                (Is_Pure (Typ)
+                   or else Is_Shared_Passive (Typ)
+                   or else
+                     ((Is_Remote_Types (Typ)
+                         or else Is_Remote_Call_Interface (Typ))
+                      and then Original_View_In_Visible_Part (Typ))
+                   or else not Comes_From_Source (Typ));
+
+            Append_To (Elab_Code,
+              Make_DT_Access_Action (Typ,
+                Action => Set_Remotely_Callable,
+                Args   => New_List (
+                  New_Occurrence_Of (DT_Ptr, Loc),
+                  New_Occurrence_Of (Status, Loc))));
+         end;
+
+         --  Generate:
+         --    Set_Offset_To_Top (DT_Ptr, 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 (DT_Ptr, Loc),
+               Make_Integer_Literal (Loc, Uint_0))));
+      end if;
+
+      --  Generate: Set_External_Tag (DT_Ptr, exname'Address);
+      --  Should be the external name not the qualified name???
+
+      if not Has_External_Tag_Rep_Clause (Typ) then
+         Append_To (Elab_Code,
+           Make_DT_Access_Action (Typ,
+             Action => Set_External_Tag,
+             Args   => New_List (
+               Node1 => New_Reference_To (DT_Ptr, Loc),
+               Node2 =>
+                 Make_Attribute_Reference (Loc,
+                   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.
+
+      --        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)
+
+         if not No_Run_Time_Mode
+           and then RTE_Available (RE_Register_Tag)
+           and then Is_RTE (Generalized_Tag, RE_Tag)
+           and then not Is_Interface (Typ)
+         then
+            Append_To (Elab_Code,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (RTE (RE_Register_Tag), Loc),
+                Parameter_Associations =>
+                  New_List (New_Reference_To (DT_Ptr, Loc))));
+         end if;
+      end if;
+
+      --  Generate:
+      --     if No_Reg then
+      --        <elab_code>
+      --        No_Reg := False;
+      --     end if;
+
+      Append_To (Elab_Code,
+        Make_Assignment_Statement (Loc,
+          Name       => New_Reference_To (No_Reg, Loc),
+          Expression => New_Reference_To (Standard_False, Loc)));
+
+      Append_To (Result,
+        Make_Implicit_If_Statement (Typ,
+          Condition       => New_Reference_To (No_Reg, Loc),
+          Then_Statements => Elab_Code));
+
+      --  Ada 2005 (AI-251): Register the tag of the interfaces into
+      --  the table of implemented interfaces and ...
+
+      if not Is_Interface (Typ)
+        and then Present (Abstract_Interfaces (Typ_Copy))
+        and then not Is_Empty_Elmt_List (Abstract_Interfaces (Typ_Copy))
+      then
+         AI := First_Elmt (Abstract_Interfaces (Typ_Copy));
+         while Present (AI) loop
+
+            --  Generate:
+            --    Register_Interface (DT_Ptr, Interface'Tag);
+
+            Append_To (Result,
+              Make_DT_Access_Action (Typ,
+                Action => Register_Interface_Tag,
+                Args   => New_List (
+                  Node1 => New_Reference_To (DT_Ptr, Loc),
+                  Node2 => New_Reference_To
+                             (Node
+                              (First_Elmt
+                               (Access_Disp_Table (Node (AI)))),
+                              Loc))));
+
+            Next_Elmt (AI);
+         end loop;
+      end if;
+
+      return Result;
+   end Make_DT;
+
+   ---------------------------
+   -- Make_DT_Access_Action --
+   ---------------------------
+
+   function Make_DT_Access_Action
+     (Typ    : Entity_Id;
+      Action : DT_Access_Action;
+      Args   : List_Id) return Node_Id
+   is
+      Action_Name : constant Entity_Id := RTE (Ada_Actions (Action));
+      Loc         : Source_Ptr;
+
+   begin
+      if No (Args) then
+
+         --  This is a constant
+
+         return New_Reference_To (Action_Name, Sloc (Typ));
+      end if;
+
+      pragma Assert (List_Length (Args) = Action_Nb_Arg (Action));
+
+      Loc := Sloc (First (Args));
+
+      if Action_Is_Proc (Action) then
+         return
+           Make_Procedure_Call_Statement (Loc,
+             Name => New_Reference_To (Action_Name, Loc),
+             Parameter_Associations => Args);
+
+      else
+         return
+           Make_Function_Call (Loc,
+             Name => New_Reference_To (Action_Name, Loc),
+             Parameter_Associations => Args);
+      end if;
+   end Make_DT_Access_Action;
+
+   -----------------------
+   -- Make_Secondary_DT --
+   -----------------------
+
+   procedure Make_Secondary_DT
+     (Typ             : Entity_Id;
+      Ancestor_Typ    : Entity_Id;
+      Suffix_Index    : Int;
+      Iface           : Entity_Id;
+      AI_Tag          : Entity_Id;
+      Acc_Disp_Tables : in out Elist_Id;
+      Result          : out List_Id)
+   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');
+      Iface_DT        : Node_Id;
+      Iface_DT_Ptr    : Node_Id;
+      Name_DT_Ptr     : Name_Id;
+      Nb_Prim         : Int;
+      OSD             : Entity_Id;
+      Size_Expr_Node  : Node_Id;
+      Tname           : Name_Id;
+
+   begin
+      Result := New_List;
+
+      --  Generate a unique external name associated with the secondary
+      --  dispatch table. This external name will be used to declare an
+      --  access to this secondary dispatch table, value that will be used
+      --  for the elaboration of Typ's objects and also for the elaboration
+      --  of objects of any derivation of Typ that do not override any
+      --  primitive operation of Typ.
+
+      Get_Secondary_DT_External_Name (Typ, Ancestor_Typ, Suffix_Index);
+
+      Tname        := Name_Find;
+      Name_DT_Ptr  := New_External_Name (Tname, "P");
+      Iface_DT     := Make_Defining_Identifier (Loc, Name_DT);
+      Iface_DT_Ptr := Make_Defining_Identifier (Loc, Name_DT_Ptr);
+
+      --  Dispatch table and related entities are allocated statically
+
+      Set_Ekind (Iface_DT, E_Variable);
+      Set_Is_Statically_Allocated (Iface_DT);
+
+      Set_Ekind (Iface_DT_Ptr, E_Variable);
+      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.
+
+      Nb_Prim := UI_To_Int (DT_Entry_Count (AI_Tag));
+
+      if Nb_Prim < Default_Prim_Op_Count then
+         Nb_Prim := Default_Prim_Op_Count;
+      end if;
+
+      --    DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
+      --    for DT'Alignment use Address'Alignment
+
+      Size_Expr_Node :=
+        Make_Op_Add (Loc,
+          Left_Opnd  => Make_DT_Access_Action (Etype (AI_Tag),
+                          DT_Prologue_Size,
+                          No_List),
+          Right_Opnd =>
+            Make_Op_Multiply (Loc,
+              Left_Opnd  =>
+                Make_DT_Access_Action (Etype (AI_Tag),
+                                       DT_Entry_Size,
+                                       No_List),
+              Right_Opnd =>
+                Make_Integer_Literal (Loc, Nb_Prim)));
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Iface_DT,
+          Aliased_Present     => True,
+          Object_Definition   =>
+            Make_Subtype_Indication (Loc,
+              Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
+              Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
+                Constraints => New_List (
+                  Make_Range (Loc,
+                    Low_Bound  => Make_Integer_Literal (Loc, 1),
+                    High_Bound => Size_Expr_Node))))));
+
+      Append_To (Result,
+        Make_Attribute_Definition_Clause (Loc,
+          Name       => New_Reference_To (Iface_DT, Loc),
+          Chars      => Name_Alignment,
+          Expression =>
+            Make_Attribute_Reference (Loc,
+              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);
+
+      --  According to the C++ ABI, the base of the vtable is located
+      --  after the following prologue: Offset_To_Top, and Typeinfo_Ptr.
+      --  Hence, move the pointer down to the real base of the vtable.
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Iface_DT_Ptr,
+          Constant_Present    => True,
+          Object_Definition   => New_Reference_To (Generalized_Tag, Loc),
+          Expression          =>
+            Unchecked_Convert_To (Generalized_Tag,
+              Make_Op_Add (Loc,
+                Left_Opnd =>
+                  Unchecked_Convert_To (RTE (RE_Storage_Offset),
+                    Make_Attribute_Reference (Loc,
+                      Prefix         => New_Reference_To (Iface_DT, Loc),
+                      Attribute_Name => Name_Address)),
+                Right_Opnd =>
+                  Make_DT_Access_Action (Etype (AI_Tag),
+                    DT_Prologue_Size, No_List)))));
+
+      --  Note: Offset_To_Top will be initialized by the init subprogram
+
+      --  Set Access_Disp_Table field to be the dispatch table pointer
+
+      if not (Present (Acc_Disp_Tables)) then
+         Acc_Disp_Tables := New_Elmt_List;
+      end if;
+
+      Append_Elmt (Iface_DT_Ptr, Acc_Disp_Tables);
+
+      --  Step 1: Generate an Object Specific Data (OSD) table
+
+      OSD := Make_Defining_Identifier (Loc, New_Internal_Name ('I'));
+
+      --  Generate:
+      --    OSD : Ada.Tags.Object_Specific_Data
+      --            (Nb_Prims - Default_Prim_Op_Count);
+      --  where the constraint is used to allocate space for the
+      --  non-predefined primitive operations only.
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => OSD,
+          Object_Definition   =>
+            Make_Subtype_Indication (Loc,
+              Subtype_Mark => New_Reference_To (
+                RTE (RE_Object_Specific_Data), Loc),
+              Constraint =>
+                Make_Index_Or_Discriminant_Constraint (Loc,
+                  Constraints => New_List (
+                    Make_Integer_Literal (Loc,
+                      Nb_Prim - Default_Prim_Op_Count))))));
+
+      --  Generate:
+      --    Ada.Tags.Set_OSD (Iface_DT_Ptr, OSD);
+
+      Append_To (Result,
+        Make_DT_Access_Action (Typ,
+          Action => Set_OSD,
+          Args   => New_List (
+            New_Reference_To (Iface_DT_Ptr, Loc),
+            Make_Attribute_Reference (Loc,
+              Prefix         => New_Reference_To (OSD, Loc),
+              Attribute_Name => Name_Address))));
+
+      --  Offset table creation
+
+      if not Is_Interface (Typ)
+        and then not Is_Abstract   (Typ)
+        and then not Is_Controlled (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;
+            Prim_Alias : Entity_Id;
+            Prim_Elmt  : Elmt_Id;
+
+         begin
+            --  Step 2: Populate the OSD table
+
+            Prim_Alias := Empty;
+            Prim_Elmt  := First_Elmt (Primitive_Operations (Typ));
+            while Present (Prim_Elmt) loop
+               Prim := Node (Prim_Elmt);
+
+               if Present (Abstract_Interface_Alias (Prim)) then
+                  Prim_Alias := Abstract_Interface_Alias (Prim);
+               end if;
+
+               if Present (Prim_Alias)
+                 and then Present (First_Entity (Prim_Alias))
+                 and then Etype (First_Entity (Prim_Alias)) = Iface
+               then
+                  --  Generate:
+                  --    Ada.Tags.Set_Offset_Index (
+                  --      Iface_DT_Ptr, secondary_DT_Pos, primary_DT_pos);
+
+                  Append_To (Result,
+                    Make_DT_Access_Action (Iface,
+                      Action => Set_Offset_Index,
+                      Args   => New_List (
+                        New_Reference_To (Iface_DT_Ptr, Loc),
+                        Make_Integer_Literal (Loc, DT_Position (Prim_Alias)),
+                        Make_Integer_Literal (Loc, DT_Position (Prim)))));
+
+                  Prim_Alias := Empty;
+               end if;
+
+               Next_Elmt (Prim_Elmt);
+            end loop;
+         end;
+      end if;
+
+      --  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))));
+
+   end Make_Secondary_DT;
+
+   -------------------------------------
+   -- Make_Select_Specific_Data_Table --
+   -------------------------------------
+
+   function Make_Select_Specific_Data_Table
+     (Typ : Entity_Id) return List_Id
+   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;
+
+      type Examined_Array is array (Int range <>) of Boolean;
+
+      function Find_Entry_Index (E : Entity_Id) return Uint;
+      --  Given an entry, find its index in the visible declarations of the
+      --  corresponding concurrent type of Typ.
+
+      ----------------------
+      -- Find_Entry_Index --
+      ----------------------
+
+      function Find_Entry_Index (E : Entity_Id) return Uint is
+         Index     : Uint := Uint_1;
+         Subp_Decl : Entity_Id;
+
+      begin
+         if Present (Decls)
+           and then not Is_Empty_List (Decls)
+         then
+            Subp_Decl := First (Decls);
+            while Present (Subp_Decl) loop
+               if Nkind (Subp_Decl) = N_Entry_Declaration then
+                  if Defining_Identifier (Subp_Decl) = E then
+                     return Index;
+                  end if;
+
+                  Index := Index + 1;
+               end if;
+
+               Next (Subp_Decl);
+            end loop;
+         end if;
+
+         return Uint_0;
+      end Find_Entry_Index;
+
+   --  Start of processing for Make_Select_Specific_Data_Table
+
+   begin
+      DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+
+      if Present (Corresponding_Concurrent_Type (Typ)) then
+         Conc_Typ := Corresponding_Concurrent_Type (Typ);
+
+         if Ekind (Conc_Typ) = E_Protected_Type then
+            Decls := Visible_Declarations (Protected_Definition (
+                       Parent (Conc_Typ)));
+         else
+            pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
+            Decls := Visible_Declarations (Task_Definition (
+                       Parent (Conc_Typ)));
+         end if;
+      end if;
+
+      --  Count the non-predefined primitive operations
+
+      Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
+      while Present (Prim_Elmt) loop
+         if not Is_Predefined_Dispatching_Operation (Node (Prim_Elmt)) then
+            Nb_Prim := Nb_Prim + 1;
+         end if;
+
+         Next_Elmt (Prim_Elmt);
+      end loop;
+
+      declare
+         Examined_Size : constant Int := Nb_Prim + Default_Prim_Op_Count;
+         Examined : Examined_Array (1 .. Examined_Size) := (others => False);
+
+      begin
+         Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
+         while Present (Prim_Elmt) loop
+            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>);
+
+               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;
+               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;
+
+            <<Continue>>
+
+            Next_Elmt (Prim_Elmt);
+         end loop;
+      end;
+
+      return Assignments;
+   end Make_Select_Specific_Data_Table;
+
    -----------------------------------
    -- Original_View_In_Visible_Part --
    -----------------------------------
@@ -3342,6 +3772,11 @@ package body Exp_Disp is
          if Ekind (Full_Typ) = E_Protected_Type then
             return New_Reference_To (RTE (RE_POK_Protected_Function), Loc);
 
+         --  Task function
+
+         elsif Ekind (Full_Typ) = E_Task_Type then
+            return New_Reference_To (RTE (RE_POK_Task_Function), Loc);
+
          --  Regular function
 
          else
@@ -3638,7 +4073,10 @@ package body Exp_Disp is
 
             --  Ada 2005 (AI-251)
 
-            if Present (Abstract_Interface_Alias (Prim)) then
+            if Present (Abstract_Interface_Alias (Prim))
+              and then Is_Interface (Scope (DTC_Entity
+                                      (Abstract_Interface_Alias (Prim))))
+            then
                Set_DTC_Entity (Prim,
                   Find_Interface_Tag
                     (T => Typ,
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index 469ea79..bdc1417 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -28,8 +28,144 @@
 --  dispatching expansion.
 
 with Types; use Types;
+
 package Exp_Disp is
 
+   -------------------------------------
+   -- Predefined primitive operations --
+   -------------------------------------
+
+   --  The predefined primitive operations (PPOs) are subprograms generated
+   --  by GNAT for a particular tagged type. Their role is to provide support
+   --  for different Ada language features such as the attribute 'Size or
+   --  handling of dispatching triggers in select statements. PPOs are created
+   --  when a tagged type is expanded or frozen. These subprograms are later
+   --  collected and inserted into the dispatch table of a tagged type at
+   --  fixed positions. Some of the PPOs that manipulate data in tagged objects
+   --  require the generation of thunks.
+
+   --  List of predefined primitive operations
+
+   --    Leading underscores designate reserved names. Bracketed numerical
+   --    values represent dispatch table slot numbers.
+
+   --      _Size (1) - implementation of the attribute 'Size for any tagged
+   --      type. Constructs of the form Prefix'Size are converted into
+   --      Prefix._Size.
+
+   --      _Alignment (2) - implementation of the attribute 'Alignment for
+   --      any tagged type. Constructs of the form Prefix'Alignment are
+   --      converted into Prefix._Alignment.
+
+   --      TSS_Stream_Read (3) - implementation of the stream attribute Read
+   --      for any tagged type.
+
+   --      TSS_Stream_Write (4) - implementation of the stream attribute Write
+   --      for any tagged type.
+
+   --      TSS_Stream_Input (5) - implementation of the stream attribute Input
+   --      for any tagged type.
+
+   --      TSS_Stream_Output (6) - implementation of the stream attribute
+   --      Output for any tagged type.
+
+   --      Op_Eq (7) - implementation of the equality operator for any non-
+   --      limited tagged type.
+
+   --      _Assign (8) - implementation of the assignment operator for any
+   --      non-limited tagged type.
+
+   --      TSS_Deep_Adjust (9) - implementation of the finalization operation
+   --      Adjust for any non-limited tagged type.
+
+   --      TSS_Deep_Finalize (10) - implementation of the finalization
+   --      operation Finalize for any non-limited tagged type.
+
+   --      _Disp_Asynchronous_Select (11) - used in the expansion of ATC with
+   --      dispatching triggers. Null implementation for limited interfaces,
+   --      full body generation for types that implement limited interfaces,
+   --      not generated for the rest of the cases. See Expand_N_Asynchronous_
+   --      Select in Exp_Ch9 for more information.
+
+   --      _Disp_Conditional_Select (12) - used in the expansion of conditional
+   --      selects with dispatching triggers. Null implementation for limited
+   --      interfaces, full body generation for types that implement limited
+   --      interfaces, not generated for the rest of the cases. See Expand_N_
+   --      Conditional_Entry_Call in Exp_Ch9 for more information.
+
+   --      _Disp_Get_Prim_Op_Kind (13) - helper routine used in the expansion
+   --      of ATC with dispatching triggers. Null implementation for limited
+   --      interfaces, full body generation for types that implement limited
+   --      interfaces, not generated for the rest of the cases.
+
+   --      _Disp_Get_Task_Id (14) - helper routine used in the expansion of
+   --      Abort, attributes 'Callable and 'Terminated for task interface
+   --      class-wide types. Full body generation for task types, null
+   --      implementation for limited interfaces, not generated for the rest
+   --      of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
+   --      Expand_N_Abort_Statement in Exp_Ch9 for more information.
+
+   --      _Disp_Timed_Select (15) - used in the expansion of timed selects
+   --      with dispatching triggers. Null implementation for limited
+   --      interfaces, full body generation for types that implement limited
+   --      interfaces, not generated for the rest of the cases. See Expand_N_
+   --      Timed_Entry_Call for more information.
+
+   --  Lifecycle of predefined primitive operations
+
+   --      The specifications and bodies of the PPOs are created by
+   --      Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
+   --      in Exp_Ch3. The generated specifications are immediately analyzed,
+   --      while the bodies are left as freeze actions to the tagged type for
+   --      which they are created.
+
+   --      PPOs are collected and added to the Primitive_Operations list of
+   --      a type by the regular analysis mechanism.
+
+   --      PPOs are frozen in Predefined_Primitive_Freeze in Exp_Ch3.
+
+   --      Thunks for PPOs are created in Freeze_Subprogram in Exp_Ch6, by a
+   --      call to Register_Predefined_DT_Entry, also in Exp_Ch6.
+
+   --      Dispatch table positions of PPOs are set in Set_All_DT_Position in
+   --      Exp_Disp.
+
+   --      Calls to PPOs procede as regular dispatching calls. If the PPO
+   --      has a thunk, a call procedes as a regular dispatching call with
+   --      a thunk.
+
+   --  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.
+
+   --      Introduce a new predefined name for the new PPO in Snames.ads and
+   --      Snames.adb.
+
+   --      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.
+
+   --      Generate the body of the new PPO in Predefined_Primitive_Bodies in
+   --      Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
+   --      specification must be set to True.
+
+   --      If the new PPO requires a thunk, add an entry in Freeze_Subprogram
+   --      in Exp_Ch6.adb.
+
+   --      When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
+   --      to retrieve the entity of the operation directly.
+
    --  Number of predefined primitive operations added by the Expander
    --  for a tagged type. If more predefined primitive operations are
    --  added, the following items must be changed:
@@ -38,7 +174,7 @@ 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 := 14;
+   Default_Prim_Op_Count : constant Int := 15;
 
    type DT_Access_Action is
       (CW_Membership,
@@ -48,6 +184,7 @@ package Exp_Disp is
        Get_Access_Level,
        Get_Entry_Index,
        Get_External_Tag,
+       Get_Offset_Index,
        Get_Prim_Op_Address,
        Get_Prim_Op_Kind,
        Get_RC_Offset,
@@ -60,10 +197,13 @@ package Exp_Disp is
        Set_Entry_Index,
        Set_Expanded_Name,
        Set_External_Tag,
+       Set_Offset_Index,
+       Set_OSD,
        Set_Prim_Op_Address,
        Set_Prim_Op_Kind,
        Set_RC_Offset,
        Set_Remotely_Callable,
+       Set_SSD,
        Set_TSD,
        TSD_Entry_Size,
        TSD_Prologue_Size);
@@ -117,16 +257,6 @@ package Exp_Disp is
    --  Ada 2005 (AI-251): Initialize the entries associated with predefined
    --  primitives in all the secondary dispatch tables of Typ.
 
-   procedure Make_Abstract_Interface_DT
-     (AI_Tag          : Entity_Id;
-      Acc_Disp_Tables : in out Elist_Id;
-      Result          : out List_Id);
-   --  Ada 2005 (AI-251): Expand the declarations for the secondary Dispatch
-   --  Tables corresponding with an abstract interface. The reference to the
-   --  dispatch table is appended at the end of Acc_Disp_Tables; it will be
-   --  are later used to generate the corresponding initialization statement
-   --  (see Exp_Ch3.Build_Init_Procedure).
-
    function Make_DT_Access_Action
      (Typ    : Entity_Id;
       Action : DT_Access_Action;
@@ -141,7 +271,8 @@ package Exp_Disp is
    function Make_Disp_Asynchronous_Select_Body
      (Typ : Entity_Id) return Node_Id;
    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
-   --  Typ used for dispatching in asynchronous selects.
+   --  Typ used for dispatching in asynchronous selects. Generate a null body
+   --  if Typ is an interface type.
 
    function Make_Disp_Asynchronous_Select_Spec
      (Typ : Entity_Id) return Node_Id;
@@ -151,7 +282,8 @@ package Exp_Disp is
    function Make_Disp_Conditional_Select_Body
      (Typ : Entity_Id) return Node_Id;
    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
-   --  Typ used for dispatching in conditional selects.
+   --  Typ used for dispatching in conditional selects. Generate a null body
+   --  if Typ is an interface type.
 
    function Make_Disp_Conditional_Select_Spec
      (Typ : Entity_Id) return Node_Id;
@@ -162,7 +294,7 @@ package Exp_Disp is
      (Typ : Entity_Id) return Node_Id;
    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
    --  Typ used for retrieving the callable entity kind during dispatching in
-   --  asynchronous selects.
+   --  asynchronous selects. Generate a null body if Typ is an interface type.
 
    function Make_Disp_Get_Prim_Op_Kind_Spec
      (Typ : Entity_Id) return Node_Id;
@@ -170,23 +302,52 @@ package Exp_Disp is
    --  of the type Typ use for retrieving the callable entity kind during
    --  dispatching in asynchronous selects.
 
-   function Make_Disp_Select_Tables
-     (Typ : Entity_Id) return List_Id;
-   --  Ada 2005 (AI-345): Populate the two auxiliary tables in the TSD of Typ
-   --  used for dispatching in asynchronous, conditional and timed selects.
-   --  Generate code to set the primitive operation kinds and entry indices
-   --  of primitive operations and primitive wrappers.
+   function Make_Disp_Get_Task_Id_Body
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+   --  Typ used for retrieving the _task_id field of a task interface class-
+   --  wide type. Generate a null body if Typ is an interface or a non-task
+   --  type.
+
+   function Make_Disp_Get_Task_Id_Spec
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+   --  of type Typ used for retrieving the _task_id field of a task interface
+   --  class-wide type.
 
    function Make_Disp_Timed_Select_Body
      (Typ : Entity_Id) return Node_Id;
    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
-   --  Typ used for dispatching in timed selects.
+   --  Typ used for dispatching in timed selects. Generate a null body if Nul
+   --  is an interface type.
 
    function Make_Disp_Timed_Select_Spec
      (Typ : Entity_Id) return Node_Id;
    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
    --  of type Typ used for dispatching in timed selects.
 
+   function Make_Select_Specific_Data_Table
+     (Typ : Entity_Id) return List_Id;
+   --  Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
+   --  of Typ used for dispatching in asynchronous, conditional and timed
+   --  selects. Generate code to set the primitive operation kinds and entry
+   --  indices of primitive operations and primitive wrappers.
+
+   procedure Make_Secondary_DT
+     (Typ             : Entity_Id;
+      Ancestor_Typ    : Entity_Id;
+      Suffix_Index    : Int;
+      Iface           : Entity_Id;
+      AI_Tag          : Entity_Id;
+      Acc_Disp_Tables : in out Elist_Id;
+      Result          : out List_Id);
+   --  Ada 2005 (AI-251): Expand the declarations for the Secondary Dispatch
+   --  Table of Typ associated with Iface (each abstract interface implemented
+   --  by Typ has a secondary dispatch table). The arguments Typ, Ancestor_Typ
+   --  and Suffix_Index are used to generate an unique external name which
+   --  is added at the end of Acc_Disp_Tables; this external name will be
+   --  used later by the subprogram Exp_Ch3.Build_Init_Procedure.
+
    procedure Set_All_DT_Position (Typ : Entity_Id);
    --  Set the DT_Position field for each primitive operation. In the CPP
    --  Class case check that no pragma CPP_Virtual is missing and that the
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index ebef01d..c6924e9 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -1275,6 +1275,16 @@ package body Exp_Util is
       then
          null;
 
+      --  Nothing to be done for derived types with unknown discriminants if
+      --  the parent type also has unknown discriminants.
+
+      elsif Is_Record_Type (Unc_Type)
+        and then not Is_Class_Wide_Type (Unc_Type)
+        and then Has_Unknown_Discriminants (Unc_Type)
+        and then Has_Unknown_Discriminants (Underlying_Type (Unc_Type))
+      then
+         null;
+
       --  Nothing to be done if the type of the expression is limited, because
       --  in this case the expression cannot be copied, and its use can only
       --  be by reference and there is no need for the actual subtype.
@@ -1289,8 +1299,147 @@ package body Exp_Util is
       end if;
    end Expand_Subtype_From_Expr;
 
+   --------------------------------
+   -- Find_Implemented_Interface --
+   --------------------------------
+
+   --  Given the following code (XXX denotes irrelevant value):
+
+   --     type Limd_Iface is limited interface;
+   --     type Prot_Iface is protected interface;
+   --     type Sync_Iface is synchronized interface;
+
+   --     type Parent_Subtype is new Limd_Iface and Sync_Iface with ...
+   --     type Child_Subtype is new Parent_Subtype and Prot_Iface with ...
+
+   --  The following calls will return the following values:
+
+   --     Find_Implemented_Interface
+   --       (Child_Subtype, Synchronized_Interface, False)    -> Empty
+
+   --     Find_Implemented_Interface
+   --       (Child_Subtype, Synchronized_Interface, True)     -> Sync_Iface
+
+   --     Find_Implemented_Interface
+   --       (Child_Subtype, Any_Synchronized_Interface, XXX)  -> Prot_Iface
+
+   --     Find_Implemented_Interface
+   --       (Child_Subtype, Any_Limited_Interface, XXX)       -> Prot_Iface
+
+   function Find_Implemented_Interface
+     (Typ          : Entity_Id;
+      Kind         : Interface_Kind;
+      Check_Parent : Boolean := False) return Entity_Id
+   is
+      Iface_Elmt : Elmt_Id;
+
+      function Interface_In_Kind
+        (I    : Entity_Id;
+         Kind : Interface_Kind) return Boolean;
+      --  Determine whether an interface falls into a specified kind
+
+      -----------------------
+      -- Interface_In_Kind --
+      -----------------------
+
+      function Interface_In_Kind
+        (I    : Entity_Id;
+         Kind : Interface_Kind) return Boolean is
+      begin
+         if Is_Limited_Interface (I)
+           and then (Kind = Any_Interface
+             or else Kind = Any_Limited_Interface
+             or else Kind = Limited_Interface)
+         then
+            return True;
+
+         elsif Is_Protected_Interface (I)
+           and then (Kind = Any_Interface
+             or else Kind = Any_Limited_Interface
+             or else Kind = Any_Synchronized_Interface
+             or else Kind = Protected_Interface)
+         then
+            return True;
+
+         elsif Is_Synchronized_Interface (I)
+           and then (Kind = Any_Interface
+             or else Kind = Any_Limited_Interface
+             or else Kind = Synchronized_Interface)
+         then
+            return True;
+
+         elsif Is_Task_Interface (I)
+           and then (Kind = Any_Interface
+             or else Kind = Any_Limited_Interface
+             or else Kind = Any_Synchronized_Interface
+             or else Kind = Task_Interface)
+         then
+            return True;
+
+         --  Regular interface. This should be the last kind to check since
+         --  all of the previous cases have their Is_Interface flags set.
+
+         elsif Is_Interface (I)
+           and then (Kind = Any_Interface
+             or else Kind = Iface)
+         then
+            return True;
+
+         else
+            return False;
+         end if;
+      end Interface_In_Kind;
+
+   --  Start of processing for Find_Implemented_Interface
+
+   begin
+      if not Is_Tagged_Type (Typ) then
+         return Empty;
+      end if;
+
+      --  Implementations of the form:
+      --    Typ is new Interface ...
+
+      if Is_Interface (Etype (Typ))
+        and then Interface_In_Kind (Etype (Typ), Kind)
+      then
+         return Etype (Typ);
+      end if;
+
+      --  Implementations of the form:
+      --     Typ is new Typ_Parent and Interface ...
+
+      if Present (Abstract_Interfaces (Typ)) then
+         Iface_Elmt := First_Elmt (Abstract_Interfaces (Typ));
+         while Present (Iface_Elmt) loop
+            if Interface_In_Kind (Node (Iface_Elmt), Kind) then
+               return Node (Iface_Elmt);
+            end if;
+
+            Iface_Elmt := Next_Elmt (Iface_Elmt);
+         end loop;
+      end if;
+
+      --  Typ is a derived type and may implement a limited interface
+      --  through its parent subtype. Check the parent subtype as well
+      --  as any interfaces explicitly implemented at this level.
+
+      if Check_Parent
+        and then Ekind (Typ) = E_Record_Type
+        and then Present (Parent_Subtype (Typ))
+      then
+         return Find_Implemented_Interface (
+           Parent_Subtype (Typ), Kind, Check_Parent);
+      end if;
+
+      --  Typ does not implement a limited interface either at this level or
+      --  in any of its parent subtypes.
+
+      return Empty;
+   end Find_Implemented_Interface;
+
    ------------------------
-   -- Find_Interface_Tag --
+   -- Find_Interface_ADT --
    ------------------------
 
    function Find_Interface_ADT
@@ -1302,7 +1451,7 @@ package body Exp_Util is
       Typ   : Entity_Id := T;
 
       procedure Find_Secondary_Table (Typ : Entity_Id);
-      --  Comment required ???
+      --  Internal subprogram used to recursively climb to the ancestors
 
       --------------------------
       -- Find_Secondary_Table --
@@ -1313,10 +1462,23 @@ package body Exp_Util is
          AI      : Node_Id;
 
       begin
-         if Etype (Typ) /= Typ then
+         --  Climb to the ancestor (if any) handling private types
+
+         if Present (Full_View (Etype (Typ))) then
+            if Full_View (Etype (Typ)) /= Typ then
+               Find_Secondary_Table (Full_View (Etype (Typ)));
+            end if;
+
+         elsif Etype (Typ) /= Typ then
             Find_Secondary_Table (Etype (Typ));
          end if;
 
+         --  If we already found it there is nothing else to do
+
+         if Found then
+            return;
+         end if;
+
          if Present (Abstract_Interfaces (Typ))
            and then not Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
          then
@@ -1401,9 +1563,14 @@ package body Exp_Util is
             return;
          end if;
 
-         --  Climb to the root type
+         --  Climb to the root type handling private types
+
+         if Present (Full_View (Etype (Typ))) then
+            if Full_View (Etype (Typ)) /= Typ then
+               Find_Tag (Full_View (Etype (Typ)));
+            end if;
 
-         if Etype (Typ) /= Typ then
+         elsif Etype (Typ) /= Typ then
             Find_Tag (Etype (Typ));
          end if;
 
@@ -1437,6 +1604,8 @@ package body Exp_Util is
    --  Start of processing for Find_Interface_Tag
 
    begin
+      pragma Assert (Is_Interface (Iface));
+
       --  Handle private types
 
       if Has_Private_Declaration (Typ)
@@ -1742,67 +1911,17 @@ package body Exp_Util is
       return Count;
    end Homonym_Number;
 
-   ----------------------------------
-   -- Implements_Limited_Interface --
-   ----------------------------------
-
-   function Implements_Limited_Interface (Typ : Entity_Id) return Boolean is
-      function Contains_Limited_Interface
-        (Ifaces : Elist_Id) return Boolean;
-      --  Given a list of interfaces, determine whether one of them is limited
-
-      --------------------------------
-      -- Contains_Limited_Interface --
-      --------------------------------
-
-      function Contains_Limited_Interface
-        (Ifaces : Elist_Id) return Boolean
-      is
-         Iface_Elmt : Elmt_Id;
-
-      begin
-         if not Present (Ifaces) then
-            return False;
-         end if;
-
-         Iface_Elmt := First_Elmt (Ifaces);
-
-         while Present (Iface_Elmt) loop
-            if Is_Limited_Record (Node (Iface_Elmt)) then
-               return True;
-            end if;
-
-            Iface_Elmt := Next_Elmt (Iface_Elmt);
-         end loop;
-
-         return False;
-      end Contains_Limited_Interface;
-
-   --  Start of processing for Implements_Limited_Interface
+   --------------------------
+   -- Implements_Interface --
+   --------------------------
 
+   function Implements_Interface
+     (Typ          : Entity_Id;
+      Kind         : Interface_Kind;
+      Check_Parent : Boolean := False) return Boolean is
    begin
-      --  Typ is a derived type and may implement a limited interface
-      --  through its parent subtype. Check the parent subtype as well
-      --  as any interfaces explicitly implemented at this level.
-
-      if Ekind (Typ) = E_Record_Type
-        and then Present (Parent_Subtype (Typ))
-      then
-         return Contains_Limited_Interface (Abstract_Interfaces (Typ))
-           or else Implements_Limited_Interface (Parent_Subtype (Typ));
-
-      --  Typ is an abstract type derived from some interface
-
-      elsif Is_Abstract (Typ) then
-         return Is_Interface (Etype (Typ))
-           and then Is_Limited_Record (Etype (Typ));
-
-      --  Typ may directly implement some interface
-
-      else
-         return Contains_Limited_Interface (Abstract_Interfaces (Typ));
-      end if;
-   end Implements_Limited_Interface;
+      return Find_Implemented_Interface (Typ, Kind, Check_Parent) /= Empty;
+   end Implements_Interface;
 
    ------------------------------
    -- In_Unconditional_Context --
@@ -2436,7 +2555,6 @@ package body Exp_Util is
       if Suppress = All_Checks then
          declare
             Svg : constant Suppress_Array := Scope_Suppress;
-
          begin
             Scope_Suppress := (others => True);
             Insert_Actions (Assoc_Node, Ins_Actions);
@@ -2446,7 +2564,6 @@ package body Exp_Util is
       else
          declare
             Svg : constant Boolean := Scope_Suppress (Suppress);
-
          begin
             Scope_Suppress (Suppress) := True;
             Insert_Actions (Assoc_Node, Ins_Actions);
@@ -2557,12 +2674,12 @@ package body Exp_Util is
       return True;
    end Is_All_Null_Statements;
 
-   ------------------------
-   -- Is_Default_Prim_Op --
-   ------------------------
+   -----------------------------------------
+   -- Is_Predefined_Dispatching_Operation --
+   -----------------------------------------
 
    function Is_Predefined_Dispatching_Operation
-     (Subp     : Entity_Id) return Boolean
+     (Subp : Entity_Id) return Boolean
    is
       TSS_Name : TSS_Name_Type;
       E        : Entity_Id := Subp;
@@ -2590,10 +2707,12 @@ package body Exp_Util is
            or else Chars (E) = Name_uAssign
            or else TSS_Name  = TSS_Deep_Adjust
            or else TSS_Name  = TSS_Deep_Finalize
-           or else Chars (E) = Name_uDisp_Asynchronous_Select
-           or else Chars (E) = Name_uDisp_Conditional_Select
-           or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
-           or else Chars (E) = Name_uDisp_Timed_Select
+           or else (Ada_Version >= Ada_05
+             and then (Chars (E) = Name_uDisp_Asynchronous_Select
+               or else Chars (E) = Name_uDisp_Conditional_Select
+               or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
+               or else Chars (E) = Name_uDisp_Get_Task_Id
+               or else Chars (E) = Name_uDisp_Timed_Select))
          then
             return True;
          end if;
@@ -3466,7 +3585,7 @@ package body Exp_Util is
             return New_Occurrence_Of (CW_Subtype, Loc);
          end;
 
-      --  Comment needed (what case is this ???)
+      --  Indefinite record type with discriminants.
 
       else
          D := First_Discriminant (Unc_Typ);
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index a63cc71..2afb88f8 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -33,6 +33,21 @@ with Types;   use Types;
 
 package Exp_Util is
 
+   --  An enumeration type used to capture all the possible interface
+   --  kinds and their hierarchical relation. These values are used in
+   --  Find_Implemented_Interface and Implements_Interface.
+
+   type Interface_Kind is (
+     Any_Interface,               --  Any interface
+     Any_Limited_Interface,       --  Only limited interfaces
+     Any_Synchronized_Interface,  --  Only synchronized interfaces
+
+     Iface,                       --  Individual kinds
+     Limited_Interface,
+     Protected_Interface,
+     Synchronized_Interface,
+     Task_Interface);
+
    -----------------------------------------------
    -- Handling of Actions Associated with Nodes --
    -----------------------------------------------
@@ -325,17 +340,27 @@ package Exp_Util is
    --  class-wide).
 
    function Find_Interface_ADT
-     (T         : Entity_Id;
-      Iface     : Entity_Id) return Entity_Id;
+     (T     : Entity_Id;
+      Iface : Entity_Id) return Entity_Id;
    --  Ada 2005 (AI-251): Given a type T implementing the interface Iface,
    --  return the Access_Disp_Table value of the interface.
 
    function Find_Interface_Tag
-     (T         : Entity_Id;
-      Iface     : Entity_Id) return Entity_Id;
+     (T     : Entity_Id;
+      Iface : Entity_Id) return Entity_Id;
    --  Ada 2005 (AI-251): Given a type T implementing the interface Iface,
    --  return the record component containing the tag of Iface.
 
+   function Find_Implemented_Interface
+     (Typ          : Entity_Id;
+      Kind         : Interface_Kind;
+      Check_Parent : Boolean := False) return Entity_Id;
+   --  Ada 2005 (AI-345): Find a designated kind of interface implemented by
+   --  Typ or any parent subtype. Return the first encountered interface that
+   --  correspond to the selected class. Return Empty if no such interface is
+   --  found. Use Check_Parent to climb a potential derivation chain and
+   --  examine the parent subtypes for any implementation.
+
    function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id;
    --  Find the first primitive operation of type T whose name is 'Name'.
    --  This function allows the use of a primitive operation which is not
@@ -410,11 +435,13 @@ package Exp_Util is
    --  chain, counting only entries in the curren scope. If an entity is not
    --  overloaded, the returned number will be one.
 
-   function Implements_Limited_Interface (Typ : Entity_Id) return Boolean;
-   --  Ada 2005 (AI-345): Determine whether Typ implements some limited
-   --  interface. The interface may be of limited, protected, synchronized
-   --  or taks kind. Typ may also be derived from a type that implements a
-   --  limited interface.
+   function Implements_Interface
+     (Typ          : Entity_Id;
+      Kind         : Interface_Kind;
+      Check_Parent : Boolean := False) return Boolean;
+   --  Ada 2005 (AI-345): Determine whether Typ implements a designated kind
+   --  of interface. Use Check_Parent to climb a potential derivation chain
+   --  and examine the parent subtypes for any implementation.
 
    function Inside_Init_Proc return Boolean;
    --  Returns True if current scope is within an init proc
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 07adc39..8b19055 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -209,9 +209,14 @@ package Rtsfind is
       System_Exp_Mod,
       System_Exp_Uns,
       System_Fat_Flt,
+      System_Fat_IEEE_Long_Float,
+      System_Fat_IEEE_Short_Float,
       System_Fat_LFlt,
       System_Fat_LLF,
       System_Fat_SFlt,
+      System_Fat_VAX_D_Float,
+      System_Fat_VAX_F_Float,
+      System_Fat_VAX_G_Float,
       System_Finalization_Implementation,
       System_Finalization_Root,
       System_Fore,
@@ -493,6 +498,7 @@ package Rtsfind is
      RE_Get_Access_Level,                -- Ada.Tags
      RE_Get_Entry_Index,                 -- Ada.Tags
      RE_Get_External_Tag,                -- Ada.Tags
+     RE_Get_Offset_Index,                -- Ada.Tags
      RE_Get_Prim_Op_Address,             -- Ada.Tags
      RE_Get_Prim_Op_Kind,                -- Ada.Tags
      RE_Get_RC_Offset,                   -- Ada.Tags
@@ -501,25 +507,32 @@ package Rtsfind is
      RE_Inherit_TSD,                     -- Ada.Tags
      RE_Internal_Tag,                    -- Ada.Tags
      RE_Is_Descendant_At_Same_Level,     -- Ada.Tags
+     RE_Object_Specific_Data,            -- Ada.Tags
      RE_POK_Function,                    -- Ada.Tags
      RE_POK_Procedure,                   -- Ada.Tags
      RE_POK_Protected_Entry,             -- Ada.Tags
      RE_POK_Protected_Function,          -- Ada.Tags
      RE_POK_Protected_Procedure,         -- Ada.Tags
      RE_POK_Task_Entry,                  -- Ada.Tags
+     RE_POK_Task_Function,               -- Ada.Tags
      RE_POK_Task_Procedure,              -- Ada.Tags
      RE_Prim_Op_Kind,                    -- Ada.Tags
      RE_Register_Interface_Tag,          -- Ada.Tags
      RE_Register_Tag,                    -- Ada.Tags
+     RE_Select_Specific_Data,            -- Ada.Tags
      RE_Set_Access_Level,                -- Ada.Tags
      RE_Set_Entry_Index,                 -- Ada.Tags
      RE_Set_Expanded_Name,               -- Ada.Tags
      RE_Set_External_Tag,                -- Ada.Tags
+     RE_Set_Num_Prim_Ops,                -- Ada.Tags
+     RE_Set_Offset_Index,                -- Ada.Tags
      RE_Set_Offset_To_Top,               -- Ada.Tags
+     RE_Set_OSD,                         -- Ada.Tags
      RE_Set_Prim_Op_Address,             -- Ada.Tags
      RE_Set_Prim_Op_Kind,                -- Ada.Tags
      RE_Set_RC_Offset,                   -- Ada.Tags
      RE_Set_Remotely_Callable,           -- Ada.Tags
+     RE_Set_SSD,                         -- Ada.Tags
      RE_Set_TSD,                         -- Ada.Tags
      RE_Tag_Error,                       -- Ada.Tags
      RE_TSD_Entry_Size,                  -- Ada.Tags
@@ -527,6 +540,10 @@ package Rtsfind is
      RE_Interface_Tag,                   -- Ada.Tags
      RE_Tag,                             -- Ada.Tags
      RE_Address_Array,                   -- Ada.Tags
+     RE_Valid_Signature,                 -- Ada.Tags
+     RE_Primary_DT,                      -- Ada.Tags
+     RE_Secondary_DT,                    -- Ada.Tags
+     RE_Abstract_Interface,              -- Ada.Tags
 
      RE_Abort_Task,                      -- Ada.Task_Identification
      RE_Current_Task,                    -- Ada.Task_Identification
@@ -666,13 +683,28 @@ package Rtsfind is
 
      RE_Exp_Unsigned,                    -- System.Exp_Uns
 
-     RE_Fat_Float,                       -- System.Fat_Flt
+     RE_Attr_Float,                      -- System.Fat_Flt
 
-     RE_Fat_Long_Float,                  -- System.Fat_LFlt
+     RE_Attr_IEEE_Long,                  -- System.Fat_IEEE_Long_Float
+     RE_Fat_IEEE_Long,                   -- System.Fat_IEEE_Long_Float
 
-     RE_Fat_Long_Long_Float,             -- System.Fat_LLF
+     RE_Attr_IEEE_Short,                 -- System.Fat_IEEE_Short_Float
+     RE_Fat_IEEE_Short,                  -- System.Fat_IEEE_Short_Float
 
-     RE_Fat_Short_Float,                 -- System.Fat_SFlt
+     RE_Attr_Long_Float,                 -- System.Fat_LFlt
+
+     RE_Attr_Long_Long_Float,            -- System.Fat_LLF
+
+     RE_Attr_Short_Float,                -- System.Fat_SFlt
+
+     RE_Attr_VAX_D_Float,                -- System.Fat_VAX_D_Float
+     RE_Fat_VAX_D,                       -- System.Fat_VAX_D_Float
+
+     RE_Attr_VAX_F_Float,                -- System.Fat_VAX_F_Float
+     RE_Fat_VAX_F,                       -- System.Fat_VAX_F_Float
+
+     RE_Attr_VAX_G_Float,                -- System.Fat_VAX_G_Float
+     RE_Fat_VAX_G,                       -- System.Fat_VAX_G_Float
 
      RE_Attach_To_Final_List,            -- System.Finalization_Implementation
      RE_Finalize_List,                   -- System.Finalization_Implementation
@@ -1151,6 +1183,7 @@ package Rtsfind is
 
      RE_TC_Alias,                        -- System.PolyORB_Interface
      RE_TC_Build,                        -- System.PolyORB_Interface
+     RE_Get_TC,                          -- System.PolyORB_Interface
      RE_Set_TC,                          -- System.PolyORB_Interface
      RE_TC_Any,                          -- System.PolyORB_Interface
      RE_TC_AD,                           -- System.PolyORB_Interface
@@ -1219,6 +1252,7 @@ package Rtsfind is
      RE_Integer_Address,                 -- System.Storage_Elements
      RE_Storage_Offset,                  -- System.Storage_Elements
      RE_Storage_Array,                   -- System.Storage_Elements
+     RE_Storage_Element,                 -- System.Storage_Elements
      RE_To_Address,                      -- System.Storage_Elements
 
      RE_Root_Storage_Pool,               -- System.Storage_Pools
@@ -1291,6 +1325,7 @@ package Rtsfind is
      RE_Task_Procedure_Access,           -- System.Tasking
 
      RO_ST_Task_Id,                      -- System.Tasking
+     RO_ST_Null_Task,                    -- System.Tasking
 
      RE_Call_Modes,                      -- System.Tasking
      RE_Simple_Call,                     -- System.Tasking
@@ -1417,6 +1452,8 @@ package Rtsfind is
      RE_Le_G,                            -- System.Vax_Float_Operations
      RE_Lt_F,                            -- System.Vax_Float_Operations
      RE_Lt_G,                            -- System.Vax_Float_Operations
+     RE_Ne_F,                            -- System.Vax_Float_Operations
+     RE_Ne_G,                            -- System.Vax_Float_Operations
 
      RE_Valid_D,                         -- System.Vax_Float_Operations
      RE_Valid_F,                         -- System.Vax_Float_Operations
@@ -1602,6 +1639,7 @@ package Rtsfind is
      RE_Get_Access_Level                 => Ada_Tags,
      RE_Get_Entry_Index                  => Ada_Tags,
      RE_Get_External_Tag                 => Ada_Tags,
+     RE_Get_Offset_Index                 => Ada_Tags,
      RE_Get_Prim_Op_Address              => Ada_Tags,
      RE_Get_Prim_Op_Kind                 => Ada_Tags,
      RE_Get_RC_Offset                    => Ada_Tags,
@@ -1610,25 +1648,32 @@ package Rtsfind is
      RE_Inherit_TSD                      => Ada_Tags,
      RE_Internal_Tag                     => Ada_Tags,
      RE_Is_Descendant_At_Same_Level      => Ada_Tags,
+     RE_Object_Specific_Data             => Ada_Tags,
      RE_POK_Function                     => Ada_Tags,
      RE_POK_Procedure                    => Ada_Tags,
      RE_POK_Protected_Entry              => Ada_Tags,
      RE_POK_Protected_Function           => Ada_Tags,
      RE_POK_Protected_Procedure          => Ada_Tags,
      RE_POK_Task_Entry                   => Ada_Tags,
+     RE_POK_Task_Function                => Ada_Tags,
      RE_POK_Task_Procedure               => Ada_Tags,
      RE_Prim_Op_Kind                     => Ada_Tags,
      RE_Register_Interface_Tag           => Ada_Tags,
      RE_Register_Tag                     => Ada_Tags,
+     RE_Select_Specific_Data             => Ada_Tags,
      RE_Set_Access_Level                 => Ada_Tags,
      RE_Set_Entry_Index                  => Ada_Tags,
      RE_Set_Expanded_Name                => Ada_Tags,
      RE_Set_External_Tag                 => Ada_Tags,
+     RE_Set_Num_Prim_Ops                 => Ada_Tags,
+     RE_Set_Offset_Index                 => Ada_Tags,
      RE_Set_Offset_To_Top                => Ada_Tags,
+     RE_Set_OSD                          => Ada_Tags,
      RE_Set_Prim_Op_Address              => Ada_Tags,
      RE_Set_Prim_Op_Kind                 => Ada_Tags,
      RE_Set_RC_Offset                    => Ada_Tags,
      RE_Set_Remotely_Callable            => Ada_Tags,
+     RE_Set_SSD                          => Ada_Tags,
      RE_Set_TSD                          => Ada_Tags,
      RE_Tag_Error                        => Ada_Tags,
      RE_TSD_Entry_Size                   => Ada_Tags,
@@ -1636,6 +1681,10 @@ package Rtsfind is
      RE_Interface_Tag                    => Ada_Tags,
      RE_Tag                              => Ada_Tags,
      RE_Address_Array                    => Ada_Tags,
+     RE_Valid_Signature                  => Ada_Tags,
+     RE_Primary_DT                       => Ada_Tags,
+     RE_Secondary_DT                     => Ada_Tags,
+     RE_Abstract_Interface               => Ada_Tags,
 
      RE_Abort_Task                       => Ada_Task_Identification,
      RE_Current_Task                     => Ada_Task_Identification,
@@ -1773,13 +1822,28 @@ package Rtsfind is
 
      RE_Exp_Unsigned                     => System_Exp_Uns,
 
-     RE_Fat_Float                        => System_Fat_Flt,
+     RE_Attr_Float                       => System_Fat_Flt,
+
+     RE_Attr_IEEE_Long                   => System_Fat_IEEE_Long_Float,
+     RE_Fat_IEEE_Long                    => System_Fat_IEEE_Long_Float,
+
+     RE_Attr_IEEE_Short                  => System_Fat_IEEE_Short_Float,
+     RE_Fat_IEEE_Short                   => System_Fat_IEEE_Short_Float,
+
+     RE_Attr_Long_Float                  => System_Fat_LFlt,
+
+     RE_Attr_Long_Long_Float             => System_Fat_LLF,
+
+     RE_Attr_Short_Float                 => System_Fat_SFlt,
 
-     RE_Fat_Long_Float                   => System_Fat_LFlt,
+     RE_Attr_VAX_D_Float                 => System_Fat_VAX_D_Float,
+     RE_Fat_VAX_D                        => System_Fat_VAX_D_Float,
 
-     RE_Fat_Long_Long_Float              => System_Fat_LLF,
+     RE_Attr_VAX_F_Float                 => System_Fat_VAX_F_Float,
+     RE_Fat_VAX_F                        => System_Fat_VAX_F_Float,
 
-     RE_Fat_Short_Float                  => System_Fat_SFlt,
+     RE_Attr_VAX_G_Float                 => System_Fat_VAX_G_Float,
+     RE_Fat_VAX_G                        => System_Fat_VAX_G_Float,
 
      RE_Attach_To_Final_List             => System_Finalization_Implementation,
      RE_Finalize_List                    => System_Finalization_Implementation,
@@ -2249,6 +2313,7 @@ package Rtsfind is
 
      RE_TC_Alias                         => System_PolyORB_Interface,
      RE_TC_Build                         => System_PolyORB_Interface,
+     RE_Get_TC                           => System_PolyORB_Interface,
      RE_Set_TC                           => System_PolyORB_Interface,
      RE_TC_Any                           => System_PolyORB_Interface,
      RE_TC_AD                            => System_PolyORB_Interface,
@@ -2326,6 +2391,7 @@ package Rtsfind is
      RE_Integer_Address                  => System_Storage_Elements,
      RE_Storage_Offset                   => System_Storage_Elements,
      RE_Storage_Array                    => System_Storage_Elements,
+     RE_Storage_Element                  => System_Storage_Elements,
      RE_To_Address                       => System_Storage_Elements,
 
      RE_Root_Storage_Pool                => System_Storage_Pools,
@@ -2397,6 +2463,7 @@ package Rtsfind is
      RE_Task_Procedure_Access            => System_Tasking,
 
      RO_ST_Task_Id                       => System_Tasking,
+     RO_ST_Null_Task                     => System_Tasking,
 
      RE_Call_Modes                       => System_Tasking,
      RE_Simple_Call                      => System_Tasking,
@@ -2523,6 +2590,8 @@ package Rtsfind is
      RE_Le_G                             => System_Vax_Float_Operations,
      RE_Lt_F                             => System_Vax_Float_Operations,
      RE_Lt_G                             => System_Vax_Float_Operations,
+     RE_Ne_F                             => System_Vax_Float_Operations,
+     RE_Ne_G                             => System_Vax_Float_Operations,
 
      RE_Valid_D                          => System_Vax_Float_Operations,
      RE_Valid_F                          => System_Vax_Float_Operations,
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 190706c..c49bed3 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -28,7 +28,7 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
-with Exp_Ch9;
+with Exp_Ch9;  use Exp_Ch9;
 with Elists;   use Elists;
 with Freeze;   use Freeze;
 with Itypes;   use Itypes;
@@ -94,11 +94,22 @@ package body Sem_Ch9 is
       while Present (T_Name) loop
          Analyze (T_Name);
 
-         if not Is_Task_Type (Etype (T_Name)) then
-            Error_Msg_N ("expect task name for ABORT", T_Name);
-            return;
-         else
+         if Is_Task_Type (Etype (T_Name))
+           or else (Ada_Version >= Ada_05
+                      and then Ekind (Etype (T_Name)) = E_Class_Wide_Type
+                      and then Is_Interface (Etype (T_Name))
+                      and then Is_Task_Interface (Etype (T_Name)))
+         then
             Resolve (T_Name);
+         else
+            if Ada_Version >= Ada_05 then
+               Error_Msg_N ("expect task name or task interface class-wide "
+                          & "object for ABORT", T_Name);
+            else
+               Error_Msg_N ("expect task name for ABORT", T_Name);
+            end if;
+
+            return;
          end if;
 
          Next (T_Name);
@@ -298,9 +309,7 @@ package body Sem_Ch9 is
 
          begin
             E1 := First_Entity (Current_Scope);
-
             while Present (E1) loop
-
                if Ekind (E1) = E_Procedure
                  and then Chars (E1) = Chars (Entry_Nam)
                  and then Type_Conformant (E1, Entry_Nam)
@@ -368,7 +377,6 @@ package body Sem_Ch9 is
 
          begin
             Decl := First (Declarations (N));
-
             while Present (Decl) loop
                Analyze (Decl);
 
@@ -390,6 +398,7 @@ package body Sem_Ch9 is
       --  In the case of a select alternative of a selective accept,
       --  the expander references the address declaration even if there
       --  is no statement list.
+
       --  We also need to create the renaming declarations for the local
       --  variables that will replace references to the formals within
       --  the accept.
@@ -440,14 +449,49 @@ package body Sem_Ch9 is
    ---------------------------------
 
    procedure Analyze_Asynchronous_Select (N : Node_Id) is
+      Param   : Node_Id;
+      Trigger : Node_Id;
+
    begin
       Tasking_Used := True;
       Check_Restriction (Max_Asynchronous_Select_Nesting, N);
       Check_Restriction (No_Select_Statements, N);
 
-      --  Analyze the statements. We analyze statements in the abortable part
-      --  first, because this is the section that is executed first, and that
-      --  way our remembering of saved values and checks is accurate.
+      if Ada_Version >= Ada_05 then
+         Trigger := Triggering_Statement (Triggering_Alternative (N));
+
+         Analyze (Trigger);
+
+         --  The trigger is a dispatching procedure. Postpone the analysis
+         --  of the triggering and abortable statements until the expansion
+         --  of this asynchronous select in Expand_N_Asynchronous_Select.
+         --  This action is required since the code replication in Expand-
+         --  _N_Asynchronous_Select of an already analyzed statement list
+         --  causes Gigi aborts.
+
+         if Expander_Active
+           and then Nkind (Trigger) = N_Procedure_Call_Statement
+           and then Present (Parameter_Associations (Trigger))
+         then
+            Param := First (Parameter_Associations (Trigger));
+
+            if Is_Controlling_Actual (Param)
+              and then Is_Interface (Etype (Param))
+            then
+               if Is_Limited_Record (Etype (Param)) then
+                  return;
+               else
+                  Error_Msg_N
+                   ("dispatching operation of limited or synchronized " &
+                    "interface required ('R'M 9.7.2(3))!", N);
+               end if;
+            end if;
+         end if;
+      end if;
+
+      --  Analyze the statements. We analyze statements in the abortable part,
+      --  because this is the section that is executed first, and that way our
+      --  remembering of saved values and checks is accurate.
 
       Analyze_Statements (Statements (Abortable_Part (N)));
       Analyze (Triggering_Alternative (N));
@@ -462,6 +506,16 @@ package body Sem_Ch9 is
       Check_Restriction (No_Select_Statements, N);
       Tasking_Used := True;
       Analyze (Entry_Call_Alternative (N));
+
+      if List_Length (Else_Statements (N)) = 1
+        and then Nkind (First (Else_Statements (N))) in N_Delay_Statement
+      then
+         Error_Msg_N
+           ("suspicious form of conditional entry call?", N);
+         Error_Msg_N
+           ("\`SELECT OR` may be intended rather than `SELECT ELSE`", N);
+      end if;
+
       Analyze_Statements (Else_Statements (N));
    end Analyze_Conditional_Entry_Call;
 
@@ -491,19 +545,19 @@ package body Sem_Ch9 is
 
          if Nkind (Delay_Statement (N)) = N_Delay_Relative_Statement then
             Pre_Analyze_And_Resolve (Expr, Standard_Duration);
-
          else
             Pre_Analyze_And_Resolve (Expr);
          end if;
 
-         if Nkind (Delay_Statement (N)) = N_Delay_Until_Statement and then
-            not Is_RTE (Base_Type (Etype (Expr)), RO_CA_Time)     and then
-            not Is_RTE (Base_Type (Etype (Expr)), RO_RT_Time)
+         if Nkind (Delay_Statement (N)) = N_Delay_Until_Statement
+           and then not Is_RTE (Base_Type (Etype (Expr)), RO_CA_Time)
+           and then not Is_RTE (Base_Type (Etype (Expr)), RO_RT_Time)
          then
             Error_Msg_N ("expect Time types for `DELAY UNTIL`", Expr);
          end if;
 
          Check_Restriction (No_Fixed_Point, Expr);
+
       else
          Analyze (Delay_Statement (N));
       end if;
@@ -632,7 +686,13 @@ package body Sem_Ch9 is
                      then
                         Set_Etype (Def, Empty);
                         Set_Analyzed (Def, False);
-                        Set_Discrete_Subtype_Definition (Index_Spec, Def);
+
+                        --  Keep the original subtree to ensure tree is
+                        --  properly formed (e.g. for ASIS use)
+
+                        Rewrite
+                          (Discrete_Subtype_Definition (Index_Spec), Def);
+
                         Set_Analyzed (Low_Bound (Def), False);
                         Set_Analyzed (High_Bound (Def), False);
 
@@ -683,12 +743,16 @@ package body Sem_Ch9 is
       --  The entity for the protected subprogram corresponding to the entry
       --  has been created. We retain the name of this entity in the entry
       --  body, for use when the corresponding subprogram body is created.
-      --  Note that entry bodies have to corresponding_spec, and there is no
+      --  Note that entry bodies have no corresponding_spec, and there is no
       --  easy link back in the tree between the entry body and the entity for
-      --  the entry itself.
+      --  the entry itself, which is why we must propagate some attributes
+      --  explicitly from spec to body.
 
-      Set_Protected_Body_Subprogram (Id,
-        Protected_Body_Subprogram (Entry_Name));
+      Set_Protected_Body_Subprogram
+        (Id, Protected_Body_Subprogram (Entry_Name));
+
+      Set_Entry_Parameters_Type
+        (Id, Entry_Parameters_Type (Entry_Name));
 
       if Present (Decls) then
          Analyze_Declarations (Decls);
@@ -707,6 +771,9 @@ package body Sem_Ch9 is
 
       --  At the same time, we set the flags on the spec entities to suppress
       --  any warnings on the spec formals, since we also scan the spec.
+      --  Finally, we propagate the Entry_Component attribute to the body
+      --  formals, for use in the renaming declarations created later for the
+      --  formals (see exp_ch9.Add_Formal_Renamings).
 
       declare
          E1  : Entity_Id;
@@ -736,6 +803,7 @@ package body Sem_Ch9 is
 
             Set_Referenced (E2, Referenced (E1));
             Set_Referenced (E1);
+            Set_Entry_Component (E2, Entry_Component (E1));
 
          <<Continue>>
             Next_Entity (E1);
@@ -1011,9 +1079,7 @@ package body Sem_Ch9 is
       end if;
 
       E := First_Entity (Current_Scope);
-
       while Present (E) loop
-
          if Ekind (E) = E_Function
            or else Ekind (E) = E_Procedure
          then
@@ -1072,8 +1138,9 @@ package body Sem_Ch9 is
       --  Ada 2005 (AI-345)
 
       if Present (Interface_List (N)) then
-         Iface := First (Interface_List (N));
+         Set_Is_Tagged_Type (T);
 
+         Iface := First (Interface_List (N));
          while Present (Iface) loop
             Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
             Iface_Def := Type_Definition (Parent (Iface_Typ));
@@ -1147,7 +1214,6 @@ package body Sem_Ch9 is
       --  illegal uses. Now it can be set correctly.
 
       E := First_Entity (Current_Scope);
-
       while Present (E) loop
          if Ekind (E) = E_Void then
             Set_Ekind (E, E_Component);
@@ -1254,14 +1320,13 @@ package body Sem_Ch9 is
       --  Overloaded case, find right interpretation
 
       if Is_Overloaded (Entry_Name) then
-         Get_First_Interp (Entry_Name, I, It);
          Entry_Id := Empty;
 
+         Get_First_Interp (Entry_Name, I, It);
          while Present (It.Nam) loop
             if No (First_Formal (It.Nam))
               or else Subtype_Conformant (Enclosing, It.Nam)
             then
-
                --  Ada 2005 (AI-345): Since protected and task types have
                --  primitive entry wrappers, we only consider source entries.
 
@@ -1348,9 +1413,10 @@ package body Sem_Ch9 is
             --  Processing for parameters accessed by the requeue
 
             declare
-               Ent : Entity_Id := First_Formal (Enclosing);
+               Ent : Entity_Id;
 
             begin
+               Ent := First_Formal (Enclosing);
                while Present (Ent) loop
 
                   --  For OUT or IN OUT parameter, the effect of the requeue
@@ -1399,6 +1465,8 @@ package body Sem_Ch9 is
       Check_Restriction (No_Select_Statements, N);
       Tasking_Used := True;
 
+      --  Loop to analyze alternatives
+
       Alt := First (Alts);
       while Present (Alt) loop
          Alt_Count := Alt_Count + 1;
@@ -1716,7 +1784,6 @@ package body Sem_Ch9 is
 
       begin
          Ent := First_Entity (Spec_Id);
-
          while Present (Ent) loop
             if Is_Entry (Ent)
               and then not Entry_Accepted (Ent)
@@ -1799,6 +1866,8 @@ package body Sem_Ch9 is
       --  Ada 2005 (AI-345)
 
       if Present (Interface_List (N)) then
+         Set_Is_Tagged_Type (T);
+
          Iface := First (Interface_List (N));
          while Present (Iface) loop
             Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
@@ -1919,21 +1988,20 @@ package body Sem_Ch9 is
       end if;
 
       Analyze (Trigger);
+
       if Comes_From_Source (Trigger)
-        and then Nkind (Trigger) /= N_Delay_Until_Statement
-        and then Nkind (Trigger) /= N_Delay_Relative_Statement
+        and then Nkind (Trigger) not in N_Delay_Statement
         and then Nkind (Trigger) /= N_Entry_Call_Statement
       then
          if Ada_Version < Ada_05 then
             Error_Msg_N
              ("triggering statement must be delay or entry call", Trigger);
 
-         --  Ada 2005 (AI-345): If a procedure_call_statement is used
-         --  for a procedure_or_entry_call, the procedure_name or pro-
-         --  cedure_prefix of the procedure_call_statement shall denote
-         --  an entry renamed by a procedure, or (a view of) a primitive
-         --  subprogram of a limited interface whose first parameter is
-         --  a controlling parameter.
+         --  Ada 2005 (AI-345): If a procedure_call_statement is used for a
+         --  procedure_or_entry_call, the procedure_name or pro- cedure_prefix
+         --  of the procedure_call_statement shall denote an entry renamed by a
+         --  procedure, or (a view of) a primitive subprogram of a limited
+         --  interface whose first parameter is a controlling parameter.
 
          elsif Nkind (Trigger) = N_Procedure_Call_Statement
            and then not Is_Renamed_Entry (Entity (Name (Trigger)))
@@ -2089,7 +2157,6 @@ package body Sem_Ch9 is
 
          begin
             Ent := First (Ifaces);
-
             while Present (Ent) loop
                if Etype (Ent) = Iface then
                   return True;
@@ -2119,14 +2186,13 @@ package body Sem_Ch9 is
 
          Entry_Param := First (Entry_Params);
          Proc_Param  := Next (Proc_Param);
-         while Present (Entry_Param)
-           and then Present (Proc_Param)
-         loop
+         while Present (Entry_Param) and then Present (Proc_Param) loop
+
             --  The two parameters must be mode conformant and have the exact
             --  same types.
 
-            if In_Present (Entry_Param) /= In_Present (Proc_Param)
-              or else Out_Present (Entry_Param) /= Out_Present (Proc_Param)
+            if Ekind (Defining_Identifier (Entry_Param)) /=
+               Ekind (Defining_Identifier (Proc_Param))
               or else Etype (Parameter_Type (Entry_Param)) /=
                       Etype (Parameter_Type (Proc_Param))
             then
@@ -2177,7 +2243,6 @@ package body Sem_Ch9 is
                               Null_Present (Parent (Hom)))
                   then
                      Aliased_Hom := Hom;
-
                      while Present (Alias (Aliased_Hom)) loop
                         Aliased_Hom := Alias (Aliased_Hom);
                      end loop;
@@ -2274,7 +2339,6 @@ package body Sem_Ch9 is
 
       else
          Decl := First (Vis_Decls);
-
          while Present (Decl) loop
             if Nkind (Decl) = N_Entry_Declaration
               and then Must_Override (Decl)
@@ -2322,7 +2386,6 @@ package body Sem_Ch9 is
 
    begin
       E := First_Entity (Spec);
-
       while Present (E) loop
          Prev := Current_Entity (E);
          Set_Current_Entity (E);
diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb
index 4993c64..c1ca4dd 100644
--- a/gcc/ada/snames.adb
+++ b/gcc/ada/snames.adb
@@ -93,6 +93,7 @@ package body Snames is
      "_disp_conditional_select#" &
      "_disp_get_prim_op_kind#" &
      "_disp_timed_select#" &
+     "_disp_get_task_id#" &
      "initialize#" &
      "adjust#" &
      "finalize#" &
@@ -458,6 +459,7 @@ package body Snames is
      "machine_mantissa#" &
      "machine_overflows#" &
      "machine_radix#" &
+     "machine_rounding#" &
      "machine_rounds#" &
      "machine_size#" &
      "mantissa#" &
@@ -639,6 +641,7 @@ package body Snames is
      "unchecked_conversion#" &
      "unchecked_deallocation#" &
      "to_pointer#" &
+     "free#" &
      "abstract#" &
      "aliased#" &
      "protected#" &
@@ -674,6 +677,7 @@ package body Snames is
      "include_option#" &
      "language_processing#" &
      "languages#" &
+     "library_ali_dir#" &
      "library_dir#" &
      "library_auto_init#" &
      "library_gcc#" &
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads
index 6cdb344..caa31e3 100644
--- a/gcc/ada/snames.ads
+++ b/gcc/ada/snames.ads
@@ -67,63 +67,63 @@ package Snames is
    --  The lower case letter entries are used for one character identifiers
    --  appearing in the source, for example in pragma Interface (C).
 
-   Name_A         : constant Name_Id := First_Name_Id + Character'Pos ('a');
-   Name_B         : constant Name_Id := First_Name_Id + Character'Pos ('b');
-   Name_C         : constant Name_Id := First_Name_Id + Character'Pos ('c');
-   Name_D         : constant Name_Id := First_Name_Id + Character'Pos ('d');
-   Name_E         : constant Name_Id := First_Name_Id + Character'Pos ('e');
-   Name_F         : constant Name_Id := First_Name_Id + Character'Pos ('f');
-   Name_G         : constant Name_Id := First_Name_Id + Character'Pos ('g');
-   Name_H         : constant Name_Id := First_Name_Id + Character'Pos ('h');
-   Name_I         : constant Name_Id := First_Name_Id + Character'Pos ('i');
-   Name_J         : constant Name_Id := First_Name_Id + Character'Pos ('j');
-   Name_K         : constant Name_Id := First_Name_Id + Character'Pos ('k');
-   Name_L         : constant Name_Id := First_Name_Id + Character'Pos ('l');
-   Name_M         : constant Name_Id := First_Name_Id + Character'Pos ('m');
-   Name_N         : constant Name_Id := First_Name_Id + Character'Pos ('n');
-   Name_O         : constant Name_Id := First_Name_Id + Character'Pos ('o');
-   Name_P         : constant Name_Id := First_Name_Id + Character'Pos ('p');
-   Name_Q         : constant Name_Id := First_Name_Id + Character'Pos ('q');
-   Name_R         : constant Name_Id := First_Name_Id + Character'Pos ('r');
-   Name_S         : constant Name_Id := First_Name_Id + Character'Pos ('s');
-   Name_T         : constant Name_Id := First_Name_Id + Character'Pos ('t');
-   Name_U         : constant Name_Id := First_Name_Id + Character'Pos ('u');
-   Name_V         : constant Name_Id := First_Name_Id + Character'Pos ('v');
-   Name_W         : constant Name_Id := First_Name_Id + Character'Pos ('w');
-   Name_X         : constant Name_Id := First_Name_Id + Character'Pos ('x');
-   Name_Y         : constant Name_Id := First_Name_Id + Character'Pos ('y');
-   Name_Z         : constant Name_Id := First_Name_Id + Character'Pos ('z');
+   Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a');
+   Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b');
+   Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c');
+   Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d');
+   Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e');
+   Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f');
+   Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g');
+   Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h');
+   Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i');
+   Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j');
+   Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k');
+   Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l');
+   Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m');
+   Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n');
+   Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o');
+   Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p');
+   Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q');
+   Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r');
+   Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s');
+   Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t');
+   Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u');
+   Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v');
+   Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w');
+   Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x');
+   Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y');
+   Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z');
 
    --  The upper case letter entries are used by expander code for local
    --  variables that do not require unique names (e.g. formal parameter
    --  names in constructed procedures)
 
-   Name_uA        : constant Name_Id := First_Name_Id + Character'Pos ('A');
-   Name_uB        : constant Name_Id := First_Name_Id + Character'Pos ('B');
-   Name_uC        : constant Name_Id := First_Name_Id + Character'Pos ('C');
-   Name_uD        : constant Name_Id := First_Name_Id + Character'Pos ('D');
-   Name_uE        : constant Name_Id := First_Name_Id + Character'Pos ('E');
-   Name_uF        : constant Name_Id := First_Name_Id + Character'Pos ('F');
-   Name_uG        : constant Name_Id := First_Name_Id + Character'Pos ('G');
-   Name_uH        : constant Name_Id := First_Name_Id + Character'Pos ('H');
-   Name_uI        : constant Name_Id := First_Name_Id + Character'Pos ('I');
-   Name_uJ        : constant Name_Id := First_Name_Id + Character'Pos ('J');
-   Name_uK        : constant Name_Id := First_Name_Id + Character'Pos ('K');
-   Name_uL        : constant Name_Id := First_Name_Id + Character'Pos ('L');
-   Name_uM        : constant Name_Id := First_Name_Id + Character'Pos ('M');
-   Name_uN        : constant Name_Id := First_Name_Id + Character'Pos ('N');
-   Name_uO        : constant Name_Id := First_Name_Id + Character'Pos ('O');
-   Name_uP        : constant Name_Id := First_Name_Id + Character'Pos ('P');
-   Name_uQ        : constant Name_Id := First_Name_Id + Character'Pos ('Q');
-   Name_uR        : constant Name_Id := First_Name_Id + Character'Pos ('R');
-   Name_uS        : constant Name_Id := First_Name_Id + Character'Pos ('S');
-   Name_uT        : constant Name_Id := First_Name_Id + Character'Pos ('T');
-   Name_uU        : constant Name_Id := First_Name_Id + Character'Pos ('U');
-   Name_uV        : constant Name_Id := First_Name_Id + Character'Pos ('V');
-   Name_uW        : constant Name_Id := First_Name_Id + Character'Pos ('W');
-   Name_uX        : constant Name_Id := First_Name_Id + Character'Pos ('X');
-   Name_uY        : constant Name_Id := First_Name_Id + Character'Pos ('Y');
-   Name_uZ        : constant Name_Id := First_Name_Id + Character'Pos ('Z');
+   Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A');
+   Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B');
+   Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C');
+   Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D');
+   Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E');
+   Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F');
+   Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G');
+   Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H');
+   Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I');
+   Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J');
+   Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K');
+   Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L');
+   Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M');
+   Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N');
+   Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O');
+   Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P');
+   Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q');
+   Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R');
+   Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S');
+   Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T');
+   Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U');
+   Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V');
+   Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W');
+   Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X');
+   Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
+   Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
 
    --  Note: the following table is read by the utility program XSNAMES and
    --  its format should not be changed without coordinating with this program.
@@ -181,127 +181,132 @@ package Snames is
    Name_uDisp_Get_Prim_Op_Kind         : constant Name_Id := N + 034;
    Name_uDisp_Timed_Select             : constant Name_Id := N + 035;
 
+   --  Names of routines used in the expansion of Abort, attributes 'Callable
+   --  and 'Terminated for task interface class-wide types.
+
+   Name_uDisp_Get_Task_Id              : constant Name_Id := N + 036;
+
    --  Names of routines in Ada.Finalization, needed by expander
 
-   Name_Initialize                     : constant Name_Id := N + 036;
-   Name_Adjust                         : constant Name_Id := N + 037;
-   Name_Finalize                       : constant Name_Id := N + 038;
+   Name_Initialize                     : constant Name_Id := N + 037;
+   Name_Adjust                         : constant Name_Id := N + 038;
+   Name_Finalize                       : constant Name_Id := N + 039;
 
    --  Names of fields declared in System.Finalization_Implementation,
    --  needed by the expander when generating code for finalization.
 
-   Name_Next                           : constant Name_Id := N + 039;
-   Name_Prev                           : constant Name_Id := N + 040;
+   Name_Next                           : constant Name_Id := N + 040;
+   Name_Prev                           : constant Name_Id := N + 041;
 
    --  Names of TSS routines for implementation of DSA over PolyORB
 
-   Name_uTypeCode                      : constant Name_Id := N + 041;
-   Name_uFrom_Any                      : constant Name_Id := N + 042;
-   Name_uTo_Any                        : constant Name_Id := N + 043;
+   Name_uTypeCode                      : constant Name_Id := N + 042;
+   Name_uFrom_Any                      : constant Name_Id := N + 043;
+   Name_uTo_Any                        : constant Name_Id := N + 044;
 
    --  Names of allocation routines, also needed by expander
 
-   Name_Allocate                       : constant Name_Id := N + 044;
-   Name_Deallocate                     : constant Name_Id := N + 045;
-   Name_Dereference                    : constant Name_Id := N + 046;
+   Name_Allocate                       : constant Name_Id := N + 045;
+   Name_Deallocate                     : constant Name_Id := N + 046;
+   Name_Dereference                    : constant Name_Id := N + 047;
 
    --  Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
 
-   First_Text_IO_Package               : constant Name_Id := N + 047;
-   Name_Decimal_IO                     : constant Name_Id := N + 047;
-   Name_Enumeration_IO                 : constant Name_Id := N + 048;
-   Name_Fixed_IO                       : constant Name_Id := N + 049;
-   Name_Float_IO                       : constant Name_Id := N + 050;
-   Name_Integer_IO                     : constant Name_Id := N + 051;
-   Name_Modular_IO                     : constant Name_Id := N + 052;
-   Last_Text_IO_Package                : constant Name_Id := N + 052;
+   First_Text_IO_Package               : constant Name_Id := N + 048;
+   Name_Decimal_IO                     : constant Name_Id := N + 048;
+   Name_Enumeration_IO                 : constant Name_Id := N + 049;
+   Name_Fixed_IO                       : constant Name_Id := N + 050;
+   Name_Float_IO                       : constant Name_Id := N + 051;
+   Name_Integer_IO                     : constant Name_Id := N + 052;
+   Name_Modular_IO                     : constant Name_Id := N + 053;
+   Last_Text_IO_Package                : constant Name_Id := N + 053;
 
    subtype Text_IO_Package_Name is Name_Id
      range First_Text_IO_Package .. Last_Text_IO_Package;
 
    --  Some miscellaneous names used for error detection/recovery
 
-   Name_Const                          : constant Name_Id := N + 053;
-   Name_Error                          : constant Name_Id := N + 054;
-   Name_Go                             : constant Name_Id := N + 055;
-   Name_Put                            : constant Name_Id := N + 056;
-   Name_Put_Line                       : constant Name_Id := N + 057;
-   Name_To                             : constant Name_Id := N + 058;
+   Name_Const                          : constant Name_Id := N + 054;
+   Name_Error                          : constant Name_Id := N + 055;
+   Name_Go                             : constant Name_Id := N + 056;
+   Name_Put                            : constant Name_Id := N + 057;
+   Name_Put_Line                       : constant Name_Id := N + 058;
+   Name_To                             : constant Name_Id := N + 059;
 
    --  Names for packages that are treated specially by the compiler
 
-   Name_Finalization                   : constant Name_Id := N + 059;
-   Name_Finalization_Root              : constant Name_Id := N + 060;
-   Name_Interfaces                     : constant Name_Id := N + 061;
-   Name_Standard                       : constant Name_Id := N + 062;
-   Name_System                         : constant Name_Id := N + 063;
-   Name_Text_IO                        : constant Name_Id := N + 064;
-   Name_Wide_Text_IO                   : constant Name_Id := N + 065;
-   Name_Wide_Wide_Text_IO              : constant Name_Id := N + 066;
+   Name_Finalization                   : constant Name_Id := N + 060;
+   Name_Finalization_Root              : constant Name_Id := N + 061;
+   Name_Interfaces                     : constant Name_Id := N + 062;
+   Name_Standard                       : constant Name_Id := N + 063;
+   Name_System                         : constant Name_Id := N + 064;
+   Name_Text_IO                        : constant Name_Id := N + 065;
+   Name_Wide_Text_IO                   : constant Name_Id := N + 066;
+   Name_Wide_Wide_Text_IO              : constant Name_Id := N + 067;
 
    --  Names of implementations of the distributed systems annex
 
-   First_PCS_Name                      : constant Name_Id := N + 067;
-   Name_No_DSA                         : constant Name_Id := N + 067;
-   Name_GARLIC_DSA                     : constant Name_Id := N + 068;
-   Name_PolyORB_DSA                    : constant Name_Id := N + 069;
-   Last_PCS_Name                       : constant Name_Id := N + 069;
+   First_PCS_Name                      : constant Name_Id := N + 068;
+   Name_No_DSA                         : constant Name_Id := N + 068;
+   Name_GARLIC_DSA                     : constant Name_Id := N + 069;
+   Name_PolyORB_DSA                    : constant Name_Id := N + 070;
+   Last_PCS_Name                       : constant Name_Id := N + 070;
 
    subtype PCS_Names is Name_Id
      range First_PCS_Name .. Last_PCS_Name;
 
    --  Names of identifiers used in expanding distribution stubs
 
-   Name_Addr                           : constant Name_Id := N + 070;
-   Name_Async                          : constant Name_Id := N + 071;
-   Name_Get_Active_Partition_ID        : constant Name_Id := N + 072;
-   Name_Get_RCI_Package_Receiver       : constant Name_Id := N + 073;
-   Name_Get_RCI_Package_Ref            : constant Name_Id := N + 074;
-   Name_Origin                         : constant Name_Id := N + 075;
-   Name_Params                         : constant Name_Id := N + 076;
-   Name_Partition                      : constant Name_Id := N + 077;
-   Name_Partition_Interface            : constant Name_Id := N + 078;
-   Name_Ras                            : constant Name_Id := N + 079;
-   Name_Call                           : constant Name_Id := N + 080;
-   Name_RCI_Name                       : constant Name_Id := N + 081;
-   Name_Receiver                       : constant Name_Id := N + 082;
-   Name_Result                         : constant Name_Id := N + 083;
-   Name_Rpc                            : constant Name_Id := N + 084;
-   Name_Subp_Id                        : constant Name_Id := N + 085;
-   Name_Operation                      : constant Name_Id := N + 086;
-   Name_Argument                       : constant Name_Id := N + 087;
-   Name_Arg_Modes                      : constant Name_Id := N + 088;
-   Name_Handler                        : constant Name_Id := N + 089;
-   Name_Target                         : constant Name_Id := N + 090;
-   Name_Req                            : constant Name_Id := N + 091;
-   Name_Obj_TypeCode                   : constant Name_Id := N + 092;
-   Name_Stub                           : constant Name_Id := N + 093;
+   Name_Addr                           : constant Name_Id := N + 071;
+   Name_Async                          : constant Name_Id := N + 072;
+   Name_Get_Active_Partition_ID        : constant Name_Id := N + 073;
+   Name_Get_RCI_Package_Receiver       : constant Name_Id := N + 074;
+   Name_Get_RCI_Package_Ref            : constant Name_Id := N + 075;
+   Name_Origin                         : constant Name_Id := N + 076;
+   Name_Params                         : constant Name_Id := N + 077;
+   Name_Partition                      : constant Name_Id := N + 078;
+   Name_Partition_Interface            : constant Name_Id := N + 079;
+   Name_Ras                            : constant Name_Id := N + 080;
+   Name_Call                           : constant Name_Id := N + 081;
+   Name_RCI_Name                       : constant Name_Id := N + 082;
+   Name_Receiver                       : constant Name_Id := N + 083;
+   Name_Result                         : constant Name_Id := N + 084;
+   Name_Rpc                            : constant Name_Id := N + 085;
+   Name_Subp_Id                        : constant Name_Id := N + 086;
+   Name_Operation                      : constant Name_Id := N + 087;
+   Name_Argument                       : constant Name_Id := N + 088;
+   Name_Arg_Modes                      : constant Name_Id := N + 089;
+   Name_Handler                        : constant Name_Id := N + 090;
+   Name_Target                         : constant Name_Id := N + 091;
+   Name_Req                            : constant Name_Id := N + 092;
+   Name_Obj_TypeCode                   : constant Name_Id := N + 093;
+   Name_Stub                           : constant Name_Id := N + 094;
 
    --  Operator Symbol entries. The actual names have an upper case O at
    --  the start in place of the Op_ prefix (e.g. the actual name that
    --  corresponds to Name_Op_Abs is "Oabs".
 
-   First_Operator_Name                 : constant Name_Id := N + 094;
-   Name_Op_Abs                         : constant Name_Id := N + 094; -- "abs"
-   Name_Op_And                         : constant Name_Id := N + 095; -- "and"
-   Name_Op_Mod                         : constant Name_Id := N + 096; -- "mod"
-   Name_Op_Not                         : constant Name_Id := N + 097; -- "not"
-   Name_Op_Or                          : constant Name_Id := N + 098; -- "or"
-   Name_Op_Rem                         : constant Name_Id := N + 099; -- "rem"
-   Name_Op_Xor                         : constant Name_Id := N + 100; -- "xor"
-   Name_Op_Eq                          : constant Name_Id := N + 101; -- "="
-   Name_Op_Ne                          : constant Name_Id := N + 102; -- "/="
-   Name_Op_Lt                          : constant Name_Id := N + 103; -- "<"
-   Name_Op_Le                          : constant Name_Id := N + 104; -- "<="
-   Name_Op_Gt                          : constant Name_Id := N + 105; -- ">"
-   Name_Op_Ge                          : constant Name_Id := N + 106; -- ">="
-   Name_Op_Add                         : constant Name_Id := N + 107; -- "+"
-   Name_Op_Subtract                    : constant Name_Id := N + 108; -- "-"
-   Name_Op_Concat                      : constant Name_Id := N + 109; -- "&"
-   Name_Op_Multiply                    : constant Name_Id := N + 110; -- "*"
-   Name_Op_Divide                      : constant Name_Id := N + 111; -- "/"
-   Name_Op_Expon                       : constant Name_Id := N + 112; -- "**"
-   Last_Operator_Name                  : constant Name_Id := N + 112;
+   First_Operator_Name                 : constant Name_Id := N + 095;
+   Name_Op_Abs                         : constant Name_Id := N + 095; -- "abs"
+   Name_Op_And                         : constant Name_Id := N + 096; -- "and"
+   Name_Op_Mod                         : constant Name_Id := N + 097; -- "mod"
+   Name_Op_Not                         : constant Name_Id := N + 098; -- "not"
+   Name_Op_Or                          : constant Name_Id := N + 099; -- "or"
+   Name_Op_Rem                         : constant Name_Id := N + 100; -- "rem"
+   Name_Op_Xor                         : constant Name_Id := N + 101; -- "xor"
+   Name_Op_Eq                          : constant Name_Id := N + 102; -- "="
+   Name_Op_Ne                          : constant Name_Id := N + 103; -- "/="
+   Name_Op_Lt                          : constant Name_Id := N + 104; -- "<"
+   Name_Op_Le                          : constant Name_Id := N + 105; -- "<="
+   Name_Op_Gt                          : constant Name_Id := N + 106; -- ">"
+   Name_Op_Ge                          : constant Name_Id := N + 107; -- ">="
+   Name_Op_Add                         : constant Name_Id := N + 108; -- "+"
+   Name_Op_Subtract                    : constant Name_Id := N + 109; -- "-"
+   Name_Op_Concat                      : constant Name_Id := N + 110; -- "&"
+   Name_Op_Multiply                    : constant Name_Id := N + 111; -- "*"
+   Name_Op_Divide                      : constant Name_Id := N + 112; -- "/"
+   Name_Op_Expon                       : constant Name_Id := N + 113; -- "**"
+   Last_Operator_Name                  : constant Name_Id := N + 113;
 
    --  Names for all pragmas recognized by GNAT. The entries with the comment
    --  "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95.
@@ -324,65 +329,65 @@ package Snames is
    --  only in GNAT for the AAMP. They are ignored in other versions with
    --  appropriate warnings.
 
-   First_Pragma_Name                   : constant Name_Id := N + 113;
+   First_Pragma_Name                   : constant Name_Id := N + 114;
 
    --  Configuration pragmas are grouped at start
 
-   Name_Ada_83                         : constant Name_Id := N + 113; -- GNAT
-   Name_Ada_95                         : constant Name_Id := N + 114; -- GNAT
-   Name_Ada_05                         : constant Name_Id := N + 115; -- GNAT
-   Name_Assertion_Policy               : constant Name_Id := N + 116; -- Ada 05
-   Name_C_Pass_By_Copy                 : constant Name_Id := N + 117; -- GNAT
-   Name_Compile_Time_Warning           : constant Name_Id := N + 118; -- GNAT
-   Name_Component_Alignment            : constant Name_Id := N + 119; -- GNAT
-   Name_Convention_Identifier          : constant Name_Id := N + 120; -- GNAT
-   Name_Debug_Policy                   : constant Name_Id := N + 121; -- GNAT
-   Name_Detect_Blocking                : constant Name_Id := N + 122; -- Ada 05
-   Name_Discard_Names                  : constant Name_Id := N + 123;
-   Name_Elaboration_Checks             : constant Name_Id := N + 124; -- GNAT
-   Name_Eliminate                      : constant Name_Id := N + 125; -- GNAT
-   Name_Explicit_Overriding            : constant Name_Id := N + 126; -- Ada 05
-   Name_Extend_System                  : constant Name_Id := N + 127; -- GNAT
-   Name_Extensions_Allowed             : constant Name_Id := N + 128; -- GNAT
-   Name_External_Name_Casing           : constant Name_Id := N + 129; -- GNAT
-   Name_Float_Representation           : constant Name_Id := N + 130; -- GNAT
-   Name_Initialize_Scalars             : constant Name_Id := N + 131; -- GNAT
-   Name_Interrupt_State                : constant Name_Id := N + 132; -- GNAT
-   Name_License                        : constant Name_Id := N + 133; -- GNAT
-   Name_Locking_Policy                 : constant Name_Id := N + 134;
-   Name_Long_Float                     : constant Name_Id := N + 135; -- VMS
-   Name_No_Run_Time                    : constant Name_Id := N + 136; -- GNAT
-   Name_No_Strict_Aliasing             : constant Name_Id := N + 137; -- GNAT
-   Name_Normalize_Scalars              : constant Name_Id := N + 138;
-   Name_Polling                        : constant Name_Id := N + 139; -- GNAT
-   Name_Persistent_BSS                 : constant Name_Id := N + 140; -- GNAT
-   Name_Profile                        : constant Name_Id := N + 141; -- Ada 05
-   Name_Profile_Warnings               : constant Name_Id := N + 142; -- GNAT
-   Name_Propagate_Exceptions           : constant Name_Id := N + 143; -- GNAT
-   Name_Queuing_Policy                 : constant Name_Id := N + 144;
-   Name_Ravenscar                      : constant Name_Id := N + 145; -- Ada 05
-   Name_Restricted_Run_Time            : constant Name_Id := N + 146; -- GNAT
-   Name_Restrictions                   : constant Name_Id := N + 147;
-   Name_Restriction_Warnings           : constant Name_Id := N + 148; -- GNAT
-   Name_Reviewable                     : constant Name_Id := N + 149;
-   Name_Source_File_Name               : constant Name_Id := N + 150; -- GNAT
-   Name_Source_File_Name_Project       : constant Name_Id := N + 151; -- GNAT
-   Name_Style_Checks                   : constant Name_Id := N + 152; -- GNAT
-   Name_Suppress                       : constant Name_Id := N + 153;
-   Name_Suppress_Exception_Locations   : constant Name_Id := N + 154; -- GNAT
-   Name_Task_Dispatching_Policy        : constant Name_Id := N + 155;
-   Name_Universal_Data                 : constant Name_Id := N + 156; -- AAMP
-   Name_Unsuppress                     : constant Name_Id := N + 157; -- GNAT
-   Name_Use_VADS_Size                  : constant Name_Id := N + 158; -- GNAT
-   Name_Validity_Checks                : constant Name_Id := N + 159; -- GNAT
-   Name_Warnings                       : constant Name_Id := N + 160; -- GNAT
-   Last_Configuration_Pragma_Name      : constant Name_Id := N + 160;
+   Name_Ada_83                         : constant Name_Id := N + 114; -- GNAT
+   Name_Ada_95                         : constant Name_Id := N + 115; -- GNAT
+   Name_Ada_05                         : constant Name_Id := N + 116; -- GNAT
+   Name_Assertion_Policy               : constant Name_Id := N + 117; -- Ada 05
+   Name_C_Pass_By_Copy                 : constant Name_Id := N + 118; -- GNAT
+   Name_Compile_Time_Warning           : constant Name_Id := N + 119; -- GNAT
+   Name_Component_Alignment            : constant Name_Id := N + 120; -- GNAT
+   Name_Convention_Identifier          : constant Name_Id := N + 121; -- GNAT
+   Name_Debug_Policy                   : constant Name_Id := N + 122; -- GNAT
+   Name_Detect_Blocking                : constant Name_Id := N + 123; -- Ada 05
+   Name_Discard_Names                  : constant Name_Id := N + 124;
+   Name_Elaboration_Checks             : constant Name_Id := N + 125; -- GNAT
+   Name_Eliminate                      : constant Name_Id := N + 126; -- GNAT
+   Name_Explicit_Overriding            : constant Name_Id := N + 127; -- Ada 05
+   Name_Extend_System                  : constant Name_Id := N + 128; -- GNAT
+   Name_Extensions_Allowed             : constant Name_Id := N + 129; -- GNAT
+   Name_External_Name_Casing           : constant Name_Id := N + 130; -- GNAT
+   Name_Float_Representation           : constant Name_Id := N + 131; -- GNAT
+   Name_Initialize_Scalars             : constant Name_Id := N + 132; -- GNAT
+   Name_Interrupt_State                : constant Name_Id := N + 133; -- GNAT
+   Name_License                        : constant Name_Id := N + 134; -- GNAT
+   Name_Locking_Policy                 : constant Name_Id := N + 135;
+   Name_Long_Float                     : constant Name_Id := N + 136; -- VMS
+   Name_No_Run_Time                    : constant Name_Id := N + 137; -- GNAT
+   Name_No_Strict_Aliasing             : constant Name_Id := N + 138; -- GNAT
+   Name_Normalize_Scalars              : constant Name_Id := N + 139;
+   Name_Polling                        : constant Name_Id := N + 140; -- GNAT
+   Name_Persistent_BSS                 : constant Name_Id := N + 141; -- GNAT
+   Name_Profile                        : constant Name_Id := N + 142; -- Ada 05
+   Name_Profile_Warnings               : constant Name_Id := N + 143; -- GNAT
+   Name_Propagate_Exceptions           : constant Name_Id := N + 144; -- GNAT
+   Name_Queuing_Policy                 : constant Name_Id := N + 145;
+   Name_Ravenscar                      : constant Name_Id := N + 146; -- Ada 05
+   Name_Restricted_Run_Time            : constant Name_Id := N + 147; -- GNAT
+   Name_Restrictions                   : constant Name_Id := N + 148;
+   Name_Restriction_Warnings           : constant Name_Id := N + 149; -- GNAT
+   Name_Reviewable                     : constant Name_Id := N + 150;
+   Name_Source_File_Name               : constant Name_Id := N + 151; -- GNAT
+   Name_Source_File_Name_Project       : constant Name_Id := N + 152; -- GNAT
+   Name_Style_Checks                   : constant Name_Id := N + 153; -- GNAT
+   Name_Suppress                       : constant Name_Id := N + 154;
+   Name_Suppress_Exception_Locations   : constant Name_Id := N + 155; -- GNAT
+   Name_Task_Dispatching_Policy        : constant Name_Id := N + 156;
+   Name_Universal_Data                 : constant Name_Id := N + 157; -- AAMP
+   Name_Unsuppress                     : constant Name_Id := N + 158; -- GNAT
+   Name_Use_VADS_Size                  : constant Name_Id := N + 159; -- GNAT
+   Name_Validity_Checks                : constant Name_Id := N + 160; -- GNAT
+   Name_Warnings                       : constant Name_Id := N + 161; -- GNAT
+   Last_Configuration_Pragma_Name      : constant Name_Id := N + 161;
 
    --  Remaining pragma names
 
-   Name_Abort_Defer                    : constant Name_Id := N + 161; -- GNAT
-   Name_All_Calls_Remote               : constant Name_Id := N + 162;
-   Name_Annotate                       : constant Name_Id := N + 163; -- GNAT
+   Name_Abort_Defer                    : constant Name_Id := N + 162; -- GNAT
+   Name_All_Calls_Remote               : constant Name_Id := N + 163;
+   Name_Annotate                       : constant Name_Id := N + 164; -- GNAT
 
    --  Note: AST_Entry is not in this list because its name matches the
    --  name of the corresponding attribute. However, it is included in the
@@ -390,80 +395,80 @@ package Snames is
    --  and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
    --  AST_Entry is a VMS specific pragma.
 
-   Name_Assert                         : constant Name_Id := N + 164; -- Ada 05
-   Name_Asynchronous                   : constant Name_Id := N + 165;
-   Name_Atomic                         : constant Name_Id := N + 166;
-   Name_Atomic_Components              : constant Name_Id := N + 167;
-   Name_Attach_Handler                 : constant Name_Id := N + 168;
-   Name_Comment                        : constant Name_Id := N + 169; -- GNAT
-   Name_Common_Object                  : constant Name_Id := N + 170; -- GNAT
-   Name_Complex_Representation         : constant Name_Id := N + 171; -- GNAT
-   Name_Controlled                     : constant Name_Id := N + 172;
-   Name_Convention                     : constant Name_Id := N + 173;
-   Name_CPP_Class                      : constant Name_Id := N + 174; -- GNAT
-   Name_CPP_Constructor                : constant Name_Id := N + 175; -- GNAT
-   Name_CPP_Virtual                    : constant Name_Id := N + 176; -- GNAT
-   Name_CPP_Vtable                     : constant Name_Id := N + 177; -- GNAT
-   Name_Debug                          : constant Name_Id := N + 178; -- GNAT
-   Name_Elaborate                      : constant Name_Id := N + 179; -- Ada 83
-   Name_Elaborate_All                  : constant Name_Id := N + 180;
-   Name_Elaborate_Body                 : constant Name_Id := N + 181;
-   Name_Export                         : constant Name_Id := N + 182;
-   Name_Export_Exception               : constant Name_Id := N + 183; -- VMS
-   Name_Export_Function                : constant Name_Id := N + 184; -- GNAT
-   Name_Export_Object                  : constant Name_Id := N + 185; -- GNAT
-   Name_Export_Procedure               : constant Name_Id := N + 186; -- GNAT
-   Name_Export_Value                   : constant Name_Id := N + 187; -- GNAT
-   Name_Export_Valued_Procedure        : constant Name_Id := N + 188; -- GNAT
-   Name_External                       : constant Name_Id := N + 189; -- GNAT
-   Name_Finalize_Storage_Only          : constant Name_Id := N + 190; -- GNAT
-   Name_Ident                          : constant Name_Id := N + 191; -- VMS
-   Name_Import                         : constant Name_Id := N + 192;
-   Name_Import_Exception               : constant Name_Id := N + 193; -- VMS
-   Name_Import_Function                : constant Name_Id := N + 194; -- GNAT
-   Name_Import_Object                  : constant Name_Id := N + 195; -- GNAT
-   Name_Import_Procedure               : constant Name_Id := N + 196; -- GNAT
-   Name_Import_Valued_Procedure        : constant Name_Id := N + 197; -- GNAT
-   Name_Inline                         : constant Name_Id := N + 198;
-   Name_Inline_Always                  : constant Name_Id := N + 199; -- GNAT
-   Name_Inline_Generic                 : constant Name_Id := N + 200; -- GNAT
-   Name_Inspection_Point               : constant Name_Id := N + 201;
-   Name_Interface_Name                 : constant Name_Id := N + 202; -- GNAT
-   Name_Interrupt_Handler              : constant Name_Id := N + 203;
-   Name_Interrupt_Priority             : constant Name_Id := N + 204;
-   Name_Java_Constructor               : constant Name_Id := N + 205; -- GNAT
-   Name_Java_Interface                 : constant Name_Id := N + 206; -- GNAT
-   Name_Keep_Names                     : constant Name_Id := N + 207; -- GNAT
-   Name_Link_With                      : constant Name_Id := N + 208; -- GNAT
-   Name_Linker_Alias                   : constant Name_Id := N + 209; -- GNAT
-   Name_Linker_Constructor             : constant Name_Id := N + 210; -- GNAT
-   Name_Linker_Destructor              : constant Name_Id := N + 211; -- GNAT
-   Name_Linker_Options                 : constant Name_Id := N + 212;
-   Name_Linker_Section                 : constant Name_Id := N + 213; -- GNAT
-   Name_List                           : constant Name_Id := N + 214;
-   Name_Machine_Attribute              : constant Name_Id := N + 215; -- GNAT
-   Name_Main                           : constant Name_Id := N + 216; -- GNAT
-   Name_Main_Storage                   : constant Name_Id := N + 217; -- GNAT
-   Name_Memory_Size                    : constant Name_Id := N + 218; -- Ada 83
-   Name_No_Return                      : constant Name_Id := N + 219; -- GNAT
-   Name_Obsolescent                    : constant Name_Id := N + 220; -- GNAT
-   Name_Optimize                       : constant Name_Id := N + 221;
-   Name_Optional_Overriding            : constant Name_Id := N + 222; -- Ada 05
-   Name_Pack                           : constant Name_Id := N + 223;
-   Name_Page                           : constant Name_Id := N + 224;
-   Name_Passive                        : constant Name_Id := N + 225; -- GNAT
-   Name_Preelaborate                   : constant Name_Id := N + 226;
-   Name_Preelaborate_05                : constant Name_Id := N + 227; -- GNAT
-   Name_Priority                       : constant Name_Id := N + 228;
-   Name_Psect_Object                   : constant Name_Id := N + 229; -- VMS
-   Name_Pure                           : constant Name_Id := N + 230;
-   Name_Pure_05                        : constant Name_Id := N + 231; -- GNAT
-   Name_Pure_Function                  : constant Name_Id := N + 232; -- GNAT
-   Name_Remote_Call_Interface          : constant Name_Id := N + 233;
-   Name_Remote_Types                   : constant Name_Id := N + 234;
-   Name_Share_Generic                  : constant Name_Id := N + 235; -- GNAT
-   Name_Shared                         : constant Name_Id := N + 236; -- Ada 83
-   Name_Shared_Passive                 : constant Name_Id := N + 237;
+   Name_Assert                         : constant Name_Id := N + 165; -- Ada 05
+   Name_Asynchronous                   : constant Name_Id := N + 166;
+   Name_Atomic                         : constant Name_Id := N + 167;
+   Name_Atomic_Components              : constant Name_Id := N + 168;
+   Name_Attach_Handler                 : constant Name_Id := N + 169;
+   Name_Comment                        : constant Name_Id := N + 170; -- GNAT
+   Name_Common_Object                  : constant Name_Id := N + 171; -- GNAT
+   Name_Complex_Representation         : constant Name_Id := N + 172; -- GNAT
+   Name_Controlled                     : constant Name_Id := N + 173;
+   Name_Convention                     : constant Name_Id := N + 174;
+   Name_CPP_Class                      : constant Name_Id := N + 175; -- GNAT
+   Name_CPP_Constructor                : constant Name_Id := N + 176; -- GNAT
+   Name_CPP_Virtual                    : constant Name_Id := N + 177; -- GNAT
+   Name_CPP_Vtable                     : constant Name_Id := N + 178; -- GNAT
+   Name_Debug                          : constant Name_Id := N + 179; -- GNAT
+   Name_Elaborate                      : constant Name_Id := N + 180; -- Ada 83
+   Name_Elaborate_All                  : constant Name_Id := N + 181;
+   Name_Elaborate_Body                 : constant Name_Id := N + 182;
+   Name_Export                         : constant Name_Id := N + 183;
+   Name_Export_Exception               : constant Name_Id := N + 184; -- VMS
+   Name_Export_Function                : constant Name_Id := N + 185; -- GNAT
+   Name_Export_Object                  : constant Name_Id := N + 186; -- GNAT
+   Name_Export_Procedure               : constant Name_Id := N + 187; -- GNAT
+   Name_Export_Value                   : constant Name_Id := N + 188; -- GNAT
+   Name_Export_Valued_Procedure        : constant Name_Id := N + 189; -- GNAT
+   Name_External                       : constant Name_Id := N + 190; -- GNAT
+   Name_Finalize_Storage_Only          : constant Name_Id := N + 191; -- GNAT
+   Name_Ident                          : constant Name_Id := N + 192; -- VMS
+   Name_Import                         : constant Name_Id := N + 193;
+   Name_Import_Exception               : constant Name_Id := N + 194; -- VMS
+   Name_Import_Function                : constant Name_Id := N + 195; -- GNAT
+   Name_Import_Object                  : constant Name_Id := N + 196; -- GNAT
+   Name_Import_Procedure               : constant Name_Id := N + 197; -- GNAT
+   Name_Import_Valued_Procedure        : constant Name_Id := N + 198; -- GNAT
+   Name_Inline                         : constant Name_Id := N + 199;
+   Name_Inline_Always                  : constant Name_Id := N + 200; -- GNAT
+   Name_Inline_Generic                 : constant Name_Id := N + 201; -- GNAT
+   Name_Inspection_Point               : constant Name_Id := N + 202;
+   Name_Interface_Name                 : constant Name_Id := N + 203; -- GNAT
+   Name_Interrupt_Handler              : constant Name_Id := N + 204;
+   Name_Interrupt_Priority             : constant Name_Id := N + 205;
+   Name_Java_Constructor               : constant Name_Id := N + 206; -- GNAT
+   Name_Java_Interface                 : constant Name_Id := N + 207; -- GNAT
+   Name_Keep_Names                     : constant Name_Id := N + 208; -- GNAT
+   Name_Link_With                      : constant Name_Id := N + 209; -- GNAT
+   Name_Linker_Alias                   : constant Name_Id := N + 210; -- GNAT
+   Name_Linker_Constructor             : constant Name_Id := N + 211; -- GNAT
+   Name_Linker_Destructor              : constant Name_Id := N + 212; -- GNAT
+   Name_Linker_Options                 : constant Name_Id := N + 213;
+   Name_Linker_Section                 : constant Name_Id := N + 214; -- GNAT
+   Name_List                           : constant Name_Id := N + 215;
+   Name_Machine_Attribute              : constant Name_Id := N + 216; -- GNAT
+   Name_Main                           : constant Name_Id := N + 217; -- GNAT
+   Name_Main_Storage                   : constant Name_Id := N + 218; -- GNAT
+   Name_Memory_Size                    : constant Name_Id := N + 219; -- Ada 83
+   Name_No_Return                      : constant Name_Id := N + 220; -- GNAT
+   Name_Obsolescent                    : constant Name_Id := N + 221; -- GNAT
+   Name_Optimize                       : constant Name_Id := N + 222;
+   Name_Optional_Overriding            : constant Name_Id := N + 223; -- Ada 05
+   Name_Pack                           : constant Name_Id := N + 224;
+   Name_Page                           : constant Name_Id := N + 225;
+   Name_Passive                        : constant Name_Id := N + 226; -- GNAT
+   Name_Preelaborate                   : constant Name_Id := N + 227;
+   Name_Preelaborate_05                : constant Name_Id := N + 228; -- GNAT
+   Name_Priority                       : constant Name_Id := N + 229;
+   Name_Psect_Object                   : constant Name_Id := N + 230; -- VMS
+   Name_Pure                           : constant Name_Id := N + 231;
+   Name_Pure_05                        : constant Name_Id := N + 232; -- GNAT
+   Name_Pure_Function                  : constant Name_Id := N + 233; -- GNAT
+   Name_Remote_Call_Interface          : constant Name_Id := N + 234;
+   Name_Remote_Types                   : constant Name_Id := N + 235;
+   Name_Share_Generic                  : constant Name_Id := N + 236; -- GNAT
+   Name_Shared                         : constant Name_Id := N + 237; -- Ada 83
+   Name_Shared_Passive                 : constant Name_Id := N + 238;
 
    --  Note: Storage_Size is not in this list because its name matches the
    --  name of the corresponding attribute. However, it is included in the
@@ -473,27 +478,27 @@ package Snames is
    --  Note: Storage_Unit is also omitted from the list because of a clash
    --  with an attribute name, and is treated similarly.
 
-   Name_Source_Reference               : constant Name_Id := N + 238; -- GNAT
-   Name_Stream_Convert                 : constant Name_Id := N + 239; -- GNAT
-   Name_Subtitle                       : constant Name_Id := N + 240; -- GNAT
-   Name_Suppress_All                   : constant Name_Id := N + 241; -- GNAT
-   Name_Suppress_Debug_Info            : constant Name_Id := N + 242; -- GNAT
-   Name_Suppress_Initialization        : constant Name_Id := N + 243; -- GNAT
-   Name_System_Name                    : constant Name_Id := N + 244; -- Ada 83
-   Name_Task_Info                      : constant Name_Id := N + 245; -- GNAT
-   Name_Task_Name                      : constant Name_Id := N + 246; -- GNAT
-   Name_Task_Storage                   : constant Name_Id := N + 247; -- VMS
-   Name_Thread_Body                    : constant Name_Id := N + 248; -- GNAT
-   Name_Time_Slice                     : constant Name_Id := N + 249; -- GNAT
-   Name_Title                          : constant Name_Id := N + 250; -- GNAT
-   Name_Unchecked_Union                : constant Name_Id := N + 251; -- GNAT
-   Name_Unimplemented_Unit             : constant Name_Id := N + 252; -- GNAT
-   Name_Unreferenced                   : constant Name_Id := N + 253; -- GNAT
-   Name_Unreserve_All_Interrupts       : constant Name_Id := N + 254; -- GNAT
-   Name_Volatile                       : constant Name_Id := N + 255;
-   Name_Volatile_Components            : constant Name_Id := N + 256;
-   Name_Weak_External                  : constant Name_Id := N + 257; -- GNAT
-   Last_Pragma_Name                    : constant Name_Id := N + 257;
+   Name_Source_Reference               : constant Name_Id := N + 239; -- GNAT
+   Name_Stream_Convert                 : constant Name_Id := N + 240; -- GNAT
+   Name_Subtitle                       : constant Name_Id := N + 241; -- GNAT
+   Name_Suppress_All                   : constant Name_Id := N + 242; -- GNAT
+   Name_Suppress_Debug_Info            : constant Name_Id := N + 243; -- GNAT
+   Name_Suppress_Initialization        : constant Name_Id := N + 244; -- GNAT
+   Name_System_Name                    : constant Name_Id := N + 245; -- Ada 83
+   Name_Task_Info                      : constant Name_Id := N + 246; -- GNAT
+   Name_Task_Name                      : constant Name_Id := N + 247; -- GNAT
+   Name_Task_Storage                   : constant Name_Id := N + 248; -- VMS
+   Name_Thread_Body                    : constant Name_Id := N + 249; -- GNAT
+   Name_Time_Slice                     : constant Name_Id := N + 250; -- GNAT
+   Name_Title                          : constant Name_Id := N + 251; -- GNAT
+   Name_Unchecked_Union                : constant Name_Id := N + 252; -- GNAT
+   Name_Unimplemented_Unit             : constant Name_Id := N + 253; -- GNAT
+   Name_Unreferenced                   : constant Name_Id := N + 254; -- GNAT
+   Name_Unreserve_All_Interrupts       : constant Name_Id := N + 255; -- GNAT
+   Name_Volatile                       : constant Name_Id := N + 256;
+   Name_Volatile_Components            : constant Name_Id := N + 257;
+   Name_Weak_External                  : constant Name_Id := N + 258; -- GNAT
+   Last_Pragma_Name                    : constant Name_Id := N + 258;
 
    --  Language convention names for pragma Convention/Export/Import/Interface
    --  Note that Name_C is not included in this list, since it was already
@@ -504,114 +509,114 @@ package Snames is
    --  Entry and Protected, this is because these conventions cannot be
    --  specified by a pragma.
 
-   First_Convention_Name               : constant Name_Id := N + 258;
-   Name_Ada                            : constant Name_Id := N + 258;
-   Name_Assembler                      : constant Name_Id := N + 259;
-   Name_COBOL                          : constant Name_Id := N + 260;
-   Name_CPP                            : constant Name_Id := N + 261;
-   Name_Fortran                        : constant Name_Id := N + 262;
-   Name_Intrinsic                      : constant Name_Id := N + 263;
-   Name_Java                           : constant Name_Id := N + 264;
-   Name_Stdcall                        : constant Name_Id := N + 265;
-   Name_Stubbed                        : constant Name_Id := N + 266;
-   Last_Convention_Name                : constant Name_Id := N + 266;
+   First_Convention_Name               : constant Name_Id := N + 259;
+   Name_Ada                            : constant Name_Id := N + 259;
+   Name_Assembler                      : constant Name_Id := N + 260;
+   Name_COBOL                          : constant Name_Id := N + 261;
+   Name_CPP                            : constant Name_Id := N + 262;
+   Name_Fortran                        : constant Name_Id := N + 263;
+   Name_Intrinsic                      : constant Name_Id := N + 264;
+   Name_Java                           : constant Name_Id := N + 265;
+   Name_Stdcall                        : constant Name_Id := N + 266;
+   Name_Stubbed                        : constant Name_Id := N + 267;
+   Last_Convention_Name                : constant Name_Id := N + 267;
 
    --  The following names are preset as synonyms for Assembler
 
-   Name_Asm                            : constant Name_Id := N + 267;
-   Name_Assembly                       : constant Name_Id := N + 268;
+   Name_Asm                            : constant Name_Id := N + 268;
+   Name_Assembly                       : constant Name_Id := N + 269;
 
    --  The following names are preset as synonyms for C
 
-   Name_Default                        : constant Name_Id := N + 269;
+   Name_Default                        : constant Name_Id := N + 270;
    --  Name_Exernal (previously defined as pragma)
 
    --  The following names are present as synonyms for Stdcall
 
-   Name_DLL                            : constant Name_Id := N + 270;
-   Name_Win32                          : constant Name_Id := N + 271;
+   Name_DLL                            : constant Name_Id := N + 271;
+   Name_Win32                          : constant Name_Id := N + 272;
 
    --  Other special names used in processing pragmas
 
-   Name_As_Is                          : constant Name_Id := N + 272;
-   Name_Attribute_Name                 : constant Name_Id := N + 273;
-   Name_Body_File_Name                 : constant Name_Id := N + 274;
-   Name_Boolean_Entry_Barriers         : constant Name_Id := N + 275;
-   Name_Check                          : constant Name_Id := N + 276;
-   Name_Casing                         : constant Name_Id := N + 277;
-   Name_Code                           : constant Name_Id := N + 278;
-   Name_Component                      : constant Name_Id := N + 279;
-   Name_Component_Size_4               : constant Name_Id := N + 280;
-   Name_Copy                           : constant Name_Id := N + 281;
-   Name_D_Float                        : constant Name_Id := N + 282;
-   Name_Descriptor                     : constant Name_Id := N + 283;
-   Name_Dot_Replacement                : constant Name_Id := N + 284;
-   Name_Dynamic                        : constant Name_Id := N + 285;
-   Name_Entity                         : constant Name_Id := N + 286;
-   Name_Entry_Count                    : constant Name_Id := N + 287;
-   Name_External_Name                  : constant Name_Id := N + 288;
-   Name_First_Optional_Parameter       : constant Name_Id := N + 289;
-   Name_Form                           : constant Name_Id := N + 290;
-   Name_G_Float                        : constant Name_Id := N + 291;
-   Name_Gcc                            : constant Name_Id := N + 292;
-   Name_Gnat                           : constant Name_Id := N + 293;
-   Name_GPL                            : constant Name_Id := N + 294;
-   Name_IEEE_Float                     : constant Name_Id := N + 295;
-   Name_Ignore                         : constant Name_Id := N + 296;
-   Name_Info                           : constant Name_Id := N + 297;
-   Name_Internal                       : constant Name_Id := N + 298;
-   Name_Link_Name                      : constant Name_Id := N + 299;
-   Name_Lowercase                      : constant Name_Id := N + 300;
-   Name_Max_Entry_Queue_Depth          : constant Name_Id := N + 301;
-   Name_Max_Entry_Queue_Length         : constant Name_Id := N + 302;
-   Name_Max_Size                       : constant Name_Id := N + 303;
-   Name_Mechanism                      : constant Name_Id := N + 304;
-   Name_Message                        : constant Name_Id := N + 305;
-   Name_Mixedcase                      : constant Name_Id := N + 306;
-   Name_Modified_GPL                   : constant Name_Id := N + 307;
-   Name_Name                           : constant Name_Id := N + 308;
-   Name_NCA                            : constant Name_Id := N + 309;
-   Name_No                             : constant Name_Id := N + 310;
-   Name_No_Dependence                  : constant Name_Id := N + 311;
-   Name_No_Dynamic_Attachment          : constant Name_Id := N + 312;
-   Name_No_Dynamic_Interrupts          : constant Name_Id := N + 313;
-   Name_No_Requeue                     : constant Name_Id := N + 314;
-   Name_No_Requeue_Statements          : constant Name_Id := N + 315;
-   Name_No_Task_Attributes             : constant Name_Id := N + 316;
-   Name_No_Task_Attributes_Package     : constant Name_Id := N + 317;
-   Name_On                             : constant Name_Id := N + 318;
-   Name_Parameter_Types                : constant Name_Id := N + 319;
-   Name_Reference                      : constant Name_Id := N + 320;
-   Name_Restricted                     : constant Name_Id := N + 321;
-   Name_Result_Mechanism               : constant Name_Id := N + 322;
-   Name_Result_Type                    : constant Name_Id := N + 323;
-   Name_Runtime                        : constant Name_Id := N + 324;
-   Name_SB                             : constant Name_Id := N + 325;
-   Name_Secondary_Stack_Size           : constant Name_Id := N + 326;
-   Name_Section                        : constant Name_Id := N + 327;
-   Name_Semaphore                      : constant Name_Id := N + 328;
-   Name_Simple_Barriers                : constant Name_Id := N + 329;
-   Name_Spec_File_Name                 : constant Name_Id := N + 330;
-   Name_State                          : constant Name_Id := N + 331;
-   Name_Static                         : constant Name_Id := N + 332;
-   Name_Stack_Size                     : constant Name_Id := N + 333;
-   Name_Subunit_File_Name              : constant Name_Id := N + 334;
-   Name_Task_Stack_Size_Default        : constant Name_Id := N + 335;
-   Name_Task_Type                      : constant Name_Id := N + 336;
-   Name_Time_Slicing_Enabled           : constant Name_Id := N + 337;
-   Name_Top_Guard                      : constant Name_Id := N + 338;
-   Name_UBA                            : constant Name_Id := N + 339;
-   Name_UBS                            : constant Name_Id := N + 340;
-   Name_UBSB                           : constant Name_Id := N + 341;
-   Name_Unit_Name                      : constant Name_Id := N + 342;
-   Name_Unknown                        : constant Name_Id := N + 343;
-   Name_Unrestricted                   : constant Name_Id := N + 344;
-   Name_Uppercase                      : constant Name_Id := N + 345;
-   Name_User                           : constant Name_Id := N + 346;
-   Name_VAX_Float                      : constant Name_Id := N + 347;
-   Name_VMS                            : constant Name_Id := N + 348;
-   Name_Vtable_Ptr                     : constant Name_Id := N + 349;
-   Name_Working_Storage                : constant Name_Id := N + 350;
+   Name_As_Is                          : constant Name_Id := N + 273;
+   Name_Attribute_Name                 : constant Name_Id := N + 274;
+   Name_Body_File_Name                 : constant Name_Id := N + 275;
+   Name_Boolean_Entry_Barriers         : constant Name_Id := N + 276;
+   Name_Check                          : constant Name_Id := N + 277;
+   Name_Casing                         : constant Name_Id := N + 278;
+   Name_Code                           : constant Name_Id := N + 279;
+   Name_Component                      : constant Name_Id := N + 280;
+   Name_Component_Size_4               : constant Name_Id := N + 281;
+   Name_Copy                           : constant Name_Id := N + 282;
+   Name_D_Float                        : constant Name_Id := N + 283;
+   Name_Descriptor                     : constant Name_Id := N + 284;
+   Name_Dot_Replacement                : constant Name_Id := N + 285;
+   Name_Dynamic                        : constant Name_Id := N + 286;
+   Name_Entity                         : constant Name_Id := N + 287;
+   Name_Entry_Count                    : constant Name_Id := N + 288;
+   Name_External_Name                  : constant Name_Id := N + 289;
+   Name_First_Optional_Parameter       : constant Name_Id := N + 290;
+   Name_Form                           : constant Name_Id := N + 291;
+   Name_G_Float                        : constant Name_Id := N + 292;
+   Name_Gcc                            : constant Name_Id := N + 293;
+   Name_Gnat                           : constant Name_Id := N + 294;
+   Name_GPL                            : constant Name_Id := N + 295;
+   Name_IEEE_Float                     : constant Name_Id := N + 296;
+   Name_Ignore                         : constant Name_Id := N + 297;
+   Name_Info                           : constant Name_Id := N + 298;
+   Name_Internal                       : constant Name_Id := N + 299;
+   Name_Link_Name                      : constant Name_Id := N + 300;
+   Name_Lowercase                      : constant Name_Id := N + 301;
+   Name_Max_Entry_Queue_Depth          : constant Name_Id := N + 302;
+   Name_Max_Entry_Queue_Length         : constant Name_Id := N + 303;
+   Name_Max_Size                       : constant Name_Id := N + 304;
+   Name_Mechanism                      : constant Name_Id := N + 305;
+   Name_Message                        : constant Name_Id := N + 306;
+   Name_Mixedcase                      : constant Name_Id := N + 307;
+   Name_Modified_GPL                   : constant Name_Id := N + 308;
+   Name_Name                           : constant Name_Id := N + 309;
+   Name_NCA                            : constant Name_Id := N + 310;
+   Name_No                             : constant Name_Id := N + 311;
+   Name_No_Dependence                  : constant Name_Id := N + 312;
+   Name_No_Dynamic_Attachment          : constant Name_Id := N + 313;
+   Name_No_Dynamic_Interrupts          : constant Name_Id := N + 314;
+   Name_No_Requeue                     : constant Name_Id := N + 315;
+   Name_No_Requeue_Statements          : constant Name_Id := N + 316;
+   Name_No_Task_Attributes             : constant Name_Id := N + 317;
+   Name_No_Task_Attributes_Package     : constant Name_Id := N + 318;
+   Name_On                             : constant Name_Id := N + 319;
+   Name_Parameter_Types                : constant Name_Id := N + 320;
+   Name_Reference                      : constant Name_Id := N + 321;
+   Name_Restricted                     : constant Name_Id := N + 322;
+   Name_Result_Mechanism               : constant Name_Id := N + 323;
+   Name_Result_Type                    : constant Name_Id := N + 324;
+   Name_Runtime                        : constant Name_Id := N + 325;
+   Name_SB                             : constant Name_Id := N + 326;
+   Name_Secondary_Stack_Size           : constant Name_Id := N + 327;
+   Name_Section                        : constant Name_Id := N + 328;
+   Name_Semaphore                      : constant Name_Id := N + 329;
+   Name_Simple_Barriers                : constant Name_Id := N + 330;
+   Name_Spec_File_Name                 : constant Name_Id := N + 331;
+   Name_State                          : constant Name_Id := N + 332;
+   Name_Static                         : constant Name_Id := N + 333;
+   Name_Stack_Size                     : constant Name_Id := N + 334;
+   Name_Subunit_File_Name              : constant Name_Id := N + 335;
+   Name_Task_Stack_Size_Default        : constant Name_Id := N + 336;
+   Name_Task_Type                      : constant Name_Id := N + 337;
+   Name_Time_Slicing_Enabled           : constant Name_Id := N + 338;
+   Name_Top_Guard                      : constant Name_Id := N + 339;
+   Name_UBA                            : constant Name_Id := N + 340;
+   Name_UBS                            : constant Name_Id := N + 341;
+   Name_UBSB                           : constant Name_Id := N + 342;
+   Name_Unit_Name                      : constant Name_Id := N + 343;
+   Name_Unknown                        : constant Name_Id := N + 344;
+   Name_Unrestricted                   : constant Name_Id := N + 345;
+   Name_Uppercase                      : constant Name_Id := N + 346;
+   Name_User                           : constant Name_Id := N + 347;
+   Name_VAX_Float                      : constant Name_Id := N + 348;
+   Name_VMS                            : constant Name_Id := N + 349;
+   Name_Vtable_Ptr                     : constant Name_Id := N + 350;
+   Name_Working_Storage                : constant Name_Id := N + 351;
 
    --  Names of recognized attributes. The entries with the comment "Ada 83"
    --  are attributes that are defined in Ada 83, but not in Ada 95. These
@@ -625,165 +630,166 @@ package Snames is
    --  The entries marked VMS are recognized only in OpenVMS implementations
    --  of GNAT, and are treated as illegal in all other contexts.
 
-   First_Attribute_Name                : constant Name_Id := N + 351;
-   Name_Abort_Signal                   : constant Name_Id := N + 351; -- GNAT
-   Name_Access                         : constant Name_Id := N + 352;
-   Name_Address                        : constant Name_Id := N + 353;
-   Name_Address_Size                   : constant Name_Id := N + 354; -- GNAT
-   Name_Aft                            : constant Name_Id := N + 355;
-   Name_Alignment                      : constant Name_Id := N + 356;
-   Name_Asm_Input                      : constant Name_Id := N + 357; -- GNAT
-   Name_Asm_Output                     : constant Name_Id := N + 358; -- GNAT
-   Name_AST_Entry                      : constant Name_Id := N + 359; -- VMS
-   Name_Bit                            : constant Name_Id := N + 360; -- GNAT
-   Name_Bit_Order                      : constant Name_Id := N + 361;
-   Name_Bit_Position                   : constant Name_Id := N + 362; -- GNAT
-   Name_Body_Version                   : constant Name_Id := N + 363;
-   Name_Callable                       : constant Name_Id := N + 364;
-   Name_Caller                         : constant Name_Id := N + 365;
-   Name_Code_Address                   : constant Name_Id := N + 366; -- GNAT
-   Name_Component_Size                 : constant Name_Id := N + 367;
-   Name_Compose                        : constant Name_Id := N + 368;
-   Name_Constrained                    : constant Name_Id := N + 369;
-   Name_Count                          : constant Name_Id := N + 370;
-   Name_Default_Bit_Order              : constant Name_Id := N + 371; -- GNAT
-   Name_Definite                       : constant Name_Id := N + 372;
-   Name_Delta                          : constant Name_Id := N + 373;
-   Name_Denorm                         : constant Name_Id := N + 374;
-   Name_Digits                         : constant Name_Id := N + 375;
-   Name_Elaborated                     : constant Name_Id := N + 376; -- GNAT
-   Name_Emax                           : constant Name_Id := N + 377; -- Ada 83
-   Name_Enum_Rep                       : constant Name_Id := N + 378; -- GNAT
-   Name_Epsilon                        : constant Name_Id := N + 379; -- Ada 83
-   Name_Exponent                       : constant Name_Id := N + 380;
-   Name_External_Tag                   : constant Name_Id := N + 381;
-   Name_First                          : constant Name_Id := N + 382;
-   Name_First_Bit                      : constant Name_Id := N + 383;
-   Name_Fixed_Value                    : constant Name_Id := N + 384; -- GNAT
-   Name_Fore                           : constant Name_Id := N + 385;
-   Name_Has_Access_Values              : constant Name_Id := N + 386; -- GNAT
-   Name_Has_Discriminants              : constant Name_Id := N + 387; -- GNAT
-   Name_Identity                       : constant Name_Id := N + 388;
-   Name_Img                            : constant Name_Id := N + 389; -- GNAT
-   Name_Integer_Value                  : constant Name_Id := N + 390; -- GNAT
-   Name_Large                          : constant Name_Id := N + 391; -- Ada 83
-   Name_Last                           : constant Name_Id := N + 392;
-   Name_Last_Bit                       : constant Name_Id := N + 393;
-   Name_Leading_Part                   : constant Name_Id := N + 394;
-   Name_Length                         : constant Name_Id := N + 395;
-   Name_Machine_Emax                   : constant Name_Id := N + 396;
-   Name_Machine_Emin                   : constant Name_Id := N + 397;
-   Name_Machine_Mantissa               : constant Name_Id := N + 398;
-   Name_Machine_Overflows              : constant Name_Id := N + 399;
-   Name_Machine_Radix                  : constant Name_Id := N + 400;
-   Name_Machine_Rounds                 : constant Name_Id := N + 401;
-   Name_Machine_Size                   : constant Name_Id := N + 402; -- GNAT
-   Name_Mantissa                       : constant Name_Id := N + 403; -- Ada 83
-   Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + 404;
-   Name_Maximum_Alignment              : constant Name_Id := N + 405; -- GNAT
-   Name_Mechanism_Code                 : constant Name_Id := N + 406; -- GNAT
-   Name_Mod                            : constant Name_Id := N + 407;
-   Name_Model_Emin                     : constant Name_Id := N + 408;
-   Name_Model_Epsilon                  : constant Name_Id := N + 409;
-   Name_Model_Mantissa                 : constant Name_Id := N + 410;
-   Name_Model_Small                    : constant Name_Id := N + 411;
-   Name_Modulus                        : constant Name_Id := N + 412;
-   Name_Null_Parameter                 : constant Name_Id := N + 413; -- GNAT
-   Name_Object_Size                    : constant Name_Id := N + 414; -- GNAT
-   Name_Partition_ID                   : constant Name_Id := N + 415;
-   Name_Passed_By_Reference            : constant Name_Id := N + 416; -- GNAT
-   Name_Pool_Address                   : constant Name_Id := N + 417;
-   Name_Pos                            : constant Name_Id := N + 418;
-   Name_Position                       : constant Name_Id := N + 419;
-   Name_Range                          : constant Name_Id := N + 420;
-   Name_Range_Length                   : constant Name_Id := N + 421; -- GNAT
-   Name_Round                          : constant Name_Id := N + 422;
-   Name_Safe_Emax                      : constant Name_Id := N + 423; -- Ada 83
-   Name_Safe_First                     : constant Name_Id := N + 424;
-   Name_Safe_Large                     : constant Name_Id := N + 425; -- Ada 83
-   Name_Safe_Last                      : constant Name_Id := N + 426;
-   Name_Safe_Small                     : constant Name_Id := N + 427; -- Ada 83
-   Name_Scale                          : constant Name_Id := N + 428;
-   Name_Scaling                        : constant Name_Id := N + 429;
-   Name_Signed_Zeros                   : constant Name_Id := N + 430;
-   Name_Size                           : constant Name_Id := N + 431;
-   Name_Small                          : constant Name_Id := N + 432;
-   Name_Storage_Size                   : constant Name_Id := N + 433;
-   Name_Storage_Unit                   : constant Name_Id := N + 434; -- GNAT
-   Name_Stream_Size                    : constant Name_Id := N + 435; -- Ada 05
-   Name_Tag                            : constant Name_Id := N + 436;
-   Name_Target_Name                    : constant Name_Id := N + 437; -- GNAT
-   Name_Terminated                     : constant Name_Id := N + 438;
-   Name_To_Address                     : constant Name_Id := N + 439; -- GNAT
-   Name_Type_Class                     : constant Name_Id := N + 440; -- GNAT
-   Name_UET_Address                    : constant Name_Id := N + 441; -- GNAT
-   Name_Unbiased_Rounding              : constant Name_Id := N + 442;
-   Name_Unchecked_Access               : constant Name_Id := N + 443;
-   Name_Unconstrained_Array            : constant Name_Id := N + 444;
-   Name_Universal_Literal_String       : constant Name_Id := N + 445; -- GNAT
-   Name_Unrestricted_Access            : constant Name_Id := N + 446; -- GNAT
-   Name_VADS_Size                      : constant Name_Id := N + 447; -- GNAT
-   Name_Val                            : constant Name_Id := N + 448;
-   Name_Valid                          : constant Name_Id := N + 449;
-   Name_Value_Size                     : constant Name_Id := N + 450; -- GNAT
-   Name_Version                        : constant Name_Id := N + 451;
-   Name_Wchar_T_Size                   : constant Name_Id := N + 452; -- GNAT
-   Name_Wide_Wide_Width                : constant Name_Id := N + 453; -- Ada 05
-   Name_Wide_Width                     : constant Name_Id := N + 454;
-   Name_Width                          : constant Name_Id := N + 455;
-   Name_Word_Size                      : constant Name_Id := N + 456; -- GNAT
+   First_Attribute_Name                : constant Name_Id := N + 352;
+   Name_Abort_Signal                   : constant Name_Id := N + 352; -- GNAT
+   Name_Access                         : constant Name_Id := N + 353;
+   Name_Address                        : constant Name_Id := N + 354;
+   Name_Address_Size                   : constant Name_Id := N + 355; -- GNAT
+   Name_Aft                            : constant Name_Id := N + 356;
+   Name_Alignment                      : constant Name_Id := N + 357;
+   Name_Asm_Input                      : constant Name_Id := N + 358; -- GNAT
+   Name_Asm_Output                     : constant Name_Id := N + 359; -- GNAT
+   Name_AST_Entry                      : constant Name_Id := N + 360; -- VMS
+   Name_Bit                            : constant Name_Id := N + 361; -- GNAT
+   Name_Bit_Order                      : constant Name_Id := N + 362;
+   Name_Bit_Position                   : constant Name_Id := N + 363; -- GNAT
+   Name_Body_Version                   : constant Name_Id := N + 364;
+   Name_Callable                       : constant Name_Id := N + 365;
+   Name_Caller                         : constant Name_Id := N + 366;
+   Name_Code_Address                   : constant Name_Id := N + 367; -- GNAT
+   Name_Component_Size                 : constant Name_Id := N + 368;
+   Name_Compose                        : constant Name_Id := N + 369;
+   Name_Constrained                    : constant Name_Id := N + 370;
+   Name_Count                          : constant Name_Id := N + 371;
+   Name_Default_Bit_Order              : constant Name_Id := N + 372; -- GNAT
+   Name_Definite                       : constant Name_Id := N + 373;
+   Name_Delta                          : constant Name_Id := N + 374;
+   Name_Denorm                         : constant Name_Id := N + 375;
+   Name_Digits                         : constant Name_Id := N + 376;
+   Name_Elaborated                     : constant Name_Id := N + 377; -- GNAT
+   Name_Emax                           : constant Name_Id := N + 378; -- Ada 83
+   Name_Enum_Rep                       : constant Name_Id := N + 379; -- GNAT
+   Name_Epsilon                        : constant Name_Id := N + 380; -- Ada 83
+   Name_Exponent                       : constant Name_Id := N + 381;
+   Name_External_Tag                   : constant Name_Id := N + 382;
+   Name_First                          : constant Name_Id := N + 383;
+   Name_First_Bit                      : constant Name_Id := N + 384;
+   Name_Fixed_Value                    : constant Name_Id := N + 385; -- GNAT
+   Name_Fore                           : constant Name_Id := N + 386;
+   Name_Has_Access_Values              : constant Name_Id := N + 387; -- GNAT
+   Name_Has_Discriminants              : constant Name_Id := N + 388; -- GNAT
+   Name_Identity                       : constant Name_Id := N + 389;
+   Name_Img                            : constant Name_Id := N + 390; -- GNAT
+   Name_Integer_Value                  : constant Name_Id := N + 391; -- GNAT
+   Name_Large                          : constant Name_Id := N + 392; -- Ada 83
+   Name_Last                           : constant Name_Id := N + 393;
+   Name_Last_Bit                       : constant Name_Id := N + 394;
+   Name_Leading_Part                   : constant Name_Id := N + 395;
+   Name_Length                         : constant Name_Id := N + 396;
+   Name_Machine_Emax                   : constant Name_Id := N + 397;
+   Name_Machine_Emin                   : constant Name_Id := N + 398;
+   Name_Machine_Mantissa               : constant Name_Id := N + 399;
+   Name_Machine_Overflows              : constant Name_Id := N + 400;
+   Name_Machine_Radix                  : constant Name_Id := N + 401;
+   Name_Machine_Rounding               : constant Name_Id := N + 402; -- Ada 05
+   Name_Machine_Rounds                 : constant Name_Id := N + 403;
+   Name_Machine_Size                   : constant Name_Id := N + 404; -- GNAT
+   Name_Mantissa                       : constant Name_Id := N + 405; -- Ada 83
+   Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + 406;
+   Name_Maximum_Alignment              : constant Name_Id := N + 407; -- GNAT
+   Name_Mechanism_Code                 : constant Name_Id := N + 408; -- GNAT
+   Name_Mod                            : constant Name_Id := N + 409;
+   Name_Model_Emin                     : constant Name_Id := N + 410;
+   Name_Model_Epsilon                  : constant Name_Id := N + 411;
+   Name_Model_Mantissa                 : constant Name_Id := N + 412;
+   Name_Model_Small                    : constant Name_Id := N + 413;
+   Name_Modulus                        : constant Name_Id := N + 414;
+   Name_Null_Parameter                 : constant Name_Id := N + 415; -- GNAT
+   Name_Object_Size                    : constant Name_Id := N + 416; -- GNAT
+   Name_Partition_ID                   : constant Name_Id := N + 417;
+   Name_Passed_By_Reference            : constant Name_Id := N + 418; -- GNAT
+   Name_Pool_Address                   : constant Name_Id := N + 419;
+   Name_Pos                            : constant Name_Id := N + 420;
+   Name_Position                       : constant Name_Id := N + 421;
+   Name_Range                          : constant Name_Id := N + 422;
+   Name_Range_Length                   : constant Name_Id := N + 423; -- GNAT
+   Name_Round                          : constant Name_Id := N + 424;
+   Name_Safe_Emax                      : constant Name_Id := N + 425; -- Ada 83
+   Name_Safe_First                     : constant Name_Id := N + 426;
+   Name_Safe_Large                     : constant Name_Id := N + 427; -- Ada 83
+   Name_Safe_Last                      : constant Name_Id := N + 428;
+   Name_Safe_Small                     : constant Name_Id := N + 429; -- Ada 83
+   Name_Scale                          : constant Name_Id := N + 430;
+   Name_Scaling                        : constant Name_Id := N + 431;
+   Name_Signed_Zeros                   : constant Name_Id := N + 432;
+   Name_Size                           : constant Name_Id := N + 433;
+   Name_Small                          : constant Name_Id := N + 434;
+   Name_Storage_Size                   : constant Name_Id := N + 435;
+   Name_Storage_Unit                   : constant Name_Id := N + 436; -- GNAT
+   Name_Stream_Size                    : constant Name_Id := N + 437; -- Ada 05
+   Name_Tag                            : constant Name_Id := N + 438;
+   Name_Target_Name                    : constant Name_Id := N + 439; -- GNAT
+   Name_Terminated                     : constant Name_Id := N + 440;
+   Name_To_Address                     : constant Name_Id := N + 441; -- GNAT
+   Name_Type_Class                     : constant Name_Id := N + 442; -- GNAT
+   Name_UET_Address                    : constant Name_Id := N + 443; -- GNAT
+   Name_Unbiased_Rounding              : constant Name_Id := N + 444;
+   Name_Unchecked_Access               : constant Name_Id := N + 445;
+   Name_Unconstrained_Array            : constant Name_Id := N + 446;
+   Name_Universal_Literal_String       : constant Name_Id := N + 447; -- GNAT
+   Name_Unrestricted_Access            : constant Name_Id := N + 448; -- GNAT
+   Name_VADS_Size                      : constant Name_Id := N + 449; -- GNAT
+   Name_Val                            : constant Name_Id := N + 450;
+   Name_Valid                          : constant Name_Id := N + 451;
+   Name_Value_Size                     : constant Name_Id := N + 452; -- GNAT
+   Name_Version                        : constant Name_Id := N + 453;
+   Name_Wchar_T_Size                   : constant Name_Id := N + 454; -- GNAT
+   Name_Wide_Wide_Width                : constant Name_Id := N + 455; -- Ada 05
+   Name_Wide_Width                     : constant Name_Id := N + 456;
+   Name_Width                          : constant Name_Id := N + 457;
+   Name_Word_Size                      : constant Name_Id := N + 458; -- GNAT
 
    --  Attributes that designate attributes returning renamable functions,
    --  i.e. functions that return other than a universal value and that
    --  have non-universal arguments.
 
-   First_Renamable_Function_Attribute  : constant Name_Id := N + 457;
-   Name_Adjacent                       : constant Name_Id := N + 457;
-   Name_Ceiling                        : constant Name_Id := N + 458;
-   Name_Copy_Sign                      : constant Name_Id := N + 459;
-   Name_Floor                          : constant Name_Id := N + 460;
-   Name_Fraction                       : constant Name_Id := N + 461;
-   Name_Image                          : constant Name_Id := N + 462;
-   Name_Input                          : constant Name_Id := N + 463;
-   Name_Machine                        : constant Name_Id := N + 464;
-   Name_Max                            : constant Name_Id := N + 465;
-   Name_Min                            : constant Name_Id := N + 466;
-   Name_Model                          : constant Name_Id := N + 467;
-   Name_Pred                           : constant Name_Id := N + 468;
-   Name_Remainder                      : constant Name_Id := N + 469;
-   Name_Rounding                       : constant Name_Id := N + 470;
-   Name_Succ                           : constant Name_Id := N + 471;
-   Name_Truncation                     : constant Name_Id := N + 472;
-   Name_Value                          : constant Name_Id := N + 473;
-   Name_Wide_Image                     : constant Name_Id := N + 474;
-   Name_Wide_Wide_Image                : constant Name_Id := N + 475;
-   Name_Wide_Value                     : constant Name_Id := N + 476;
-   Name_Wide_Wide_Value                : constant Name_Id := N + 477;
-   Last_Renamable_Function_Attribute   : constant Name_Id := N + 477;
+   First_Renamable_Function_Attribute  : constant Name_Id := N + 459;
+   Name_Adjacent                       : constant Name_Id := N + 459;
+   Name_Ceiling                        : constant Name_Id := N + 460;
+   Name_Copy_Sign                      : constant Name_Id := N + 461;
+   Name_Floor                          : constant Name_Id := N + 462;
+   Name_Fraction                       : constant Name_Id := N + 463;
+   Name_Image                          : constant Name_Id := N + 464;
+   Name_Input                          : constant Name_Id := N + 465;
+   Name_Machine                        : constant Name_Id := N + 466;
+   Name_Max                            : constant Name_Id := N + 467;
+   Name_Min                            : constant Name_Id := N + 468;
+   Name_Model                          : constant Name_Id := N + 469;
+   Name_Pred                           : constant Name_Id := N + 470;
+   Name_Remainder                      : constant Name_Id := N + 471;
+   Name_Rounding                       : constant Name_Id := N + 472;
+   Name_Succ                           : constant Name_Id := N + 473;
+   Name_Truncation                     : constant Name_Id := N + 474;
+   Name_Value                          : constant Name_Id := N + 475;
+   Name_Wide_Image                     : constant Name_Id := N + 476;
+   Name_Wide_Wide_Image                : constant Name_Id := N + 477;
+   Name_Wide_Value                     : constant Name_Id := N + 478;
+   Name_Wide_Wide_Value                : constant Name_Id := N + 479;
+   Last_Renamable_Function_Attribute   : constant Name_Id := N + 479;
 
    --  Attributes that designate procedures
 
-   First_Procedure_Attribute           : constant Name_Id := N + 478;
-   Name_Output                         : constant Name_Id := N + 478;
-   Name_Read                           : constant Name_Id := N + 479;
-   Name_Write                          : constant Name_Id := N + 480;
-   Last_Procedure_Attribute            : constant Name_Id := N + 480;
+   First_Procedure_Attribute           : constant Name_Id := N + 480;
+   Name_Output                         : constant Name_Id := N + 480;
+   Name_Read                           : constant Name_Id := N + 481;
+   Name_Write                          : constant Name_Id := N + 482;
+   Last_Procedure_Attribute            : constant Name_Id := N + 482;
 
    --  Remaining attributes are ones that return entities
 
-   First_Entity_Attribute_Name         : constant Name_Id := N + 481;
-   Name_Elab_Body                      : constant Name_Id := N + 481; -- GNAT
-   Name_Elab_Spec                      : constant Name_Id := N + 482; -- GNAT
-   Name_Storage_Pool                   : constant Name_Id := N + 483;
+   First_Entity_Attribute_Name         : constant Name_Id := N + 483;
+   Name_Elab_Body                      : constant Name_Id := N + 483; -- GNAT
+   Name_Elab_Spec                      : constant Name_Id := N + 484; -- GNAT
+   Name_Storage_Pool                   : constant Name_Id := N + 485;
 
    --  These attributes are the ones that return types
 
-   First_Type_Attribute_Name           : constant Name_Id := N + 484;
-   Name_Base                           : constant Name_Id := N + 484;
-   Name_Class                          : constant Name_Id := N + 485;
-   Last_Type_Attribute_Name            : constant Name_Id := N + 485;
-   Last_Entity_Attribute_Name          : constant Name_Id := N + 485;
-   Last_Attribute_Name                 : constant Name_Id := N + 485;
+   First_Type_Attribute_Name           : constant Name_Id := N + 486;
+   Name_Base                           : constant Name_Id := N + 486;
+   Name_Class                          : constant Name_Id := N + 487;
+   Last_Type_Attribute_Name            : constant Name_Id := N + 487;
+   Last_Entity_Attribute_Name          : constant Name_Id := N + 487;
+   Last_Attribute_Name                 : constant Name_Id := N + 487;
 
    --  Names of recognized locking policy identifiers
 
@@ -791,10 +797,10 @@ package Snames is
    --  name (e.g. C for Ceiling_Locking). If new policy names are added,
    --  the first character must be distinct.
 
-   First_Locking_Policy_Name           : constant Name_Id := N + 486;
-   Name_Ceiling_Locking                : constant Name_Id := N + 486;
-   Name_Inheritance_Locking            : constant Name_Id := N + 487;
-   Last_Locking_Policy_Name            : constant Name_Id := N + 487;
+   First_Locking_Policy_Name           : constant Name_Id := N + 488;
+   Name_Ceiling_Locking                : constant Name_Id := N + 488;
+   Name_Inheritance_Locking            : constant Name_Id := N + 489;
+   Last_Locking_Policy_Name            : constant Name_Id := N + 489;
 
    --  Names of recognized queuing policy identifiers
 
@@ -802,10 +808,10 @@ package Snames is
    --  name (e.g. F for FIFO_Queuing). If new policy names are added,
    --  the first character must be distinct.
 
-   First_Queuing_Policy_Name           : constant Name_Id := N + 488;
-   Name_FIFO_Queuing                   : constant Name_Id := N + 488;
-   Name_Priority_Queuing               : constant Name_Id := N + 489;
-   Last_Queuing_Policy_Name            : constant Name_Id := N + 489;
+   First_Queuing_Policy_Name           : constant Name_Id := N + 490;
+   Name_FIFO_Queuing                   : constant Name_Id := N + 490;
+   Name_Priority_Queuing               : constant Name_Id := N + 491;
+   Last_Queuing_Policy_Name            : constant Name_Id := N + 491;
 
    --  Names of recognized task dispatching policy identifiers
 
@@ -813,215 +819,220 @@ package Snames is
    --  name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
    --  are added, the first character must be distinct.
 
-   First_Task_Dispatching_Policy_Name  : constant Name_Id := N + 490;
-   Name_FIFO_Within_Priorities         : constant Name_Id := N + 490;
-   Last_Task_Dispatching_Policy_Name   : constant Name_Id := N + 490;
+   First_Task_Dispatching_Policy_Name  : constant Name_Id := N + 492;
+   Name_FIFO_Within_Priorities         : constant Name_Id := N + 492;
+   Last_Task_Dispatching_Policy_Name   : constant Name_Id := N + 492;
 
    --  Names of recognized checks for pragma Suppress
 
-   First_Check_Name                    : constant Name_Id := N + 491;
-   Name_Access_Check                   : constant Name_Id := N + 491;
-   Name_Accessibility_Check            : constant Name_Id := N + 492;
-   Name_Discriminant_Check             : constant Name_Id := N + 493;
-   Name_Division_Check                 : constant Name_Id := N + 494;
-   Name_Elaboration_Check              : constant Name_Id := N + 495;
-   Name_Index_Check                    : constant Name_Id := N + 496;
-   Name_Length_Check                   : constant Name_Id := N + 497;
-   Name_Overflow_Check                 : constant Name_Id := N + 498;
-   Name_Range_Check                    : constant Name_Id := N + 499;
-   Name_Storage_Check                  : constant Name_Id := N + 500;
-   Name_Tag_Check                      : constant Name_Id := N + 501;
-   Name_All_Checks                     : constant Name_Id := N + 502;
-   Last_Check_Name                     : constant Name_Id := N + 502;
+   First_Check_Name                    : constant Name_Id := N + 493;
+   Name_Access_Check                   : constant Name_Id := N + 493;
+   Name_Accessibility_Check            : constant Name_Id := N + 494;
+   Name_Discriminant_Check             : constant Name_Id := N + 495;
+   Name_Division_Check                 : constant Name_Id := N + 496;
+   Name_Elaboration_Check              : constant Name_Id := N + 497;
+   Name_Index_Check                    : constant Name_Id := N + 498;
+   Name_Length_Check                   : constant Name_Id := N + 499;
+   Name_Overflow_Check                 : constant Name_Id := N + 500;
+   Name_Range_Check                    : constant Name_Id := N + 501;
+   Name_Storage_Check                  : constant Name_Id := N + 502;
+   Name_Tag_Check                      : constant Name_Id := N + 503;
+   Name_All_Checks                     : constant Name_Id := N + 504;
+   Last_Check_Name                     : constant Name_Id := N + 504;
 
    --  Names corresponding to reserved keywords, excluding those already
    --  declared in the attribute list (Access, Delta, Digits, Mod, Range).
 
-   Name_Abort                          : constant Name_Id := N + 503;
-   Name_Abs                            : constant Name_Id := N + 504;
-   Name_Accept                         : constant Name_Id := N + 505;
-   Name_And                            : constant Name_Id := N + 506;
-   Name_All                            : constant Name_Id := N + 507;
-   Name_Array                          : constant Name_Id := N + 508;
-   Name_At                             : constant Name_Id := N + 509;
-   Name_Begin                          : constant Name_Id := N + 510;
-   Name_Body                           : constant Name_Id := N + 511;
-   Name_Case                           : constant Name_Id := N + 512;
-   Name_Constant                       : constant Name_Id := N + 513;
-   Name_Declare                        : constant Name_Id := N + 514;
-   Name_Delay                          : constant Name_Id := N + 515;
-   Name_Do                             : constant Name_Id := N + 516;
-   Name_Else                           : constant Name_Id := N + 517;
-   Name_Elsif                          : constant Name_Id := N + 518;
-   Name_End                            : constant Name_Id := N + 519;
-   Name_Entry                          : constant Name_Id := N + 520;
-   Name_Exception                      : constant Name_Id := N + 521;
-   Name_Exit                           : constant Name_Id := N + 522;
-   Name_For                            : constant Name_Id := N + 523;
-   Name_Function                       : constant Name_Id := N + 524;
-   Name_Generic                        : constant Name_Id := N + 525;
-   Name_Goto                           : constant Name_Id := N + 526;
-   Name_If                             : constant Name_Id := N + 527;
-   Name_In                             : constant Name_Id := N + 528;
-   Name_Is                             : constant Name_Id := N + 529;
-   Name_Limited                        : constant Name_Id := N + 530;
-   Name_Loop                           : constant Name_Id := N + 531;
-   Name_New                            : constant Name_Id := N + 532;
-   Name_Not                            : constant Name_Id := N + 533;
-   Name_Null                           : constant Name_Id := N + 534;
-   Name_Of                             : constant Name_Id := N + 535;
-   Name_Or                             : constant Name_Id := N + 536;
-   Name_Others                         : constant Name_Id := N + 537;
-   Name_Out                            : constant Name_Id := N + 538;
-   Name_Package                        : constant Name_Id := N + 539;
-   Name_Pragma                         : constant Name_Id := N + 540;
-   Name_Private                        : constant Name_Id := N + 541;
-   Name_Procedure                      : constant Name_Id := N + 542;
-   Name_Raise                          : constant Name_Id := N + 543;
-   Name_Record                         : constant Name_Id := N + 544;
-   Name_Rem                            : constant Name_Id := N + 545;
-   Name_Renames                        : constant Name_Id := N + 546;
-   Name_Return                         : constant Name_Id := N + 547;
-   Name_Reverse                        : constant Name_Id := N + 548;
-   Name_Select                         : constant Name_Id := N + 549;
-   Name_Separate                       : constant Name_Id := N + 550;
-   Name_Subtype                        : constant Name_Id := N + 551;
-   Name_Task                           : constant Name_Id := N + 552;
-   Name_Terminate                      : constant Name_Id := N + 553;
-   Name_Then                           : constant Name_Id := N + 554;
-   Name_Type                           : constant Name_Id := N + 555;
-   Name_Use                            : constant Name_Id := N + 556;
-   Name_When                           : constant Name_Id := N + 557;
-   Name_While                          : constant Name_Id := N + 558;
-   Name_With                           : constant Name_Id := N + 559;
-   Name_Xor                            : constant Name_Id := N + 560;
+   Name_Abort                          : constant Name_Id := N + 505;
+   Name_Abs                            : constant Name_Id := N + 506;
+   Name_Accept                         : constant Name_Id := N + 507;
+   Name_And                            : constant Name_Id := N + 508;
+   Name_All                            : constant Name_Id := N + 509;
+   Name_Array                          : constant Name_Id := N + 510;
+   Name_At                             : constant Name_Id := N + 511;
+   Name_Begin                          : constant Name_Id := N + 512;
+   Name_Body                           : constant Name_Id := N + 513;
+   Name_Case                           : constant Name_Id := N + 514;
+   Name_Constant                       : constant Name_Id := N + 515;
+   Name_Declare                        : constant Name_Id := N + 516;
+   Name_Delay                          : constant Name_Id := N + 517;
+   Name_Do                             : constant Name_Id := N + 518;
+   Name_Else                           : constant Name_Id := N + 519;
+   Name_Elsif                          : constant Name_Id := N + 520;
+   Name_End                            : constant Name_Id := N + 521;
+   Name_Entry                          : constant Name_Id := N + 522;
+   Name_Exception                      : constant Name_Id := N + 523;
+   Name_Exit                           : constant Name_Id := N + 524;
+   Name_For                            : constant Name_Id := N + 525;
+   Name_Function                       : constant Name_Id := N + 526;
+   Name_Generic                        : constant Name_Id := N + 527;
+   Name_Goto                           : constant Name_Id := N + 528;
+   Name_If                             : constant Name_Id := N + 529;
+   Name_In                             : constant Name_Id := N + 530;
+   Name_Is                             : constant Name_Id := N + 531;
+   Name_Limited                        : constant Name_Id := N + 532;
+   Name_Loop                           : constant Name_Id := N + 533;
+   Name_New                            : constant Name_Id := N + 534;
+   Name_Not                            : constant Name_Id := N + 535;
+   Name_Null                           : constant Name_Id := N + 536;
+   Name_Of                             : constant Name_Id := N + 537;
+   Name_Or                             : constant Name_Id := N + 538;
+   Name_Others                         : constant Name_Id := N + 539;
+   Name_Out                            : constant Name_Id := N + 540;
+   Name_Package                        : constant Name_Id := N + 541;
+   Name_Pragma                         : constant Name_Id := N + 542;
+   Name_Private                        : constant Name_Id := N + 543;
+   Name_Procedure                      : constant Name_Id := N + 544;
+   Name_Raise                          : constant Name_Id := N + 545;
+   Name_Record                         : constant Name_Id := N + 546;
+   Name_Rem                            : constant Name_Id := N + 547;
+   Name_Renames                        : constant Name_Id := N + 548;
+   Name_Return                         : constant Name_Id := N + 549;
+   Name_Reverse                        : constant Name_Id := N + 550;
+   Name_Select                         : constant Name_Id := N + 551;
+   Name_Separate                       : constant Name_Id := N + 552;
+   Name_Subtype                        : constant Name_Id := N + 553;
+   Name_Task                           : constant Name_Id := N + 554;
+   Name_Terminate                      : constant Name_Id := N + 555;
+   Name_Then                           : constant Name_Id := N + 556;
+   Name_Type                           : constant Name_Id := N + 557;
+   Name_Use                            : constant Name_Id := N + 558;
+   Name_When                           : constant Name_Id := N + 559;
+   Name_While                          : constant Name_Id := N + 560;
+   Name_With                           : constant Name_Id := N + 561;
+   Name_Xor                            : constant Name_Id := N + 562;
 
    --  Names of intrinsic subprograms
 
    --  Note: Asm is missing from this list, since Asm is a legitimate
    --  convention name. So is To_Adress, which is a GNAT attribute.
 
-   First_Intrinsic_Name                 : constant Name_Id := N + 561;
-   Name_Divide                          : constant Name_Id := N + 561;
-   Name_Enclosing_Entity                : constant Name_Id := N + 562;
-   Name_Exception_Information           : constant Name_Id := N + 563;
-   Name_Exception_Message               : constant Name_Id := N + 564;
-   Name_Exception_Name                  : constant Name_Id := N + 565;
-   Name_File                            : constant Name_Id := N + 566;
-   Name_Generic_Dispatching_Constructor : constant Name_Id := N + 567;
-   Name_Import_Address                  : constant Name_Id := N + 568;
-   Name_Import_Largest_Value            : constant Name_Id := N + 569;
-   Name_Import_Value                    : constant Name_Id := N + 570;
-   Name_Is_Negative                     : constant Name_Id := N + 571;
-   Name_Line                            : constant Name_Id := N + 572;
-   Name_Rotate_Left                     : constant Name_Id := N + 573;
-   Name_Rotate_Right                    : constant Name_Id := N + 574;
-   Name_Shift_Left                      : constant Name_Id := N + 575;
-   Name_Shift_Right                     : constant Name_Id := N + 576;
-   Name_Shift_Right_Arithmetic          : constant Name_Id := N + 577;
-   Name_Source_Location                 : constant Name_Id := N + 578;
-   Name_Unchecked_Conversion            : constant Name_Id := N + 579;
-   Name_Unchecked_Deallocation          : constant Name_Id := N + 580;
-   Name_To_Pointer                      : constant Name_Id := N + 581;
-   Last_Intrinsic_Name                  : constant Name_Id := N + 581;
+   First_Intrinsic_Name                 : constant Name_Id := N + 563;
+   Name_Divide                          : constant Name_Id := N + 563;
+   Name_Enclosing_Entity                : constant Name_Id := N + 564;
+   Name_Exception_Information           : constant Name_Id := N + 565;
+   Name_Exception_Message               : constant Name_Id := N + 566;
+   Name_Exception_Name                  : constant Name_Id := N + 567;
+   Name_File                            : constant Name_Id := N + 568;
+   Name_Generic_Dispatching_Constructor : constant Name_Id := N + 569;
+   Name_Import_Address                  : constant Name_Id := N + 570;
+   Name_Import_Largest_Value            : constant Name_Id := N + 571;
+   Name_Import_Value                    : constant Name_Id := N + 572;
+   Name_Is_Negative                     : constant Name_Id := N + 573;
+   Name_Line                            : constant Name_Id := N + 574;
+   Name_Rotate_Left                     : constant Name_Id := N + 575;
+   Name_Rotate_Right                    : constant Name_Id := N + 576;
+   Name_Shift_Left                      : constant Name_Id := N + 577;
+   Name_Shift_Right                     : constant Name_Id := N + 578;
+   Name_Shift_Right_Arithmetic          : constant Name_Id := N + 579;
+   Name_Source_Location                 : constant Name_Id := N + 580;
+   Name_Unchecked_Conversion            : constant Name_Id := N + 581;
+   Name_Unchecked_Deallocation          : constant Name_Id := N + 582;
+   Name_To_Pointer                      : constant Name_Id := N + 583;
+   Last_Intrinsic_Name                  : constant Name_Id := N + 583;
+
+   --  Names used in processing intrinsic calls
+
+   Name_Free                           : constant Name_Id := N + 584;
 
    --  Reserved words used only in Ada 95
 
-   First_95_Reserved_Word              : constant Name_Id := N + 582;
-   Name_Abstract                       : constant Name_Id := N + 582;
-   Name_Aliased                        : constant Name_Id := N + 583;
-   Name_Protected                      : constant Name_Id := N + 584;
-   Name_Until                          : constant Name_Id := N + 585;
-   Name_Requeue                        : constant Name_Id := N + 586;
-   Name_Tagged                         : constant Name_Id := N + 587;
-   Last_95_Reserved_Word               : constant Name_Id := N + 587;
+   First_95_Reserved_Word              : constant Name_Id := N + 585;
+   Name_Abstract                       : constant Name_Id := N + 585;
+   Name_Aliased                        : constant Name_Id := N + 586;
+   Name_Protected                      : constant Name_Id := N + 587;
+   Name_Until                          : constant Name_Id := N + 588;
+   Name_Requeue                        : constant Name_Id := N + 589;
+   Name_Tagged                         : constant Name_Id := N + 590;
+   Last_95_Reserved_Word               : constant Name_Id := N + 590;
 
    subtype Ada_95_Reserved_Words is
      Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
 
    --  Miscellaneous names used in semantic checking
 
-   Name_Raise_Exception                : constant Name_Id := N + 588;
+   Name_Raise_Exception                : constant Name_Id := N + 591;
 
    --  Additional reserved words and identifiers used in GNAT Project Files
    --  Note that Name_External is already previously declared
 
-   Name_Ada_Roots                      : constant Name_Id := N + 589;
-   Name_Binder                         : constant Name_Id := N + 590;
-   Name_Binder_Driver                  : constant Name_Id := N + 591;
-   Name_Body_Suffix                    : constant Name_Id := N + 592;
-   Name_Builder                        : constant Name_Id := N + 593;
-   Name_Compiler                       : constant Name_Id := N + 594;
-   Name_Compiler_Driver                : constant Name_Id := N + 595;
-   Name_Compiler_Kind                  : constant Name_Id := N + 596;
-   Name_Compute_Dependency             : constant Name_Id := N + 597;
-   Name_Cross_Reference                : constant Name_Id := N + 598;
-   Name_Default_Linker                 : constant Name_Id := N + 599;
-   Name_Default_Switches               : constant Name_Id := N + 600;
-   Name_Dependency_Option              : constant Name_Id := N + 601;
-   Name_Exec_Dir                       : constant Name_Id := N + 602;
-   Name_Executable                     : constant Name_Id := N + 603;
-   Name_Executable_Suffix              : constant Name_Id := N + 604;
-   Name_Extends                        : constant Name_Id := N + 605;
-   Name_Externally_Built               : constant Name_Id := N + 606;
-   Name_Finder                         : constant Name_Id := N + 607;
-   Name_Global_Configuration_Pragmas   : constant Name_Id := N + 608;
-   Name_Gnatls                         : constant Name_Id := N + 609;
-   Name_Gnatstub                       : constant Name_Id := N + 610;
-   Name_Implementation                 : constant Name_Id := N + 611;
-   Name_Implementation_Exceptions      : constant Name_Id := N + 612;
-   Name_Implementation_Suffix          : constant Name_Id := N + 613;
-   Name_Include_Option                 : constant Name_Id := N + 614;
-   Name_Language_Processing            : constant Name_Id := N + 615;
-   Name_Languages                      : constant Name_Id := N + 616;
-   Name_Library_Dir                    : constant Name_Id := N + 617;
-   Name_Library_Auto_Init              : constant Name_Id := N + 618;
-   Name_Library_GCC                    : constant Name_Id := N + 619;
-   Name_Library_Interface              : constant Name_Id := N + 620;
-   Name_Library_Kind                   : constant Name_Id := N + 621;
-   Name_Library_Name                   : constant Name_Id := N + 622;
-   Name_Library_Options                : constant Name_Id := N + 623;
-   Name_Library_Reference_Symbol_File  : constant Name_Id := N + 624;
-   Name_Library_Src_Dir                : constant Name_Id := N + 625;
-   Name_Library_Symbol_File            : constant Name_Id := N + 626;
-   Name_Library_Symbol_Policy          : constant Name_Id := N + 627;
-   Name_Library_Version                : constant Name_Id := N + 628;
-   Name_Linker                         : constant Name_Id := N + 629;
-   Name_Local_Configuration_Pragmas    : constant Name_Id := N + 630;
-   Name_Locally_Removed_Files          : constant Name_Id := N + 631;
-   Name_Metrics                        : constant Name_Id := N + 632;
-   Name_Naming                         : constant Name_Id := N + 633;
-   Name_Object_Dir                     : constant Name_Id := N + 634;
-   Name_Pretty_Printer                 : constant Name_Id := N + 635;
-   Name_Project                        : constant Name_Id := N + 636;
-   Name_Separate_Suffix                : constant Name_Id := N + 637;
-   Name_Source_Dirs                    : constant Name_Id := N + 638;
-   Name_Source_Files                   : constant Name_Id := N + 639;
-   Name_Source_List_File               : constant Name_Id := N + 640;
-   Name_Spec                           : constant Name_Id := N + 641;
-   Name_Spec_Suffix                    : constant Name_Id := N + 642;
-   Name_Specification                  : constant Name_Id := N + 643;
-   Name_Specification_Exceptions       : constant Name_Id := N + 644;
-   Name_Specification_Suffix           : constant Name_Id := N + 645;
-   Name_Switches                       : constant Name_Id := N + 646;
+   Name_Ada_Roots                      : constant Name_Id := N + 592;
+   Name_Binder                         : constant Name_Id := N + 593;
+   Name_Binder_Driver                  : constant Name_Id := N + 594;
+   Name_Body_Suffix                    : constant Name_Id := N + 595;
+   Name_Builder                        : constant Name_Id := N + 596;
+   Name_Compiler                       : constant Name_Id := N + 597;
+   Name_Compiler_Driver                : constant Name_Id := N + 598;
+   Name_Compiler_Kind                  : constant Name_Id := N + 599;
+   Name_Compute_Dependency             : constant Name_Id := N + 600;
+   Name_Cross_Reference                : constant Name_Id := N + 601;
+   Name_Default_Linker                 : constant Name_Id := N + 602;
+   Name_Default_Switches               : constant Name_Id := N + 603;
+   Name_Dependency_Option              : constant Name_Id := N + 604;
+   Name_Exec_Dir                       : constant Name_Id := N + 605;
+   Name_Executable                     : constant Name_Id := N + 606;
+   Name_Executable_Suffix              : constant Name_Id := N + 607;
+   Name_Extends                        : constant Name_Id := N + 608;
+   Name_Externally_Built               : constant Name_Id := N + 609;
+   Name_Finder                         : constant Name_Id := N + 610;
+   Name_Global_Configuration_Pragmas   : constant Name_Id := N + 611;
+   Name_Gnatls                         : constant Name_Id := N + 612;
+   Name_Gnatstub                       : constant Name_Id := N + 613;
+   Name_Implementation                 : constant Name_Id := N + 614;
+   Name_Implementation_Exceptions      : constant Name_Id := N + 615;
+   Name_Implementation_Suffix          : constant Name_Id := N + 616;
+   Name_Include_Option                 : constant Name_Id := N + 617;
+   Name_Language_Processing            : constant Name_Id := N + 618;
+   Name_Languages                      : constant Name_Id := N + 619;
+   Name_Library_Ali_Dir                : constant Name_Id := N + 620;
+   Name_Library_Dir                    : constant Name_Id := N + 621;
+   Name_Library_Auto_Init              : constant Name_Id := N + 622;
+   Name_Library_GCC                    : constant Name_Id := N + 623;
+   Name_Library_Interface              : constant Name_Id := N + 624;
+   Name_Library_Kind                   : constant Name_Id := N + 625;
+   Name_Library_Name                   : constant Name_Id := N + 626;
+   Name_Library_Options                : constant Name_Id := N + 627;
+   Name_Library_Reference_Symbol_File  : constant Name_Id := N + 628;
+   Name_Library_Src_Dir                : constant Name_Id := N + 629;
+   Name_Library_Symbol_File            : constant Name_Id := N + 630;
+   Name_Library_Symbol_Policy          : constant Name_Id := N + 631;
+   Name_Library_Version                : constant Name_Id := N + 632;
+   Name_Linker                         : constant Name_Id := N + 633;
+   Name_Local_Configuration_Pragmas    : constant Name_Id := N + 634;
+   Name_Locally_Removed_Files          : constant Name_Id := N + 635;
+   Name_Metrics                        : constant Name_Id := N + 636;
+   Name_Naming                         : constant Name_Id := N + 637;
+   Name_Object_Dir                     : constant Name_Id := N + 638;
+   Name_Pretty_Printer                 : constant Name_Id := N + 639;
+   Name_Project                        : constant Name_Id := N + 640;
+   Name_Separate_Suffix                : constant Name_Id := N + 641;
+   Name_Source_Dirs                    : constant Name_Id := N + 642;
+   Name_Source_Files                   : constant Name_Id := N + 643;
+   Name_Source_List_File               : constant Name_Id := N + 644;
+   Name_Spec                           : constant Name_Id := N + 645;
+   Name_Spec_Suffix                    : constant Name_Id := N + 646;
+   Name_Specification                  : constant Name_Id := N + 647;
+   Name_Specification_Exceptions       : constant Name_Id := N + 648;
+   Name_Specification_Suffix           : constant Name_Id := N + 649;
+   Name_Switches                       : constant Name_Id := N + 650;
 
    --  Other miscellaneous names used in front end
 
-   Name_Unaligned_Valid                : constant Name_Id := N + 647;
+   Name_Unaligned_Valid                : constant Name_Id := N + 651;
 
    --  ----------------------------------------------------------------
-   First_2005_Reserved_Word            : constant Name_Id := N + 648;
-   Name_Interface                      : constant Name_Id := N + 648;
-   Name_Overriding                     : constant Name_Id := N + 649;
-   Name_Synchronized                   : constant Name_Id := N + 650;
-   Last_2005_Reserved_Word             : constant Name_Id := N + 650;
+   First_2005_Reserved_Word            : constant Name_Id := N + 652;
+   Name_Interface                      : constant Name_Id := N + 652;
+   Name_Overriding                     : constant Name_Id := N + 653;
+   Name_Synchronized                   : constant Name_Id := N + 654;
+   Last_2005_Reserved_Word             : constant Name_Id := N + 654;
 
    subtype Ada_2005_Reserved_Words is
      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
 
    --  Mark last defined name for consistency check in Snames body
 
-   Last_Predefined_Name                : constant Name_Id := N + 650;
+   Last_Predefined_Name                : constant Name_Id := N + 654;
 
    subtype Any_Operator_Name is Name_Id range
      First_Operator_Name .. Last_Operator_Name;
@@ -1081,6 +1092,7 @@ package Snames is
       Attribute_Machine_Mantissa,
       Attribute_Machine_Overflows,
       Attribute_Machine_Radix,
+      Attribute_Machine_Rounding,
       Attribute_Machine_Rounds,
       Attribute_Machine_Size,
       Attribute_Mantissa,