a-tags.adb (IW_Membership): Give support to "Iface_CW_Typ in T'Class".

2005-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* a-tags.adb (IW_Membership): Give support to
	"Iface_CW_Typ in T'Class". For this purpose the functionality of this
	subprogram has been extended to look for the tag in the ancestors tag
	table.
	Update the structure of the GNAT Dispatch Table to reflect the
	additional two tables used in dispatching selects.
	Introduce appropriate array types and record components in
	Type_Specific_Data to reflect the two tables.
	(Get_Entry_Index, Set_Entry_Index): Retrieve and set the entry index in
	the TSD of a tag, indexed by position.
	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Retrieve and set the primitive
	operation kind in the TSD of a tag, indexed by position.

	* a-tags.ads: Introduce an enumeration type to capture different
	primitive operation kinds. Define a constant reflecting the number of
	predefined primitive operations.
	(Get_Entry_Index, Set_Entry_Index): Set and retrieve the entry index
	of an entry wrapper.
	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Set and retrieve the kind of
	callable entity of a primitive operation.

	* exp_ch3.adb (Freeze_Record_Type): Generate the declarations of the
	primitive operations used in dispatching selects for limited
	interfaces, limited tagged, task and protected types what implement a
	limited interface.
	(Freeze_Type): Generate the bodies of the primitive operations used in
	dispatching selects for limited tagged, task and protected types that
	implement a limited interface. Generate statements to populate the two
	auxiliary tables used for dispatching in select statements.
	(Freeze_Record_Type): Add call to initialize the dispatch table entries
	associated with predefined interface primitive operations.
	(Build_Dcheck_Function): Change Set_Subtype_Mark to
	Set_Result_Definition.
	(Build_Variant_Record_Equality): Change Subtype_Mark to
	Result_Definition.
	(Freeze_Enumeration_Type): Change Subtype_Mark to Result_Definition.
	(Predef_Spec_Or_Body): Change Subtype_Mark to Result_Definition.
	(Build_Assignment): Simplify the code that adds the run-time-check.
	(Expand_N_Object_Declaration): Code cleanup.

	* exp_ch7.adb (Make_Clean): Select the appropriate type for locking
	entries when there is a protected type that implements a limited
	interface.

	* exp_ch9.adb: Add package Select_Expansion_Utilities that contains
	common routines used in expansion of dispatching selects.
	(Add_Private_Declarations): Select the appropriate protection type when
	there is a protected type that implements a limited interface.
	(Build_Parameter_Block): Generate a wrapped parameter block.
	(Build_Protected_Subprogram_Body): Select the appropriate type for
	locking entries when there is a protected type that implements a
	limited interface.
	(Build_Wrapper_Spec): Set the flag and wrapped entity for procedures
	classified as entry wrappers.
	(Expand_N_Asynchronous_Select): Add support for expansion of dispatching
	asynchronous selects.
	(Expand_N_Conditional_Entry_Call): Add support for expansion of
	dispatching conditional selects.
	(Expand_N_Protected_Type_Declaration): Select the appropriate type for
	protection when there is a protected type that implements limited
	interfaces.
	(Expand_N_Timed_Entry_Call): Add support for expansion of dispatching
	timed selects.
	(Extract_Dispatching_Call): Extract the entity of the name of a
	dispatching call, the object parameter, actual parameters and
	corresponding formals.
	(Make_Initialize_Protection): Correct logic of protection initialization
	when there is a protected type that implements a limited interface.
	(Parameter_Block_Pack): Populate a wrapped parameter block with the
	values of actual parameters.
	(Parameter_Block_Unpack): Retrieve the values from a wrapped parameter
	block and assign them to the original actual parameters.

	* exp_ch9.ads (Subprogram_Protection_Mode): New type.
	(Build_Protected_Sub_Specification): Change the type and name of the
	last formal to account for the increased variety of protection modes.

	* einfo.ads, einfo.adb (Was_Hidden): New attribute. Present in all
	entities. Used to save the value of the Is_Hidden attribute when the
	limited-view is installed.
	(Is_Primitive_Wrapper, Set_Is_Primitive_Wrapper): Retrieve and change
	the attribute of procedures classified as entry wrappers.
	(Wrapped_Entity, Set_Wrapped_Entity): Retrieve and change the wrapped
	entity of a primitive wrapper.
	(Write_Entity_Flags): Output the name and value of the
	Is_Primitive_Wrapper attribute.
	(Write_Field27_Name): Output the name and entity of the field Wrapped_
	Entity.
	(Underlying_Type): If we have an incomplete entity that comes from
	the limited view then we return the Underlying_Type of its non-limited
	view if it is already available.
	(Abstract_Interface_Alias): Flag applies to all subrogram kinds,
	including operators.
	(Write_Field26_Name): Add entry for Overridden_Operation
	(Overridden_Operation): New attribute of functions and procedures.

	* exp_disp.ads, exp_disp.adb (Default_Prim_Op_Position): Return a
	predefined position in the dispatch table for the primitive operations
	used in dispatching selects.
	(Init_Predefined_Interface_Primitives): Remove the hardcoded number of
	predefined primitive operations and replace it with
	Default_Prim_Op_Count.
	(Make_Disp_Asynchronous_Select_Spec, Make_Disp_Conditional_Select_Spec,
	Make_Disp_Get_Prim_Op_Kind_Spec, Make_Disp_Timed_Select_Spec): Update
	the names of the generated primitive operations used in dispatching
	selects.
	(Init_Predefined_Interface_Primitives): No need to inherit primitives in
	case of abstract interface types. They will be inherit by the objects
	implementing the interface.
	(Make_DT): There is no need to inherit the dispatch table of the
	ancestor interface for the elaboration of abstract interface types.
	The dispatch table will be inherited by the object implementing the
	interface.
	(Copy_Secondary_DTs): Add documentation.
	(Validate_Position): Improve this static check in case of
	aliased subprograms because aliased subprograms must have
	the same position.
	(Init_Predefined_Interface_Primitives): New subprogram that initializes
	the entries associated with predefined primitives of all the secondary
	dispatch tables.
	(Build_Anonymous_Access_Type): Removed.
	(Expand_Interface_Actuals): With the previous cleanup there is no need
	to build an anonymous access type. This allows further cleanup in the
	code generated by the expander.
	(Expand_Interface_Conversion): If the actual is an access type then
	build an internal function to handle the displacement. If the actual
	is null this function returns null because no displacement is
	required; otherwise performs a type conversion that will be
	expanded in the code that returns the value of the displaced actual.
	(Expand_Interface_Actuals): Avoid the generation of unnecessary type
	conversions that have no effect in the generated code because no
	displacement is required. Code cleanup; use local variables to
	avoid repeated calls to the subprogram directly_designated_type().

	* exp_util.ads, exp_util.adb (Is_Predefined_Dispatching_Operation):
	Classify the primitive operations used in dispatching selects as
	predefined.
	(Implements_Limited_Interface): Determine whether some type either
	directly implements a limited interface or extends a type that
	implements a limited interface.
	(Build_Task_Image_Function): Change Subtype_Mark to Result_Definition.
	(Expand_Subtype_From_Expr): Do not build actual subtype if the
	expression is limited.
	(Find_Interface_Tag): Add code to handle class-wide types and
	entities from the limited-view.

	* rtsfind.ads: Add entries in RE_Id and RE_Unit_Table for
	Get_Entry_Index, Get_Prim_Op_Kind, POK_Function, POK_Procedure,
	POK_Protected_Entry, POK_Protected_Function, POK_Protected_Procedure,
	POK_Task_Entry, POK_Task_Procedure, Prim_Op_Kind, Set_Entry_Index,
	Set_Prim_Op_Kind.

	* sem_ch9.adb (Analyze_Triggering_Alternative): Check for legal type
	of procedure name or prefix that appears as a trigger in a triggering
	alternative.

	* uintp.ads: Introduce constants Uint_11 and Uint_13.

From-SVN: r103850

1 files changed, 2077 insertions, 454 deletions

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 8759d02..6911d86 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -57,11 +57,261 @@ with Snames;   use Snames;
 with Stand;    use Stand;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
-with Types;    use Types;
 with Uintp;    use Uintp;
 
 package body Exp_Ch9 is
 
+   --------------------------------
+   -- Select_Expansion_Utilities --
+   --------------------------------
+
+   --  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;
+      --  Generate:
+      --    begin
+      --       Blk
+      --    exception
+      --       when Abort_Signal => Abort_Undefer;
+      --    end;
+      --  Blk_Ent is the name of the encapsulated block, Blk is the actual
+      --  block node.
+
+      function Build_B
+        (Loc   : Source_Ptr;
+         Decls : List_Id) return Entity_Id;
+      --  Generate:
+      --    B : Boolean := False;
+      --  Append the object declaration to the list and return the name of
+      --  the object.
+
+      function Build_C
+        (Loc   : Source_Ptr;
+         Decls : List_Id) return Entity_Id;
+      --  Generate:
+      --    C : Ada.Tags.Prim_Op_Kind;
+      --  Append the object declaration to the list and return the name of
+      --  the object.
+
+      function Build_Cleanup_Block
+        (Loc       : Source_Ptr;
+         Blk_Ent   : Entity_Id;
+         Stmts     : List_Id;
+         Clean_Ent : Entity_Id) return Node_Id;
+      --  Generate:
+      --    declare
+      --       procedure _clean is
+      --       begin
+      --          ...
+      --       end _clean;
+      --    begin
+      --       Stmts
+      --    at end
+      --       _clean;
+      --    end;
+      --  Blk_Ent is the name of the generated block, Stmts is the list
+      --  of encapsulated statements and Clean_Ent is the parameter to
+      --  the _clean procedure.
+
+      function Build_S
+        (Loc      : Source_Ptr;
+         Decls    : List_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.
+
+      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;
+
+   package body Select_Expansion_Utilities is
+
+      -----------------------
+      -- Build_Abort_Block --
+      -----------------------
+
+      function Build_Abort_Block
+        (Loc   : Source_Ptr;
+         Blk_Ent : Entity_Id;
+         Blk     : Node_Id) return Node_Id
+      is
+      begin
+         return
+           Make_Block_Statement (Loc,
+             Declarations =>
+               No_List,
+
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements =>
+                   New_List (
+                     Make_Implicit_Label_Declaration (Loc,
+                       Defining_Identifier =>
+                         Blk_Ent,
+                       Label_Construct =>
+                         Blk),
+                     Blk),
+
+                 Exception_Handlers =>
+                   New_List (
+                     Make_Exception_Handler (Loc,
+                       Exception_Choices =>
+                         New_List (
+                           New_Reference_To (Stand.Abort_Signal, Loc)),
+                       Statements =>
+                         New_List (
+                           Make_Procedure_Call_Statement (Loc,
+                             Name =>
+                               New_Reference_To (RTE (
+                                 RE_Abort_Undefer), Loc),
+                             Parameter_Associations => No_List))))));
+      end Build_Abort_Block;
+
+      -------------
+      -- Build_B --
+      -------------
+
+      function Build_B
+        (Loc   : Source_Ptr;
+         Decls : List_Id) return Entity_Id
+      is
+         B : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uB);
+
+      begin
+         Append_To (Decls,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier =>
+               B,
+             Object_Definition =>
+               New_Reference_To (Standard_Boolean, Loc),
+             Expression =>
+               New_Reference_To (Standard_False, Loc)));
+
+         return B;
+      end Build_B;
+
+      -------------
+      -- Build_C --
+      -------------
+
+      function Build_C
+        (Loc   : Source_Ptr;
+         Decls : List_Id) return Entity_Id
+      is
+         C : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uC);
+
+      begin
+         Append_To (Decls,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier =>
+               C,
+             Object_Definition =>
+               New_Reference_To (RTE (RE_Prim_Op_Kind), Loc)));
+
+         return C;
+      end Build_C;
+
+      -------------------------
+      -- Build_Cleanup_Block --
+      -------------------------
+
+      function Build_Cleanup_Block
+        (Loc       : Source_Ptr;
+         Blk_Ent   : Entity_Id;
+         Stmts     : List_Id;
+         Clean_Ent : Entity_Id) return Node_Id
+      is
+         Cleanup_Block : constant Node_Id :=
+                           Make_Block_Statement (Loc,
+                             Identifier   => New_Reference_To (Blk_Ent, Loc),
+                             Declarations => No_List,
+                             Handled_Statement_Sequence =>
+                               Make_Handled_Sequence_Of_Statements (Loc,
+                                 Statements => Stmts),
+                             Is_Asynchronous_Call_Block => True);
+
+      begin
+         Set_Entry_Cancel_Parameter (Blk_Ent, Clean_Ent);
+
+         return Cleanup_Block;
+      end Build_Cleanup_Block;
+
+      -------------
+      -- Build_S --
+      -------------
+
+      function Build_S
+        (Loc      : Source_Ptr;
+         Decls    : List_Id;
+         Call_Ent : Entity_Id) return Entity_Id
+      is
+         S : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uS);
+
+      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))));
+
+         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;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -76,17 +326,6 @@ package body Exp_Ch9 is
    --  the expression computed by this function uses the discriminants
    --  of the target task.
 
-   function Index_Constant_Declaration
-     (N        : Node_Id;
-      Index_Id : Entity_Id;
-      Prot     : Entity_Id) return List_Id;
-   --  For an entry family and its barrier function, we define a local entity
-   --  that maps the index in the call into the entry index into the object:
-   --
-   --     I : constant Index_Type := Index_Type'Val (
-   --       E - <<index of first family member>> +
-   --       Protected_Entry_Index (Index_Type'Pos (Index_Type'First)));
-
    procedure Add_Object_Pointer
      (Decls : List_Id;
       Pid   : Entity_Id;
@@ -96,7 +335,7 @@ package body Exp_Ch9 is
    --  of the System.Address pointer passed to entry barrier functions
    --  and entry body procedures.
 
-   function Build_Accept_Body (Astat : Node_Id) return  Node_Id;
+   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
    --  select statements. Astat is the accept statement.
@@ -131,6 +370,23 @@ package body Exp_Ch9 is
    --  of the range of each entry family. A single array with that size is
    --  allocated for each concurrent object of the type.
 
+   function Build_Parameter_Block
+     (Loc     : Source_Ptr;
+      Actuals : List_Id;
+      Formals : List_Id;
+      Decls   : List_Id) return Entity_Id;
+   --  Generate an access type for each actual parameter in the list Actuals.
+   --  Cleate an encapsulating record that contains all the actuals and return
+   --  its type. Generate:
+   --    type Ann1 is access all <actual1-type>
+   --    ...
+   --    type AnnN is access all <actualN-type>
+   --    type Pnn is record
+   --       <formal1> : Ann1;
+   --       ...
+   --       <formalN> : AnnN;
+   --    end record;
+
    function Build_Wrapper_Body
      (Loc      : Source_Ptr;
       Proc_Nam : Entity_Id;
@@ -272,6 +528,16 @@ package body Exp_Ch9 is
    --  to the use of 'Length on the index type, but must use Family_Offset
    --  to handle properly the case of bounds that depend on discriminants.
 
+   procedure Extract_Dispatching_Call
+     (N        : Node_Id;
+      Call_Ent : out Entity_Id;
+      Object   : out Entity_Id;
+      Actuals  : out List_Id;
+      Formals  : out List_Id);
+   --  Given a dispatching call, extract the entity of the name of the call,
+   --  its object parameter, its actual parameters and the formal parameters
+   --  of the overriden interface-level version.
+
    procedure Extract_Entry
      (N       : Node_Id;
       Concval : out Node_Id;
@@ -289,6 +555,47 @@ package body Exp_Ch9 is
    --  when P is Name_uPriority, the call will also find Interrupt_Priority.
    --  ??? Should be implemented with the rep item chain mechanism.
 
+   function Index_Constant_Declaration
+     (N        : Node_Id;
+      Index_Id : Entity_Id;
+      Prot     : Entity_Id) return List_Id;
+   --  For an entry family and its barrier function, we define a local entity
+   --  that maps the index in the call into the entry index into the object:
+   --
+   --     I : constant Index_Type := Index_Type'Val (
+   --       E - <<index of first family member>> +
+   --       Protected_Entry_Index (Index_Type'Pos (Index_Type'First)));
+
+   function Parameter_Block_Pack
+     (Loc     : Source_Ptr;
+      Blk_Typ : Entity_Id;
+      Actuals : List_Id;
+      Formals : List_Id;
+      Decls   : List_Id;
+      Stmts   : List_Id) return Node_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
+   --  to the actual's value. Return the address of the aggregate block.
+   --  Generate:
+   --    Jnn1 : alias <formal-type1>;
+   --    Jnn1 := <actual1>;
+   --    ...
+   --    P : Blk_Typ := (
+   --      Jnn1'unchecked_access;
+   --      <actual2>'reference;
+   --      ...);
+
+   function Parameter_Block_Unpack
+     (Loc     : Source_Ptr;
+      Actuals : List_Id;
+      Formals : List_Id) return List_Id;
+   --  Retrieve the values of the components from the parameter block and
+   --  assign then to the original actual parameters. Generate:
+   --    <actual1> := P.<formal1>;
+   --    ...
+   --    <actualN> := P.<formalN>;
+
    procedure Update_Prival_Subtypes (N : Node_Id);
    --  The actual subtypes of the privals will differ from the type of the
    --  private declaration in the original protected type, if the protected
@@ -579,7 +886,13 @@ package body Exp_Ch9 is
          elsif Has_Interrupt_Handler (Typ) then
             Protection_Type := RE_Dynamic_Interrupt_Protection;
 
-         elsif Has_Entries (Typ) then
+         --  The type has explicit entries or generated primitive entry
+         --  wrappers.
+
+         elsif Has_Entries (Typ)
+            or else (Ada_Version >= Ada_05
+                       and then Present (Interface_List (Parent (Typ))))
+         then
             if Abort_Allowed
               or else Restriction_Active (No_Entry_Queue) = False
               or else Number_Entries (Typ) > 1
@@ -836,7 +1149,7 @@ package body Exp_Ch9 is
             Parameter_Type =>
               New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),
 
-        Subtype_Mark => New_Reference_To (Standard_Boolean, Loc));
+        Result_Definition => New_Reference_To (Standard_Boolean, Loc));
    end Build_Barrier_Function_Specification;
 
    --------------------------
@@ -998,9 +1311,92 @@ package body Exp_Ch9 is
       return Ecount;
    end Build_Entry_Count_Expression;
 
-   ------------------------------
+   ---------------------------
+   -- Build_Parameter_Block --
+   ---------------------------
+
+   function Build_Parameter_Block
+     (Loc     : Source_Ptr;
+      Actuals : List_Id;
+      Formals : List_Id;
+      Decls   : List_Id) return Entity_Id
+   is
+      Actual   : Entity_Id;
+      Comp_Nam : Node_Id;
+      Comp_Rec : Node_Id;
+      Comps    : List_Id;
+      Formal   : Entity_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>
+
+         Comp_Nam :=
+           Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+
+         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))));
+
+         --  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))));
+
+         Next_Actual (Actual);
+         Next_Formal_With_Extras (Formal);
+      end loop;
+
+      --  Generate:
+      --    type Pnn is record
+      --       Param1 : Ann1;
+      --       ...
+      --       ParamN : AnnN;
+
+      --  where Pnn is a parameter wrapping record, Param1 .. ParamN are the
+      --  original parameter names and Ann1 .. AnnN are the access to actual
+      --  types.
+
+      Comp_Rec :=
+        Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+
+      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))));
+
+      return Comp_Rec;
+   end Build_Parameter_Block;
+
+   ------------------------
    -- Build_Wrapper_Body --
-   ------------------------------
+   ------------------------
 
    function Build_Wrapper_Body
      (Loc      : Source_Ptr;
@@ -1370,7 +1766,10 @@ package body Exp_Ch9 is
       if Ekind (Proc_Nam) = E_Procedure
         or else Ekind (Proc_Nam) = E_Entry
       then
-         Set_Ekind (New_Name_Id, E_Procedure);
+         Set_Ekind                (New_Name_Id, E_Procedure);
+         Set_Is_Primitive_Wrapper (New_Name_Id);
+         Set_Wrapped_Entity       (New_Name_Id, Proc_Nam);
+
          return
            Make_Procedure_Specification (Loc,
              Defining_Unit_Name => New_Name_Id,
@@ -1378,11 +1777,13 @@ package body Exp_Ch9 is
 
       else pragma Assert (Ekind (Proc_Nam) = E_Function);
          Set_Ekind (New_Name_Id, E_Function);
+
          return
            Make_Function_Specification (Loc,
              Defining_Unit_Name => New_Name_Id,
              Parameter_Specifications => New_Formals,
-             Subtype_Mark => New_Copy (Subtype_Mark (Parent (Proc_Nam))));
+             Result_Definition =>
+               New_Copy (Result_Definition (Parent (Proc_Nam))));
       end if;
    end Build_Wrapper_Spec;
 
@@ -1602,7 +2003,7 @@ package body Exp_Ch9 is
               Defining_Identifier => Parm2,
               Parameter_Type =>
                 New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),
-          Subtype_Mark => New_Occurrence_Of (
+          Result_Definition => New_Occurrence_Of (
             RTE (RE_Protected_Entry_Index), Loc));
    end Build_Find_Body_Index_Spec;
 
@@ -1895,19 +2296,23 @@ package body Exp_Ch9 is
    ---------------------------------------
 
    function Build_Protected_Sub_Specification
-     (N           : Node_Id;
-      Prottyp     : Entity_Id;
-      Unprotected : Boolean := False) return Node_Id
+     (N       : Node_Id;
+      Prottyp : Entity_Id;
+      Mode    : Subprogram_Protection_Mode) return Node_Id
    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;
-      Append_Char : Character;
-      New_Spec    : Node_Id;
+      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;
+
+      Append_Chr : constant array (Subprogram_Protection_Mode) of Character :=
+                     (Dispatching_Mode => ' ',
+                      Protected_Mode   => 'P',
+                      Unprotected_Mode => 'N');
 
    begin
       if Ekind
@@ -1921,26 +2326,14 @@ package body Exp_Ch9 is
       Ident := Defining_Unit_Name (Specification (Decl));
       Nam := Chars (Ident);
 
-      New_Plist := Build_Protected_Spec
-                        (Decl, Corresponding_Record_Type (Prottyp),
-                         Unprotected, Ident);
-
-      if Unprotected then
-         Append_Char := 'N';
-      else
-         --  Ada 2005 (AI-345): The protected version no longer uses 'P'
-         --  as suffix in order to make it a primitive operation
-
-         if Ada_Version >= Ada_05 then
-            Append_Char := ' ';
-         else
-            Append_Char := 'P';
-         end if;
-      end if;
+      New_Plist :=
+        Build_Protected_Spec (Decl,
+          Corresponding_Record_Type (Prottyp),
+                              Mode = Unprotected_Mode, Ident);
 
       New_Id :=
         Make_Defining_Identifier (Loc,
-          Chars => Build_Selected_Name (Protnm, Nam, Append_Char));
+          Chars => Build_Selected_Name (Protnm, Nam, Append_Chr (Mode)));
 
       --  The unprotected operation carries the user code, and debugging
       --  information must be generated for it, even though this spec does
@@ -1961,7 +2354,8 @@ package body Exp_Ch9 is
            Make_Function_Specification (Loc,
              Defining_Unit_Name => New_Id,
              Parameter_Specifications => New_Plist,
-             Subtype_Mark => New_Copy (Subtype_Mark (Specification (Decl))));
+             Result_Definition =>
+               New_Copy (Result_Definition (Specification (Decl))));
          Set_Return_Present (Defining_Unit_Name (New_Spec));
          return New_Spec;
       end if;
@@ -2089,8 +2483,7 @@ package body Exp_Ch9 is
       Exc_Safe := Is_Exception_Safe (N);
 
       P_Op_Spec :=
-        Build_Protected_Sub_Specification (N,
-          Pid, Unprotected => False);
+        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
@@ -2116,7 +2509,7 @@ package body Exp_Ch9 is
               Make_Object_Declaration (Loc,
                 Defining_Identifier => R,
                 Constant_Present => True,
-                Object_Definition => New_Copy (Subtype_Mark (N_Op_Spec)),
+                Object_Definition => New_Copy (Result_Definition (N_Op_Spec)),
                 Expression =>
                   Make_Function_Call (Loc,
                     Name => Make_Identifier (Loc,
@@ -2162,7 +2555,10 @@ package body Exp_Ch9 is
 
       if Has_Entries (Pid)
         or else Has_Interrupt_Handler (Pid)
-        or else (Has_Attach_Handler (Pid) and then not Restricted_Profile)
+        or else (Has_Attach_Handler (Pid)
+                  and then not Restricted_Profile)
+        or else (Ada_Version >= Ada_05
+                  and then Present (Interface_List (Parent (Pid))))
       then
          if Abort_Allowed
            or else Restriction_Active (No_Entry_Queue) = False
@@ -3004,8 +3400,7 @@ package body Exp_Ch9 is
 
       Op_Decls := Declarations (N);
       N_Op_Spec :=
-        Build_Protected_Sub_Specification
-          (N, Pid, Unprotected => True);
+        Build_Protected_Sub_Specification (N, Pid, Unprotected_Mode);
 
       return
         Make_Subprogram_Body (Loc,
@@ -3687,7 +4082,8 @@ package body Exp_Ch9 is
          Def1 :=
            Make_Access_Function_Definition (Loc,
              Parameter_Specifications => P_List,
-             Subtype_Mark => New_Copy (Subtype_Mark (Type_Definition (N))));
+             Result_Definition =>
+               New_Copy (Result_Definition (Type_Definition (N))));
 
       else
          Def1 :=
@@ -4158,9 +4554,10 @@ package body Exp_Ch9 is
    -- Expand_N_Asynchronous_Select --
    ----------------------------------
 
-   --  This procedure assumes that the trigger statement is an entry call. A
-   --  delay alternative should already have been expanded into an entry call
-   --  to the appropriate delay object Wait entry.
+   --  This procedure assumes that the trigger statement is an entry call or
+   --  a dispatching procedure call. A delay alternative should already have
+   --  been expanded into an entry call to the appropriate delay object Wait
+   --  entry.
 
    --  If the trigger is a task entry call, the select is implemented with
    --  a Task_Entry_Call:
@@ -4191,19 +4588,19 @@ package body Exp_Ch9 is
    --       begin
    --          begin
    --             Abort_Undefer;
-   --             abortable-part
+   --             <abortable-part>
    --          at end
    --             _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
    --          end;
-
    --       exception
-   --       when Abort_Signal => Abort_Undefer;
+   --          when Abort_Signal => Abort_Undefer;
    --       end;
+
    --       parm := P.param;
    --       parm := P.param;
    --       ...
    --       if not C then
-   --          triggered-statements
+   --          <triggered-statements>
    --       end if;
    --    end;
 
@@ -4250,20 +4647,17 @@ package body Exp_Ch9 is
    --             Mode => Asynchronous_Call;
    --             Block => Bnn);
    --           if Enqueued (Bnn) then
-   --              <abortable part>
+   --              <abortable-part>
    --           end if;
    --        at end
    --           _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
    --        end;
-
    --     exception
-   --        when Abort_Signal =>
-   --           Abort_Undefer;
-   --           null;
+   --        when Abort_Signal => Abort_Undefer;
    --     end;
 
    --     if not Cancelled (Bnn) then
-   --        triggered statements
+   --        <triggered-statements>
    --     end if;
    --  end;
 
@@ -4286,6 +4680,100 @@ package body Exp_Ch9 is
    --       ...
    --  end;
 
+   --  Ada 2005 (AI-345): If the trigger is a dispatching call, the select is
+   --  expanded into:
+
+   --  declare
+   --     B   : Boolean := False;
+   --     Bnn : Communication_Block;
+   --     C   : Ada.Tags.Prim_Op_Kind;
+   --     P   : Parameters := (Param1 .. ParamN)
+   --     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);
+
+   --     if C = POK_Protected_Entry then
+   --        declare
+   --           procedure _clean is
+   --           begin
+   --              if Enqueued (Bnn) then
+   --                 Cancel_Protected_Entry_Call (Bnn);
+   --              end if;
+   --           end _clean;
+
+   --        begin
+   --           begin
+   --              disp_asynchronous_select
+   --                (Obj, S, P'address, Bnn, B);
+
+   --              Param1 := P.Param1;
+   --              ...
+   --              ParamN := P.ParamN;
+
+   --              if Enqueued (Bnn) then
+   --                 <temp>A;
+   --              end if;
+   --           at end
+   --              _clean;
+   --           end;
+   --        exception
+   --           when Abort_Signal => Abort_Undefer;
+   --        end;
+
+   --        if not Cancelled (Bnn) then
+   --           <temp>T;
+   --        end if;
+
+   --     elsif C = POK_Task_Entry then
+   --        declare
+   --           procedure _clean is
+   --           begin
+   --              Cancel_Task_Entry_Call (U);
+   --           end _clean;
+
+   --        begin
+   --           Abort_Defer;
+
+   --           disp_asynchronous_select
+   --             (<object>, S, P'address, Bnn, B);
+
+   --           Param1 := P.Param1;
+   --           ...
+   --           ParamN := P.ParamN;
+
+   --           begin
+   --              begin
+   --                 Abort_Undefer;
+   --                 <temp>A;
+   --              at end
+   --                 _clean;
+   --              end;
+   --           exception
+   --              when Abort_Signal => Abort_Undefer;
+   --           end;
+
+   --           if not U then
+   --              <temp>T;
+   --           end if;
+   --        end;
+
+   --     else
+   --        <dispatching-call>;
+   --        <temp>T;
+   --     end if;
+
    --  The job is to convert this to the asynchronous form
 
    --  If the trigger is a delay statement, it will have been expanded into a
@@ -4302,37 +4790,55 @@ package body Exp_Ch9 is
 
    procedure Expand_N_Asynchronous_Select (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
-      Trig   : constant Node_Id    := Triggering_Alternative (N);
       Abrt   : constant Node_Id    := Abortable_Part (N);
-      Tstats : constant List_Id    := Statements (Trig);
       Astats : constant List_Id    := Statements (Abrt);
+      Trig   : constant Node_Id    := Triggering_Alternative (N);
+      Tstats : constant List_Id    := Statements (Trig);
 
-      Ecall           : Node_Id;
+      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;
-      Ename           : Node_Id;
-      Index           : Node_Id;
-      Hdle            : List_Id;
-      Decls           : List_Id;
+      Dblock_Ent      : Entity_Id;
       Decl            : Node_Id;
-      Parms           : List_Id;
-      Parm            : Node_Id;
-      Call            : Node_Id;
-      Stmts           : List_Id;
+      Decls           : List_Id;
+      Ecall           : Node_Id;
+      Ename           : Node_Id;
       Enqueue_Call    : Node_Id;
-      Stmt            : Node_Id;
-      B               : Entity_Id;
-      Pdef            : Entity_Id;
-      Dblock_Ent      : Entity_Id;
+      Formals         : List_Id;
+      Hdle            : List_Id;
+      Index           : Node_Id;
       N_Orig          : Node_Id;
-      Abortable_Block : Node_Id;
-      Cancel_Param    : Entity_Id;
-      Blkent          : Entity_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;
 
+      B   : Entity_Id;  --  Call status flag
+      Bnn : Entity_Id;  --  Communication block
+      C   : Entity_Id;  --  Call kind
+      P   : Node_Id;    --  Parameter block
+      S   : Entity_Id;  --  Primitive operation slot
+      U   : Entity_Id;  --  Additional status flag
+
    begin
-      Blkent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
-      Ecall := Triggering_Statement (Trig);
+      Blk_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+      Ecall   := Triggering_Statement (Trig);
 
       --  The arguments in the call may require dynamic allocation, and the
       --  call statement may have been transformed into a block. The block
@@ -4341,7 +4847,6 @@ package body Exp_Ch9 is
 
       if Nkind (Ecall) = N_Block_Statement then
          Ecall := First (Statements (Handled_Statement_Sequence (Ecall)));
-
          while Nkind (Ecall) /= N_Procedure_Call_Statement
            and then Nkind (Ecall) /= N_Entry_Call_Statement
          loop
@@ -4349,112 +4854,483 @@ package body Exp_Ch9 is
          end loop;
       end if;
 
-      --  If a delay was used as a trigger, it will have been expanded
-      --  into a procedure call. Convert it to the appropriate sequence of
-      --  statements, similar to what is done for a task entry call.
-      --  Note that this currently supports only Duration, Real_Time.Time,
-      --  and Calendar.Time.
+      --  This is either a dispatching call or a delay statement used as a
+      --  trigger which was expanded into a procedure call.
 
       if Nkind (Ecall) = N_Procedure_Call_Statement then
+         if Ada_Version >= Ada_05
+           and then
+             (not Present (Original_Node (Ecall))
+                or else
+              Nkind (Original_Node (Ecall)) /= N_Delay_Relative_Statement)
+         then
+            Extract_Dispatching_Call (Ecall, Call_Ent, Obj, Actuals, Formals);
 
-         --  Add a Delay_Block object to the parameter list of the
-         --  delay procedure to form the parameter list of the Wait
-         --  entry call.
+            Decls := New_List;
+            Stmts := New_List;
 
-         Dblock_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
+            --  Call status flag processing, generate:
+            --    B : Boolean := False;
 
-         Pdef := Entity (Name (Ecall));
+            B := SEU.Build_B (Loc, Decls);
 
-         if Is_RTE (Pdef, RO_CA_Delay_For) then
-            Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_Duration), Loc);
+            --  Communication block processing, generate:
+            --    Bnn : Communication_Block;
 
-         elsif Is_RTE (Pdef, RO_CA_Delay_Until) then
-            Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_Calendar), Loc);
+            Bnn := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
 
-         else pragma Assert (Is_RTE (Pdef, RO_RT_Delay_Until));
-            Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_RT), Loc);
-         end if;
+            Append_To (Decls,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier =>
+                  Bnn,
+                Object_Definition =>
+                  New_Reference_To (RTE (RE_Communication_Block), Loc)));
 
-         Append_To (Parameter_Associations (Ecall),
-           Make_Attribute_Reference (Loc,
-             Prefix => New_Reference_To (Dblock_Ent, Loc),
-             Attribute_Name => Name_Unchecked_Access));
+            --  Call kind processing, generate:
+            --    C : Ada.Tags.Prim_Op_Kind;
 
-         --  Create the inner block to protect the abortable part
+            C := SEU.Build_C (Loc, Decls);
 
-         Hdle := New_List (
-           Make_Exception_Handler (Loc,
-             Exception_Choices =>
-               New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
-             Statements => New_List (
-               Make_Procedure_Call_Statement (Loc,
-                 Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)))));
+            --  Parameter block processing
 
-         Prepend_To (Astats,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)));
+            Blk_Typ := Build_Parameter_Block
+                         (Loc, Actuals, Formals, Decls);
+            P       := Parameter_Block_Pack
+                         (Loc, Blk_Typ, Actuals, Formals, Decls, Stmts);
 
-         Abortable_Block :=
-           Make_Block_Statement (Loc,
-             Identifier => New_Reference_To (Blkent, Loc),
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements => Astats),
-             Has_Created_Identifier => True,
-             Is_Asynchronous_Call_Block => True);
+            --  Dispatch table slot processing, generate:
+            --    S : constant Integer :=
+            --          DT_Position (<dispatching-procedure>);
 
-         --  Append call to if Enqueue (When, DB'Unchecked_Access) then
+            S := SEU.Build_S (Loc, Decls, Call_Ent);
 
-         Rewrite (Ecall,
-           Make_Implicit_If_Statement (N,
-             Condition => Make_Function_Call (Loc,
-               Name => Enqueue_Call,
-               Parameter_Associations => Parameter_Associations (Ecall)),
-             Then_Statements =>
-               New_List (Make_Block_Statement (Loc,
-                 Handled_Statement_Sequence =>
-                   Make_Handled_Sequence_Of_Statements (Loc,
-                     Statements => New_List (
-                       Make_Implicit_Label_Declaration (Loc,
-                         Defining_Identifier => Blkent,
-                         Label_Construct     => Abortable_Block),
-                       Abortable_Block),
-                     Exception_Handlers => Hdle)))));
+            --  Additional status flag processing, generate:
 
-         Stmts := New_List (Ecall);
+            U := Make_Defining_Identifier (Loc, Name_uU);
 
-         --  Construct statement sequence for new block
+            Append_To (Decls,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier =>
+                  U,
+                Object_Definition =>
+                  New_Reference_To (Standard_Boolean, Loc)));
 
-         Append_To (Stmts,
-           Make_Implicit_If_Statement (N,
-             Condition => Make_Function_Call (Loc,
-               Name => New_Reference_To (
-                 RTE (RE_Timed_Out), Loc),
-               Parameter_Associations => New_List (
-                 Make_Attribute_Reference (Loc,
-                   Prefix => New_Reference_To (Dblock_Ent, Loc),
-                   Attribute_Name => Name_Unchecked_Access))),
-             Then_Statements => Tstats));
+            --  Generate:
+            --    procedure <temp>A is
+            --    begin
+            --       Astmts
+            --    end <temp>A;
 
-         --  The result is the new block
+            Aproc := SEU.Build_Wrapping_Procedure (Loc, 'A', Decls, Astats);
 
-         Set_Entry_Cancel_Parameter (Blkent, Dblock_Ent);
+            --  Generate:
+            --    procedure <temp>T is
+            --    begin
+            --       Tstmts
+            --    end <temp>T;
 
-         Rewrite (N,
-           Make_Block_Statement (Loc,
-             Declarations => New_List (
-               Make_Object_Declaration (Loc,
-                 Defining_Identifier => Dblock_Ent,
-                 Aliased_Present => True,
-                 Object_Definition => New_Reference_To (
-                   RTE (RE_Delay_Block), Loc))),
+            Tproc := SEU.Build_Wrapping_Procedure (Loc, 'T', Decls, Tstats);
 
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
+            --  Generate:
+            --    _dispatching_get_prim_op_kind (<object>, S, C);
 
-         Analyze (N);
-         return;
+            Append_To (Stmts,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  Make_Identifier (Loc, Name_uDisp_Get_Prim_Op_Kind),
+                Parameter_Associations =>
+                  New_List (
+                    New_Copy_Tree    (Obj),
+                    New_Reference_To (S, Loc),
+                    New_Reference_To (C, Loc))));
+
+            --  Protected entry handling
 
+            --  Generate:
+            --    Param1 := P.Param1;
+            --    ...
+            --    ParamN := P.ParamN;
+
+            Cleanup_Stmts := Parameter_Block_Unpack (Loc, Actuals, Formals);
+
+            --  Generate:
+            --    _dispatching_asynchronous_select
+            --      (<object>, S, P'address, Bnn, B);
+
+            Prepend_To (Cleanup_Stmts,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  Make_Identifier (Loc, Name_uDisp_Asynchronous_Select),
+                Parameter_Associations =>
+                  New_List (
+                    New_Copy_Tree    (Obj),
+                    New_Reference_To (S, Loc),
+                    P,
+                    New_Reference_To (Bnn, Loc),
+                    New_Reference_To (B, Loc))));
+
+            --  Generate:
+            --    if Enqueued (Bnn) then
+            --       <temp>A
+            --    end if;
+
+            --  where <temp>A is the abort statements wrapping procedure
+
+            Append_To (Cleanup_Stmts,
+              Make_If_Statement (Loc,
+                Condition =>
+                  Make_Function_Call (Loc,
+                    Name =>
+                      New_Reference_To (RTE (RE_Enqueued), Loc),
+                    Parameter_Associations =>
+                      New_List (
+                        New_Reference_To (Bnn, Loc))),
+
+                Then_Statements =>
+                  New_List (
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (Aproc, Loc),
+                      Parameter_Associations =>
+                        No_List))));
+
+            --  Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
+            --  will then generate a _clean for the communication block Bnn.
+
+            --  Generate:
+            --    declare
+            --       procedure _clean is
+            --       begin
+            --          if Enqueued (Bnn) then
+            --             Cancel_Protected_Entry_Call (Bnn);
+            --          end if;
+            --       end _clean;
+            --    begin
+            --       Cleanup_Stmts
+            --    at end
+            --       _clean;
+            --    end;
+
+            Cleanup_Block :=
+              SEU.Build_Cleanup_Block (Loc, Blk_Ent, Cleanup_Stmts, Bnn);
+
+            --  Wrap the cleanup block in an exception handling block.
+
+            --  Generate:
+            --    begin
+            --       Cleanup_Block
+            --    exception
+            --       when Abort_Signal => Abort_Undefer;
+            --    end;
+
+            ProtE_Stmts :=
+              New_List (
+                SEU.Build_Abort_Block (Loc, Blk_Ent, Cleanup_Block));
+
+            --  Generate:
+            --    if not Cancelled (Bnn) then
+            --       <temp>T
+            --    end if;
+
+            --  there <temp>T is the triggering statements wrapping procedure
+
+            Append_To (ProtE_Stmts,
+              Make_If_Statement (Loc,
+                Condition =>
+                  Make_Op_Not (Loc,
+                    Right_Opnd =>
+                      Make_Function_Call (Loc,
+                        Name =>
+                          New_Reference_To (RTE (RE_Cancelled), Loc),
+                        Parameter_Associations =>
+                          New_List (
+                            New_Reference_To (Bnn, Loc)))),
+
+                Then_Statements =>
+                  New_List (
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (Tproc, Loc),
+                      Parameter_Associations =>
+                        No_List))));
+
+            -------------------------------------------------------------------
+            --  Task entry handling
+
+            --  Generate:
+            --    Param1 := P.Param1;
+            --    ...
+            --    ParamN := P.ParamN;
+
+            TaskE_Stmts := Parameter_Block_Unpack (Loc, Actuals, Formals);
+
+            --  Generate:
+            --    _dispatching_asynchronous_select
+            --      (<object>, S, P'address, Bnn, B);
+
+            Prepend_To (TaskE_Stmts,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  Make_Identifier (Loc, Name_uDisp_Asynchronous_Select),
+                Parameter_Associations =>
+                  New_List (
+                    New_Copy_Tree    (Obj),
+                    New_Reference_To (S, Loc),
+                    New_Copy_Tree    (P),
+                    New_Reference_To (Bnn, Loc),
+                    New_Reference_To (B, Loc))));
+
+            --  Generate:
+            --    Abort_Defer;
+
+            Prepend_To (TaskE_Stmts,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  New_Reference_To (RTE (RE_Abort_Defer), Loc),
+                Parameter_Associations =>
+                  No_List));
+
+            --  Generate:
+            --    Abort_Undefer;
+            --    <temp>A
+
+            --  where <temp>A is the abortable statements wrapping procedure
+
+            Cleanup_Stmts :=
+              New_List (
+                Make_Procedure_Call_Statement (Loc,
+                  Name =>
+                    New_Reference_To (RTE (RE_Abort_Undefer), Loc),
+                  Parameter_Associations =>
+                    No_List),
+
+                Make_Procedure_Call_Statement (Loc,
+                  Name =>
+                    New_Reference_To (Aproc, 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.
+
+            --  Generate:
+            --    declare
+            --       procedure _clean is
+            --       begin
+            --          Cancel_Task_Entry_Call (U);
+            --       end _clean;
+            --    begin
+            --       Cleanup_Stmts
+            --    at end
+            --       _clean;
+            --    end;
+
+            Blk_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+
+            Cleanup_Block :=
+              SEU.Build_Cleanup_Block (Loc, Blk_Ent, Cleanup_Stmts, U);
+
+            --  Wrap the cleanup block in an exception handling block
+
+            --  Generate:
+            --    begin
+            --       Cleanup_Block
+            --    exception
+            --       when Abort_Signal => Abort_Undefer;
+            --    end;
+
+            Append_To (TaskE_Stmts,
+              SEU.Build_Abort_Block (Loc, Blk_Ent, Cleanup_Block));
+
+            --  Generate:
+            --    if not U then
+            --       <temp>T
+            --    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)),
+                Then_Statements =>
+                  New_List (
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Reference_To (Tproc, Loc),
+                      Parameter_Associations =>
+                        No_List))));
+
+            -------------------------------------------------------------------
+            --  Protected procedure handling
+
+            --  Generate:
+            --    <dispatching-call>;
+            --    <temp>T;
+
+            --  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));
+
+            --  Generate:
+            --    if C = POK_Procedure_Entry then
+            --       ProtE_Stmts
+            --    elsif C = POK_Task_Entry then
+            --       TaskE_Stmts
+            --    else
+            --       ProtP_Stmts
+            --    end if;
+
+            Append_To (Stmts,
+              Make_If_Statement (Loc,
+                Condition =>
+                  Make_Op_Eq (Loc,
+                    Left_Opnd =>
+                      New_Reference_To (C, Loc),
+                    Right_Opnd =>
+                      New_Reference_To (RTE (RE_POK_Protected_Entry), Loc)),
+
+                Then_Statements =>
+                  ProtE_Stmts,
+
+                Elsif_Parts =>
+                  New_List (
+                    Make_Elsif_Part (Loc,
+                      Condition =>
+                        Make_Op_Eq (Loc,
+                          Left_Opnd =>
+                            New_Reference_To (C, Loc),
+                          Right_Opnd =>
+                            New_Reference_To (RTE (RE_POK_Task_Entry), Loc)),
+                      Then_Statements =>
+                        TaskE_Stmts)),
+
+                Else_Statements =>
+                  ProtP_Stmts));
+
+            Rewrite (N,
+              Make_Block_Statement (Loc,
+                Declarations =>
+                  Decls,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
+
+            Analyze (N);
+            return;
+
+         --  Delay triggering statement processing
+
+         else
+            --  Add a Delay_Block object to the parameter list of the delay
+            --  procedure to form the parameter list of the Wait entry call.
+
+            Dblock_Ent :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
+
+            Pdef := Entity (Name (Ecall));
+
+            if Is_RTE (Pdef, RO_CA_Delay_For) then
+               Enqueue_Call :=
+                 New_Reference_To (RTE (RE_Enqueue_Duration), Loc);
+
+            elsif Is_RTE (Pdef, RO_CA_Delay_Until) then
+               Enqueue_Call :=
+                 New_Reference_To (RTE (RE_Enqueue_Calendar), Loc);
+
+            else pragma Assert (Is_RTE (Pdef, RO_RT_Delay_Until));
+               Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_RT), Loc);
+            end if;
+
+            Append_To (Parameter_Associations (Ecall),
+              Make_Attribute_Reference (Loc,
+                Prefix => New_Reference_To (Dblock_Ent, Loc),
+                Attribute_Name => Name_Unchecked_Access));
+
+            --  Create the inner block to protect the abortable part
+
+            Hdle := New_List (
+              Make_Exception_Handler (Loc,
+                Exception_Choices =>
+                  New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
+                Statements => New_List (
+                  Make_Procedure_Call_Statement (Loc,
+                    Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)))));
+
+            Prepend_To (Astats,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)));
+
+            Abortable_Block :=
+              Make_Block_Statement (Loc,
+                Identifier => New_Reference_To (Blk_Ent, Loc),
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => Astats),
+                Has_Created_Identifier => True,
+                Is_Asynchronous_Call_Block => True);
+
+            --  Append call to if Enqueue (When, DB'Unchecked_Access) then
+
+            Rewrite (Ecall,
+              Make_Implicit_If_Statement (N,
+                Condition => Make_Function_Call (Loc,
+                  Name => Enqueue_Call,
+                  Parameter_Associations => Parameter_Associations (Ecall)),
+                Then_Statements =>
+                  New_List (Make_Block_Statement (Loc,
+                    Handled_Statement_Sequence =>
+                      Make_Handled_Sequence_Of_Statements (Loc,
+                        Statements => New_List (
+                          Make_Implicit_Label_Declaration (Loc,
+                            Defining_Identifier => Blk_Ent,
+                            Label_Construct     => Abortable_Block),
+                          Abortable_Block),
+                        Exception_Handlers => Hdle)))));
+
+            Stmts := New_List (Ecall);
+
+            --  Construct statement sequence for new block
+
+            Append_To (Stmts,
+              Make_Implicit_If_Statement (N,
+                Condition => Make_Function_Call (Loc,
+                  Name => New_Reference_To (
+                    RTE (RE_Timed_Out), Loc),
+                  Parameter_Associations => New_List (
+                    Make_Attribute_Reference (Loc,
+                      Prefix => New_Reference_To (Dblock_Ent, Loc),
+                      Attribute_Name => Name_Unchecked_Access))),
+                Then_Statements => Tstats));
+
+            --  The result is the new block
+
+            Set_Entry_Cancel_Parameter (Blk_Ent, Dblock_Ent);
+
+            Rewrite (N,
+              Make_Block_Statement (Loc,
+                Declarations => New_List (
+                  Make_Object_Declaration (Loc,
+                    Defining_Identifier => Dblock_Ent,
+                    Aliased_Present => True,
+                    Object_Definition => New_Reference_To (
+                      RTE (RE_Delay_Block), Loc))),
+
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
+
+            Analyze (N);
+            return;
+         end if;
       else
          N_Orig := N;
       end if;
@@ -4471,9 +5347,10 @@ package body Exp_Ch9 is
 
          Decl := First (Decls);
          while Present (Decl)
-           and then (Nkind (Decl) /= N_Object_Declaration
-             or else not Is_RTE
-               (Etype (Object_Definition (Decl)), RE_Communication_Block))
+           and then
+             (Nkind (Decl) /= N_Object_Declaration
+               or else not Is_RTE (Etype (Object_Definition (Decl)),
+                                   RE_Communication_Block))
          loop
             Next (Decl);
          end loop;
@@ -4481,7 +5358,8 @@ package body Exp_Ch9 is
          pragma Assert (Present (Decl));
          Cancel_Param := Defining_Identifier (Decl);
 
-         --  Change the mode of the Protected_Entry_Call call.
+         --  Change the mode of the Protected_Entry_Call call
+
          --  Protected_Entry_Call (
          --    Object => po._object'Access,
          --    E => <entry index>;
@@ -4491,7 +5369,8 @@ package body Exp_Ch9 is
 
          Stmt := First (Stmts);
 
-         --  Skip assignments to temporaries created for in-out parameters.
+         --  Skip assignments to temporaries created for in-out parameters
+
          --  This makes unwarranted assumptions about the shape of the expanded
          --  tree for the call, and should be cleaned up ???
 
@@ -4501,19 +5380,21 @@ package body Exp_Ch9 is
 
          Call := Stmt;
 
-         Parm := First (Parameter_Associations (Call));
-         while Present (Parm)
-           and then not Is_RTE (Etype (Parm), RE_Call_Modes)
+         Param := First (Parameter_Associations (Call));
+         while Present (Param)
+           and then not Is_RTE (Etype (Param), RE_Call_Modes)
          loop
-            Next (Parm);
+            Next (Param);
          end loop;
 
-         pragma Assert (Present (Parm));
-         Rewrite (Parm, New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
-         Analyze (Parm);
+         pragma Assert (Present (Param));
+         Rewrite (Param, New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
+         Analyze (Param);
+
+         --  Append an if statement to execute the abortable part
 
-         --  Append an if statement to execute the abortable part.
-         --  if Enqueued (Bnn) then
+         --  Generate:
+         --    if Enqueued (Bnn) then
 
          Append_To (Stmts,
            Make_Implicit_If_Statement (N,
@@ -4526,7 +5407,7 @@ package body Exp_Ch9 is
 
          Abortable_Block :=
            Make_Block_Statement (Loc,
-             Identifier => New_Reference_To (Blkent, Loc),
+             Identifier => New_Reference_To (Blk_Ent, Loc),
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => Stmts),
@@ -4552,7 +5433,7 @@ package body Exp_Ch9 is
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => New_List (
                    Make_Implicit_Label_Declaration (Loc,
-                     Defining_Identifier => Blkent,
+                     Defining_Identifier => Blk_Ent,
                      Label_Construct     => Abortable_Block),
                    Abortable_Block),
 
@@ -4640,7 +5521,7 @@ package body Exp_Ch9 is
 
          Abortable_Block :=
            Make_Block_Statement (Loc,
-             Identifier => New_Reference_To (Blkent, Loc),
+             Identifier => New_Reference_To (Blk_Ent, Loc),
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => Astats),
@@ -4653,27 +5534,33 @@ package body Exp_Ch9 is
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => New_List (
                    Make_Implicit_Label_Declaration (Loc,
-                     Defining_Identifier => Blkent,
+                     Defining_Identifier => Blk_Ent,
                      Label_Construct     => Abortable_Block),
                    Abortable_Block),
                  Exception_Handlers => Hdle)));
 
          --  Create new call statement
 
-         Parms := Parameter_Associations (Call);
-         Append_To (Parms, New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
-         Append_To (Parms, New_Reference_To (B, Loc));
+         Params := Parameter_Associations (Call);
+
+         Append_To (Params,
+           New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
+         Append_To (Params,
+           New_Reference_To (B, Loc));
+
          Rewrite (Call,
            Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
-             Parameter_Associations => Parms));
+             Name =>
+               New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
+             Parameter_Associations => Params));
 
          --  Construct statement sequence for new block
 
          Append_To (Stmts,
            Make_Implicit_If_Statement (N,
-             Condition => Make_Op_Not (Loc,
-               New_Reference_To (Cancel_Param, Loc)),
+             Condition =>
+               Make_Op_Not (Loc,
+                 New_Reference_To (Cancel_Param, Loc)),
              Then_Statements => Tstats));
 
          --  Protected the call against abort
@@ -4684,7 +5571,7 @@ package body Exp_Ch9 is
              Parameter_Associations => Empty_List));
       end if;
 
-      Set_Entry_Cancel_Parameter (Blkent, Cancel_Param);
+      Set_Entry_Cancel_Parameter (Blk_Ent, Cancel_Param);
 
       --  The result is the new block
 
@@ -4786,21 +5673,199 @@ package body Exp_Ch9 is
    --         ...
    --    end;
 
+   --  Ada 2005 (AI-345): A dispatching conditional entry call is converted
+   --  into:
+
+   --    declare
+   --       B : Boolean := False;
+   --       C : Ada.Tags.Prim_Op_Kind;
+   --       P : Parameters := (Param1 .. ParamN);
+   --       S : constant Integer := DT_Position (<dispatching-procedure>);
+
+   --    begin
+   --       disp_conditional_select (<object>, S, P'address, C, B);
+
+   --       if C = POK_Protected_Entry
+   --         or else C = POK_Task_Entry
+   --       then
+   --          Param1 := P.Param1;
+   --          ...
+   --          ParamN := P.ParamN;
+   --       end if;
+
+   --       if B then
+   --          if C = POK_Procedure
+   --            or else C = POK_Protected_Procedure
+   --            or else C = POK_Task_Procedure
+   --          then
+   --             <dispatching-procedure> (<object>, Param1 .. ParamN);
+   --          end if;
+   --          <normal-statements>
+   --       else
+   --          <else-statements>
+   --       end if;
+   --    end;
+
    procedure Expand_N_Conditional_Entry_Call (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
       Alt : constant Node_Id    := Entry_Call_Alternative (N);
       Blk : Node_Id             := Entry_Call_Statement (Alt);
       Transient_Blk : Node_Id;
 
-      Parms   : List_Id;
-      Parm    : Node_Id;
-      Call    : Node_Id;
-      Stmts   : List_Id;
-      B       : Entity_Id;
-      Decl    : Node_Id;
-      Stmt    : Node_Id;
+      Actuals  : List_Id;
+      Blk_Typ  : Entity_Id;
+      Call     : Node_Id;
+      Call_Ent : Entity_Id;
+      Decl     : Node_Id;
+      Decls    : List_Id;
+      Formals  : List_Id;
+      N_Stats  : List_Id;
+      Obj      : Entity_Id;
+      Param    : Node_Id;
+      Params   : List_Id;
+      Stmt     : Node_Id;
+      Stmts    : List_Id;
+
+      B        : Entity_Id;  --  Call status flag
+      C        : Entity_Id;  --  Call kind
+      P        : Node_Id;    --  Parameter block
+      S        : Entity_Id;  --  Primitive operation slot
 
    begin
+      if Ada_Version >= Ada_05
+        and then Nkind (Blk) = N_Procedure_Call_Statement
+      then
+         Extract_Dispatching_Call (Blk, Call_Ent, Obj, Actuals, Formals);
+
+         Decls := New_List;
+         Stmts := New_List;
+
+         --  Call status flag processing, generate:
+         --    B : Boolean := False;
+
+         B := SEU.Build_B (Loc, Decls);
+
+         --  Call kind processing, generate:
+         --    C : Ada.Tags.Prim_Op_Kind;
+
+         C := SEU.Build_C (Loc, Decls);
+
+         --  Parameter block processing
+
+         Blk_Typ := Build_Parameter_Block (Loc, Actuals, Formals, Decls);
+         P       := Parameter_Block_Pack  (Loc, Blk_Typ, Actuals, Formals,
+                      Decls, Stmts);
+
+         --  Dispatch table slot processing, generate:
+         --    S : constant Integer :=
+         --          DT_Position (<dispatching-procedure>);
+
+         S := SEU.Build_S (Loc, Decls, Call_Ent);
+
+         --  Generate:
+         --    _dispatching_conditional_select (<object>, S, P'address, C, B);
+
+         Append_To (Stmts,
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               Make_Identifier (Loc, Name_uDisp_Conditional_Select),
+             Parameter_Associations =>
+               New_List (
+                 New_Copy_Tree    (Obj),
+                 New_Reference_To (S, Loc),
+                 P,
+                 New_Reference_To (C, Loc),
+                 New_Reference_To (B, Loc))));
+
+         --  Generate:
+         --    if C = POK_Protected_Entry
+         --      or else C = POK_Task_Entry
+         --    then
+         --       Param1 := P.Param1;
+         --       ...
+         --       ParamN := P.ParamN;
+         --    end if;
+
+         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 =>
+               Parameter_Block_Unpack (Loc, Actuals, Formals)));
+
+         --  Generate:
+         --    if B then
+         --       if C = POK_Procedure
+         --         or else C = POK_Protected_Procedure
+         --         or else C = POK_Task_Procedure
+         --       then
+         --          <dispatching-procedure-call>
+         --       end if;
+         --       <normal-statements>
+         --    else
+         --       <else-statements>
+         --    end if;
+
+         N_Stats := New_Copy_List (Statements (Alt));
+
+         Prepend_To (N_Stats,
+           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_Procedure), Loc)),
+
+                 Right_Opnd =>
+                   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_Procedure), Loc)),
+
+                     Right_Opnd =>
+                       Make_Op_Eq (Loc,
+                         Left_Opnd =>
+                           New_Reference_To (C, Loc),
+                         Right_Opnd =>
+                           New_Reference_To (RTE (
+                             RE_POK_Task_Procedure), Loc)))),
+
+             Then_Statements =>
+               New_List (Blk)));
+
+         Append_To (Stmts,
+           Make_If_Statement (Loc,
+             Condition       => New_Reference_To (B, Loc),
+             Then_Statements => N_Stats,
+             Else_Statements => Else_Statements (N)));
+
+         Rewrite (N,
+           Make_Block_Statement (Loc,
+             Declarations               => Decls,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
+
       --  As described above, The entry alternative is transformed into a
       --  block that contains the gnulli call, and possibly assignment
       --  statements for in-out parameters. The gnulli call may itself be
@@ -4808,110 +5873,108 @@ package body Exp_Ch9 is
       --  require it. We need to retrieve the call to complete its parameter
       --  list.
 
-      Transient_Blk :=
-         First_Real_Statement (Handled_Statement_Sequence (Blk));
-
-      if Present (Transient_Blk)
-        and then
-        Nkind (Transient_Blk) =  N_Block_Statement
-      then
-         Blk := Transient_Blk;
-      end if;
-
-      Stmts := Statements (Handled_Statement_Sequence (Blk));
+      else
+         Transient_Blk :=
+            First_Real_Statement (Handled_Statement_Sequence (Blk));
 
-      Stmt := First (Stmts);
+         if Present (Transient_Blk)
+           and then Nkind (Transient_Blk) = N_Block_Statement
+         then
+            Blk := Transient_Blk;
+         end if;
 
-      while Nkind (Stmt) /= N_Procedure_Call_Statement loop
-         Next (Stmt);
-      end loop;
+         Stmts := Statements (Handled_Statement_Sequence (Blk));
+         Stmt  := First (Stmts);
+         while Nkind (Stmt) /= N_Procedure_Call_Statement loop
+            Next (Stmt);
+         end loop;
 
-      Call := Stmt;
+         Call   := Stmt;
+         Params := Parameter_Associations (Call);
 
-      Parms := Parameter_Associations (Call);
+         if Is_RTE (Entity (Name (Call)), RE_Protected_Entry_Call) then
 
-      if Is_RTE (Entity (Name (Call)), RE_Protected_Entry_Call) then
+            --  Substitute Conditional_Entry_Call for Simple_Call parameter
 
-         --  Substitute Conditional_Entry_Call for Simple_Call
-         --  parameter.
+            Param := First (Params);
+            while Present (Param)
+              and then not Is_RTE (Etype (Param), RE_Call_Modes)
+            loop
+               Next (Param);
+            end loop;
 
-         Parm := First (Parms);
-         while Present (Parm)
-           and then not Is_RTE (Etype (Parm), RE_Call_Modes)
-         loop
-            Next (Parm);
-         end loop;
+            pragma Assert (Present (Param));
+            Rewrite (Param, New_Reference_To (RTE (RE_Conditional_Call), Loc));
 
-         pragma Assert (Present (Parm));
-         Rewrite (Parm, New_Reference_To (RTE (RE_Conditional_Call), Loc));
+            Analyze (Param);
 
-         Analyze (Parm);
+            --  Find the Communication_Block parameter for the call to the
+            --  Cancelled function.
 
-         --  Find the Communication_Block parameter for the call
-         --  to the Cancelled function.
+            Decl := First (Declarations (Blk));
+            while Present (Decl)
+              and then not Is_RTE (Etype (Object_Definition (Decl)),
+                             RE_Communication_Block)
+            loop
+               Next (Decl);
+            end loop;
 
-         Decl := First (Declarations (Blk));
-         while Present (Decl)
-           and then not
-             Is_RTE (Etype (Object_Definition (Decl)), RE_Communication_Block)
-         loop
-            Next (Decl);
-         end loop;
+            --  Add an if statement to execute the else part if the call
+            --  does not succeed (as indicated by the Cancelled predicate).
 
-         --  Add an if statement to execute the else part if the call
-         --  does not succeed (as indicated by the Cancelled predicate).
+            Append_To (Stmts,
+              Make_Implicit_If_Statement (N,
+                Condition => Make_Function_Call (Loc,
+                  Name => New_Reference_To (RTE (RE_Cancelled), Loc),
+                  Parameter_Associations => New_List (
+                    New_Reference_To (Defining_Identifier (Decl), Loc))),
+                Then_Statements => Else_Statements (N),
+                Else_Statements => Statements (Alt)));
 
-         Append_To (Stmts,
-           Make_Implicit_If_Statement (N,
-             Condition => Make_Function_Call (Loc,
-               Name => New_Reference_To (RTE (RE_Cancelled), Loc),
-               Parameter_Associations => New_List (
-                 New_Reference_To (Defining_Identifier (Decl), Loc))),
-             Then_Statements => Else_Statements (N),
-             Else_Statements => Statements (Alt)));
+         else
+            B := Make_Defining_Identifier (Loc, Name_uB);
 
-      else
-         B := Make_Defining_Identifier (Loc, Name_uB);
+            --  Insert declaration of B in declarations of existing block
 
-         --  Insert declaration of B in declarations of existing block
+            if No (Declarations (Blk)) then
+               Set_Declarations (Blk, New_List);
+            end if;
 
-         if No (Declarations (Blk)) then
-            Set_Declarations (Blk, New_List);
-         end if;
+            Prepend_To (Declarations (Blk),
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => B,
+                Object_Definition =>
+                  New_Reference_To (Standard_Boolean, Loc)));
 
-         Prepend_To (Declarations (Blk),
-         Make_Object_Declaration (Loc,
-           Defining_Identifier => B,
-           Object_Definition => New_Reference_To (Standard_Boolean, Loc)));
+            --  Create new call statement
 
-         --  Create new call statement
+            Append_To (Params,
+              New_Reference_To (RTE (RE_Conditional_Call), Loc));
+            Append_To (Params, New_Reference_To (B, Loc));
 
-         Append_To (Parms, New_Reference_To (RTE (RE_Conditional_Call), Loc));
-         Append_To (Parms, New_Reference_To (B, Loc));
+            Rewrite (Call,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
+                Parameter_Associations => Params));
 
-         Rewrite (Call,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
-             Parameter_Associations => Parms));
+            --  Construct statement sequence for new block
 
-         --  Construct statement sequence for new block
+            Append_To (Stmts,
+              Make_Implicit_If_Statement (N,
+                Condition => New_Reference_To (B, Loc),
+                Then_Statements => Statements (Alt),
+                Else_Statements => Else_Statements (N)));
+         end if;
 
-         Append_To (Stmts,
-           Make_Implicit_If_Statement (N,
-             Condition => New_Reference_To (B, Loc),
-             Then_Statements => Statements (Alt),
-             Else_Statements => Else_Statements (N)));
+         --  The result is the new block
 
+         Rewrite (N,
+           Make_Block_Statement (Loc,
+             Declarations => Declarations (Blk),
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
       end if;
 
-      --  The result is the new block
-
-      Rewrite (N,
-        Make_Block_Statement (Loc,
-          Declarations => Declarations (Blk),
-          Handled_Statement_Sequence =>
-            Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
-
       Analyze (N);
    end Expand_N_Conditional_Entry_Call;
 
@@ -4925,7 +5988,6 @@ package body Exp_Ch9 is
 
    procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
-
    begin
       Rewrite (N,
         Make_Procedure_Call_Statement (Loc,
@@ -5193,7 +6255,7 @@ package body Exp_Ch9 is
    --     <sequence of statements>
    --  end pprocN;
 
-   --  procedure pproc (_object : in out poV;...) is
+   --  procedure pprocP (_object : in out poV;...) is
    --     procedure _clean is
    --       Pn : Boolean;
    --     begin
@@ -5217,7 +6279,7 @@ package body Exp_Ch9 is
    --     <sequence of statements>
    --  end pfuncN;
 
-   --  function pfunc (_object : poV) return Return_Type is
+   --  function pfuncP (_object : poV) return Return_Type is
    --     procedure _clean is
    --     begin
    --        Unlock (_object._object'Access);
@@ -5264,10 +6326,97 @@ package body Exp_Ch9 is
       Op_Decl      : Node_Id;
       Op_Body      : Node_Id;
       Op_Id        : Entity_Id;
+      Disp_Op_Body : Node_Id;
       New_Op_Body  : Node_Id;
       Current_Node : Node_Id;
       Num_Entries  : Natural := 0;
 
+      function Build_Dispatching_Subprogram_Body
+        (N        : Node_Id;
+         Pid      : Node_Id;
+         Prot_Bod : Node_Id) return Node_Id;
+      --  Build a dispatching version of the protected subprogram body. The
+      --  newly generated subprogram contains a call to the original protected
+      --  body. The following code is generated:
+      --
+      --  function <protected-function-name> (Param1 .. ParamN) return
+      --    <return-type> is
+      --  begin
+      --     return <protected-function-name>P (Param1 .. ParamN);
+      --  end <protected-function-name>;
+      --
+      --  or
+      --
+      --  procedure <protected-procedure-name> (Param1 .. ParamN) is
+      --  begin
+      --     <protected-procedure-name>P (Param1 .. ParamN);
+      --  end <protected-procedure-name>
+
+      ---------------------------------------
+      -- Build_Dispatching_Subprogram_Body --
+      ---------------------------------------
+
+      function Build_Dispatching_Subprogram_Body
+        (N        : Node_Id;
+         Pid      : Node_Id;
+         Prot_Bod : Node_Id) return Node_Id
+      is
+         Loc     : constant Source_Ptr := Sloc (N);
+         Actuals : List_Id;
+         Formal  : Node_Id;
+         Spec    : Node_Id;
+         Stmts   : List_Id;
+
+      begin
+         --  Generate a specification without a letter suffix in order to
+         --  override an interface function or procedure.
+
+         Spec :=
+           Build_Protected_Sub_Specification (N, Pid, Dispatching_Mode);
+
+         --  The formal parameters become the actuals of the protected
+         --  function or procedure call.
+
+         Actuals := New_List;
+         Formal  := First (Parameter_Specifications (Spec));
+
+         while Present (Formal) loop
+            Append_To (Actuals,
+              Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
+
+            Next (Formal);
+         end loop;
+
+         if Nkind (Spec) = N_Procedure_Specification then
+            Stmts :=
+              New_List (
+                Make_Procedure_Call_Statement (Loc,
+                  Name =>
+                    New_Reference_To (Corresponding_Spec (Prot_Bod), Loc),
+                  Parameter_Associations => Actuals));
+         else
+            pragma Assert (Nkind (Spec) = N_Function_Specification);
+
+            Stmts :=
+              New_List (
+                Make_Return_Statement (Loc,
+                  Expression =>
+                    Make_Function_Call (Loc,
+                      Name =>
+                        New_Reference_To (Corresponding_Spec (Prot_Bod), Loc),
+                      Parameter_Associations => Actuals)));
+         end if;
+
+         return
+           Make_Subprogram_Body (Loc,
+             Declarations  => Empty_List,
+             Specification => Spec,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc, Stmts));
+      end Build_Dispatching_Subprogram_Body;
+
+   --  Start of processing for Expand_N_Protected_Body
+
    begin
       if No_Run_Time_Mode then
          Error_Msg_CRT ("protected body", N);
@@ -5340,6 +6489,26 @@ package body Exp_Ch9 is
 
                         Insert_After (Current_Node, New_Op_Body);
                         Analyze (New_Op_Body);
+
+                        Current_Node := New_Op_Body;
+
+                        --  Generate an overriding primitive operation body for
+                        --  this subprogram if the protected type implements
+                        --  an inerface.
+
+                        if Ada_Version >= Ada_05
+                          and then Present (Abstract_Interfaces (
+                                     Corresponding_Record_Type (Pid)))
+                        then
+                           Disp_Op_Body :=
+                             Build_Dispatching_Subprogram_Body (
+                               Op_Body, Pid, New_Op_Body);
+
+                           Insert_After (Current_Node, Disp_Op_Body);
+                           Analyze (Disp_Op_Body);
+
+                           Current_Node := Disp_Op_Body;
+                        end if;
                      end if;
                   end if;
                end if;
@@ -5723,7 +6892,13 @@ package body Exp_Ch9 is
                      Sloc => Loc,
                      Constraints => New_List (Entry_Count_Expr)));
 
-         elsif Has_Entries (Prottyp) then
+         --  The type has explicit entries or generated primitive entry
+         --  wrappers.
+
+         elsif Has_Entries (Prottyp)
+           or else (Ada_Version >= Ada_05
+                      and then Present (Interface_List (N)))
+         then
             if Abort_Allowed
               or else Restriction_Active (No_Entry_Queue) = False
               or else Number_Entries (Prottyp) > 1
@@ -5795,7 +6970,7 @@ package body Exp_Ch9 is
                  Make_Subprogram_Declaration (Loc,
                    Specification =>
                      Build_Protected_Sub_Specification
-                       (Priv, Prottyp, Unprotected => True));
+                       (Priv, Prottyp, Unprotected_Mode));
 
                Insert_After (Current_Node, Sub);
                Analyze (Sub);
@@ -5805,6 +6980,7 @@ package body Exp_Ch9 is
                   Defining_Unit_Name (Specification (Sub)));
 
                Current_Node := Sub;
+
                if Is_Interrupt_Handler
                  (Defining_Unit_Name (Specification (Priv)))
                then
@@ -5812,7 +6988,7 @@ package body Exp_Ch9 is
                     Make_Subprogram_Declaration (Loc,
                       Specification =>
                         Build_Protected_Sub_Specification
-                          (Priv, Prottyp, Unprotected => False));
+                          (Priv, Prottyp, Protected_Mode));
 
                   Insert_After (Current_Node, Sub);
                   Analyze (Sub);
@@ -5939,7 +7115,7 @@ package body Exp_Ch9 is
               Make_Subprogram_Declaration (Loc,
                 Specification =>
                   Build_Protected_Sub_Specification
-                    (Comp, Prottyp, Unprotected => True));
+                    (Comp, Prottyp, Unprotected_Mode));
 
             Insert_After (Current_Node, Sub);
             Analyze (Sub);
@@ -5957,12 +7133,33 @@ package body Exp_Ch9 is
               Make_Subprogram_Declaration (Loc,
                 Specification =>
                   Build_Protected_Sub_Specification
-                    (Comp, Prottyp, Unprotected => False));
+                    (Comp, Prottyp, Protected_Mode));
 
             Insert_After (Current_Node, Sub);
             Analyze (Sub);
+
             Current_Node := Sub;
 
+            --  Generate an overriding primitive operation specification for
+            --  this subprogram if the protected type implements an inerface.
+
+            if Ada_Version >= Ada_05
+              and then
+                Present (Abstract_Interfaces
+                          (Corresponding_Record_Type (Prottyp)))
+            then
+               Sub :=
+                 Make_Subprogram_Declaration (Loc,
+                   Specification =>
+                     Build_Protected_Sub_Specification
+                       (Comp, Prottyp, Dispatching_Mode));
+
+               Insert_After (Current_Node, Sub);
+               Analyze (Sub);
+
+               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:
@@ -5971,7 +7168,7 @@ package body Exp_Ch9 is
 
             if not Restricted_Profile
               and then Is_Interrupt_Handler
-                (Defining_Unit_Name (Specification (Comp)))
+                         (Defining_Unit_Name (Specification (Comp)))
             then
                Register_Handler;
             end if;
@@ -6042,7 +7239,6 @@ package body Exp_Ch9 is
 
       if Present (Private_Declarations (Pdef)) then
          Comp := First (Private_Declarations (Pdef));
-
          while Present (Comp) loop
             if Nkind (Comp) = N_Entry_Declaration then
                E_Count := E_Count + 1;
@@ -8125,11 +9321,11 @@ package body Exp_Ch9 is
    --  1) When T.E is a task entry_call;
 
    --    declare
-   --       B : Boolean;
-   --       X : Task_Entry_Index := <entry index>;
+   --       B  : Boolean;
+   --       X  : Task_Entry_Index := <entry index>;
    --       DX : Duration := To_Duration (D);
-   --       M : Delay_Mode := <discriminant>;
-   --       P : parms := (parm, parm, parm);
+   --       M  : Delay_Mode := <discriminant>;
+   --       P  : parms := (parm, parm, parm);
 
    --    begin
    --       Timed_Protected_Entry_Call (<acceptor-task>, X, P'Address,
@@ -8147,7 +9343,7 @@ package body Exp_Ch9 is
    --       B  : Boolean;
    --       X  : Protected_Entry_Index := <entry index>;
    --       DX : Duration := To_Duration (D);
-   --       M : Delay_Mode := <discriminant>;
+   --       M  : Delay_Mode := <discriminant>;
    --       P  : parms := (parm, parm, parm);
 
    --    begin
@@ -8160,6 +9356,40 @@ package body Exp_Ch9 is
    --       end if;
    --    end;
 
+   --  3) Ada 2005 (AI-345): When T.E is a dispatching procedure call;
+
+   --    declare
+   --       B  : Boolean := False;
+   --       C  : Ada.Tags.Prim_Op_Kind;
+   --       DX : Duration := To_Duration (D)
+   --       M  : Integer :=...;
+   --       P  : Parameters := (Param1 .. ParamN);
+   --       S  : constant Iteger := DT_Position (<dispatching-procedure>);
+
+   --    begin
+   --       disp_timed_select (<object>, S, P'Address, DX, M, C, B);
+
+   --       if C = POK_Protected_Entry
+   --         or else C = POK_Task_Entry
+   --       then
+   --          Param1 := P.Param1;
+   --          ...
+   --          ParamN := P.ParamN;
+   --       end if;
+
+   --       if B then
+   --          if C = POK_Procedure
+   --            or else C = POK_Protected_Procedure
+   --            or else C = POK_Task_Procedure
+   --          then
+   --             T.E;
+   --          end if;
+   --          S1;
+   --       else
+   --          S2;
+   --       end if;
+   --    end;
+
    procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
@@ -8172,25 +9402,32 @@ package body Exp_Ch9 is
       D_Stats : constant List_Id :=
                   Statements (Delay_Alternative (N));
 
-      Stmts : List_Id;
-      Stmt  : Node_Id;
-      Parms : List_Id;
-      Parm  : Node_Id;
-
-      Concval : Node_Id;
-      Ename   : Node_Id;
-      Index   : Node_Id;
-
-      Decls : List_Id;
-      Disc  : Node_Id;
-      Conv  : Node_Id;
-      B     : Entity_Id;
-      D     : Entity_Id;
-      Dtyp  : Entity_Id;
-      M     : Entity_Id;
-
-      Call  : Node_Id;
-      Dummy : Node_Id;
+      Actuals  : List_Id;
+      Blk_Typ  : Entity_Id;
+      Call     : Node_Id;
+      Call_Ent : Entity_Id;
+      Concval  : Node_Id;
+      D_Conv   : Node_Id;
+      D_Disc   : Node_Id;
+      D_Type   : Entity_Id;
+      Decls    : List_Id;
+      Dummy    : Node_Id;
+      Ename    : Node_Id;
+      Formals  : List_Id;
+      Index    : Node_Id;
+      N_Stats  : List_Id;
+      Obj      : Entity_Id;
+      Param    : Node_Id;
+      Params   : List_Id;
+      Stmt     : Node_Id;
+      Stmts    : 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
+      S : Entity_Id;  --  Primitive operation slot
 
    begin
       --  The arguments in the call may require dynamic allocation, and the
@@ -8200,7 +9437,6 @@ package body Exp_Ch9 is
 
       if Nkind (E_Call) = N_Block_Statement then
          E_Call := First (Statements (Handled_Statement_Sequence (E_Call)));
-
          while Nkind (E_Call) /= N_Procedure_Call_Statement
            and then Nkind (E_Call) /= N_Entry_Call_Statement
          loop
@@ -8208,170 +9444,350 @@ package body Exp_Ch9 is
          end loop;
       end if;
 
-      --  Build an entry call using Simple_Entry_Call. We will use this as the
-      --  base for creating appropriate calls.
+      if Ada_Version >= Ada_05
+        and then Nkind (E_Call) = N_Procedure_Call_Statement
+      then
+         Extract_Dispatching_Call (E_Call, Call_Ent, Obj, Actuals, Formals);
+
+         Decls := New_List;
+         Stmts := New_List;
+
+      else
+         --  Build an entry call using Simple_Entry_Call
 
-      Extract_Entry (E_Call, Concval, Ename, Index);
-      Build_Simple_Entry_Call (E_Call, Concval, Ename, Index);
+         Extract_Entry (E_Call, Concval, Ename, Index);
+         Build_Simple_Entry_Call (E_Call, Concval, Ename, Index);
 
-      Stmts := Statements (Handled_Statement_Sequence (E_Call));
-      Decls := Declarations (E_Call);
+         Decls := Declarations (E_Call);
+         Stmts := Statements (Handled_Statement_Sequence (E_Call));
 
-      if No (Decls) then
-         Decls := New_List;
+         if No (Decls) then
+            Decls := New_List;
+         end if;
       end if;
 
-      Dtyp := Base_Type (Etype (Expression (D_Stat)));
+      --  Call status flag processing
+
+      if Ada_Version >= Ada_05
+        and then Nkind (E_Call) = N_Procedure_Call_Statement
+      then
+         --  Generate:
+         --    B : Boolean := False;
+
+         B := SEU.Build_B (Loc, Decls);
+
+      else
+         --  Generate:
+         --    B : Boolean;
+
+         B := Make_Defining_Identifier (Loc, Name_uB);
+
+         Prepend_To (Decls,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier =>
+               B,
+             Object_Definition =>
+               New_Reference_To (Standard_Boolean, Loc)));
+      end if;
+
+      --  Call kind processing
+
+      if Ada_Version >= Ada_05
+        and then Nkind (E_Call) = N_Procedure_Call_Statement
+      then
+         --  Generate:
+         --    C : Ada.Tags.Prim_Op_Kind;
+
+         C := SEU.Build_C (Loc, Decls);
+      end if;
+
+      --  Duration and mode processing
+
+      D_Type := Base_Type (Etype (Expression (D_Stat)));
 
       --  Use the type of the delay expression (Calendar or Real_Time)
       --  to generate the appropriate conversion.
 
       if Nkind (D_Stat) = N_Delay_Relative_Statement then
-         Disc := Make_Integer_Literal (Loc, 0);
-         Conv := Relocate_Node (Expression (D_Stat));
+         D_Disc := Make_Integer_Literal (Loc, 0);
+         D_Conv := Relocate_Node (Expression (D_Stat));
 
-      elsif Is_RTE (Dtyp, RO_CA_Time) then
-         Disc := Make_Integer_Literal (Loc, 1);
-         Conv := Make_Function_Call (Loc,
+      elsif Is_RTE (D_Type, RO_CA_Time) then
+         D_Disc := Make_Integer_Literal (Loc, 1);
+         D_Conv := Make_Function_Call (Loc,
            New_Reference_To (RTE (RO_CA_To_Duration), Loc),
            New_List (New_Copy (Expression (D_Stat))));
 
-      else pragma Assert (Is_RTE (Dtyp, RO_RT_Time));
-         Disc := Make_Integer_Literal (Loc, 2);
-         Conv := Make_Function_Call (Loc,
+      else pragma Assert (Is_RTE (D_Type, RO_RT_Time));
+         D_Disc := Make_Integer_Literal (Loc, 2);
+         D_Conv := Make_Function_Call (Loc,
            New_Reference_To (RTE (RO_RT_To_Duration), Loc),
            New_List (New_Copy (Expression (D_Stat))));
       end if;
 
-      --  Create Duration and Delay_Mode objects for passing a delay value
-
       D := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
-      M := Make_Defining_Identifier (Loc, New_Internal_Name ('M'));
 
-      Append_To (Decls,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => D,
-          Object_Definition => New_Reference_To (Standard_Duration, Loc)));
+      --  Generate:
+      --    D : Duration;
 
       Append_To (Decls,
         Make_Object_Declaration (Loc,
-          Defining_Identifier => M,
-          Object_Definition => New_Reference_To (Standard_Integer, Loc),
-          Expression        => Disc));
+          Defining_Identifier =>
+            D,
+          Object_Definition =>
+            New_Reference_To (Standard_Duration, Loc)));
 
-      B := Make_Defining_Identifier (Loc, Name_uB);
+      M := Make_Defining_Identifier (Loc, New_Internal_Name ('M'));
 
-      --  Create a boolean object used for a return parameter
+      --  Generate:
+      --    M : Integer := (0 | 1 | 2);
 
-      Prepend_To (Decls,
+      Append_To (Decls,
         Make_Object_Declaration (Loc,
-          Defining_Identifier => B,
-          Object_Definition => New_Reference_To (Standard_Boolean, Loc)));
-
-      Stmt := First (Stmts);
-
-      --  Skip assignments to temporaries created for in-out parameters.
-      --  This makes unwarranted assumptions about the shape of the expanded
-      --  tree for the call, and should be cleaned up ???
-
-      while Nkind (Stmt) /= N_Procedure_Call_Statement loop
-         Next (Stmt);
-      end loop;
+          Defining_Identifier =>
+            M,
+          Object_Definition =>
+            New_Reference_To (Standard_Integer, Loc),
+          Expression =>
+            D_Disc));
 
       --  Do the assignement at this stage only because the evaluation of the
       --  expression must not occur before (see ACVC C97302A).
 
-      Insert_Before (Stmt,
+      Append_To (Stmts,
         Make_Assignment_Statement (Loc,
-          Name => New_Reference_To (D, Loc),
-          Expression => Conv));
+          Name =>
+            New_Reference_To (D, Loc),
+          Expression =>
+            D_Conv));
 
-      Call := Stmt;
+      --  Parameter block processing
 
-      Parms := Parameter_Associations (Call);
+      --  Manually create the parameter block for dispatching calls. In the
+      --  case of entries, the block has already been created during the call
+      --  to Build_Simple_Entry_Call.
 
-      --  For a protected type, we build a Timed_Protected_Entry_Call
+      if Ada_Version >= Ada_05
+        and then Nkind (E_Call) = N_Procedure_Call_Statement
+      then
+         Blk_Typ := Build_Parameter_Block (Loc, Actuals, Formals, Decls);
+         P       := Parameter_Block_Pack  (Loc, Blk_Typ, Actuals, Formals,
+                      Decls, Stmts);
 
-      if Is_Protected_Type (Etype (Concval)) then
+         --  Dispatch table slot processing, generate:
+         --    S : constant Integer :=
+         --          DT_Prosition (<dispatching-procedure>)
 
-         --  Create a new call statement
+         S := SEU.Build_S (Loc, Decls, Call_Ent);
 
-         Parm := First (Parms);
+         --  Generate:
+         --    _dispatching_timed_select (Obj, S, P'address, D, M, C, B);
 
-         while Present (Parm)
-           and then not Is_RTE (Etype (Parm), RE_Call_Modes)
-         loop
-            Next (Parm);
-         end loop;
+         --  where Obj is the controlling formal parameter, S is the dispatch
+         --  table slot number of the dispatching operation, P is the wrapped
+         --  parameter block, D is the duration, M is the duration mode, C is
+         --  the call kind and B is the call status.
 
-         Dummy := Remove_Next (Next (Parm));
+         Params := New_List;
 
-         --  Remove garbage is following the Cancel_Param if present
+         Append_To (Params, New_Copy_Tree    (Obj));
+         Append_To (Params, New_Reference_To (S, Loc));
+         Append_To (Params, P);
+         Append_To (Params, New_Reference_To (D, Loc));
+         Append_To (Params, New_Reference_To (M, Loc));
+         Append_To (Params, New_Reference_To (C, Loc));
+         Append_To (Params, New_Reference_To (B, Loc));
 
-         Dummy := Next (Parm);
+         Append_To (Stmts,
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               Make_Identifier (Loc, Name_uDisp_Timed_Select),
+             Parameter_Associations =>
+               Params));
+
+         --  Generate:
+         --    if C = POK_Protected_Entry
+         --      or else C = POK_Task_Entry
+         --    then
+         --       Param1 := P.Param1;
+         --       ...
+         --       ParamN := P.ParamN;
+         --    end if;
 
-         --  Remove the mode of the Protected_Entry_Call call, then remove the
-         --  Communication_Block of the Protected_Entry_Call call, and finally
-         --  add Duration and a Delay_Mode parameter
+         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))),
 
-         pragma Assert (Present (Parm));
-         Rewrite (Parm, New_Reference_To (D, Loc));
+             Then_Statements =>
+               Parameter_Block_Unpack (Loc, Actuals, Formals)));
+
+         --  Generate:
+         --    if B then
+         --       if C = POK_Procedure
+         --         or else C = POK_Protected_Procedure
+         --         or else C = POK_Task_Procedure
+         --       then
+         --          <dispatching-procedure-call>
+         --       end if;
+         --       <normal-statements>
+         --    else
+         --       <delay-statements>
+         --    end if;
 
-         Rewrite (Dummy, New_Reference_To (M, Loc));
+         N_Stats := New_Copy_List (E_Stats);
+
+         Prepend_To (N_Stats,
+           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_Procedure), Loc)),
+                 Right_Opnd =>
+                   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_Procedure), Loc)),
+                     Right_Opnd =>
+                       Make_Op_Eq (Loc,
+                         Left_Opnd =>
+                           New_Reference_To (C, Loc),
+                         Right_Opnd =>
+                           New_Reference_To (RTE (
+                             RE_POK_Task_Procedure), Loc)))),
 
-         --  Add a Boolean flag for successful entry call
+             Then_Statements =>
+               New_List (E_Call)));
 
-         Append_To (Parms, New_Reference_To (B, Loc));
+         Append_To (Stmts,
+           Make_If_Statement (Loc,
+             Condition       => New_Reference_To (B, Loc),
+             Then_Statements => N_Stats,
+             Else_Statements => D_Stats));
+      else
+         --  Skip assignments to temporaries created for in-out parameters.
+         --  This makes unwarranted assumptions about the shape of the expanded
+         --  tree for the call, and should be cleaned up ???
 
-         if Abort_Allowed
-           or else Restriction_Active (No_Entry_Queue) = False
-           or else Number_Entries (Etype (Concval)) > 1
-         then
-            Rewrite (Call,
-              Make_Procedure_Call_Statement (Loc,
-                Name =>
-                  New_Reference_To (RTE (RE_Timed_Protected_Entry_Call), Loc),
-                Parameter_Associations => Parms));
+         Stmt := First (Stmts);
+         while Nkind (Stmt) /= N_Procedure_Call_Statement loop
+            Next (Stmt);
+         end loop;
 
-         else
-            Parm := First (Parms);
+         --  Do the assignement at this stage only because the evaluation
+         --  of the expression must not occur before (see ACVC C97302A).
 
-            while Present (Parm)
-              and then not Is_RTE (Etype (Parm), RE_Protected_Entry_Index)
+         Insert_Before (Stmt,
+           Make_Assignment_Statement (Loc,
+             Name => New_Reference_To (D, Loc),
+             Expression => D_Conv));
+
+         Call   := Stmt;
+         Params := Parameter_Associations (Call);
+
+         --  For a protected type, we build a Timed_Protected_Entry_Call
+
+         if Is_Protected_Type (Etype (Concval)) then
+
+            --  Create a new call statement
+
+            Param := First (Params);
+            while Present (Param)
+              and then not Is_RTE (Etype (Param), RE_Call_Modes)
             loop
-               Next (Parm);
+               Next (Param);
             end loop;
 
-            Remove (Parm);
+            Dummy := Remove_Next (Next (Param));
 
-            Rewrite (Call,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Reference_To (
-                  RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
-                Parameter_Associations => Parms));
-         end if;
+            --  Remove garbage is following the Cancel_Param if present
 
-      --  For the task case, build a Timed_Task_Entry_Call
+            Dummy := Next (Param);
 
-      else
-         --  Create a new call statement
+            --  Remove the mode of the Protected_Entry_Call call, then remove
+            --  the Communication_Block of the Protected_Entry_Call call, and
+            --  finally add Duration and a Delay_Mode parameter
 
-         Append_To (Parms, New_Reference_To (D, Loc));
-         Append_To (Parms, New_Reference_To (M, Loc));
-         Append_To (Parms, New_Reference_To (B, Loc));
+            pragma Assert (Present (Param));
+            Rewrite (Param, New_Reference_To (D, Loc));
 
-         Rewrite (Call,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Timed_Task_Entry_Call), Loc),
-             Parameter_Associations => Parms));
+            Rewrite (Dummy, New_Reference_To (M, Loc));
 
-      end if;
+            --  Add a Boolean flag for successful entry call
 
-      Append_To (Stmts,
-        Make_Implicit_If_Statement (N,
-          Condition => New_Reference_To (B, Loc),
-          Then_Statements => E_Stats,
-          Else_Statements => D_Stats));
+            Append_To (Params, New_Reference_To (B, Loc));
+
+            if Abort_Allowed
+              or else Restriction_Active (No_Entry_Queue) = False
+              or else Number_Entries (Etype (Concval)) > 1
+            then
+               Rewrite (Call,
+                 Make_Procedure_Call_Statement (Loc,
+                   Name =>
+                     New_Reference_To (RTE (
+                       RE_Timed_Protected_Entry_Call), Loc),
+                   Parameter_Associations => Params));
+            else
+               Param := First (Params);
+               while Present (Param)
+                 and then not Is_RTE (Etype (Param), RE_Protected_Entry_Index)
+               loop
+                  Next (Param);
+               end loop;
+
+               Remove (Param);
+
+               Rewrite (Call,
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Reference_To (
+                     RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
+                   Parameter_Associations => Params));
+            end if;
+
+         --  For the task case, build a Timed_Task_Entry_Call
+
+         else
+            --  Create a new call statement
+
+            Append_To (Params, New_Reference_To (D, Loc));
+            Append_To (Params, New_Reference_To (M, Loc));
+            Append_To (Params, New_Reference_To (B, Loc));
+
+            Rewrite (Call,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  New_Reference_To (RTE (RE_Timed_Task_Entry_Call), Loc),
+                Parameter_Associations => Params));
+         end if;
+
+         Append_To (Stmts,
+           Make_Implicit_If_Statement (N,
+             Condition => New_Reference_To (B, Loc),
+             Then_Statements => E_Stats,
+             Else_Statements => D_Stats));
+      end if;
 
       Rewrite (N,
         Make_Block_Statement (Loc,
@@ -8481,6 +9897,55 @@ package body Exp_Ch9 is
       end if;
    end External_Subprogram;
 
+   ------------------------------
+   -- Extract_Dispatching_Call --
+   ------------------------------
+
+   procedure Extract_Dispatching_Call
+     (N        : Node_Id;
+      Call_Ent : out Entity_Id;
+      Object   : out Entity_Id;
+      Actuals  : out List_Id;
+      Formals  : out List_Id)
+   is
+      Call_Nam : Node_Id;
+
+   begin
+      pragma Assert (Nkind (N) = N_Procedure_Call_Statement);
+
+      if Present (Original_Node (N)) then
+         Call_Nam := Name (Original_Node (N));
+      else
+         Call_Nam := Name (N);
+      end if;
+
+      --  Retrieve the name of the dispatching procedure. It contains the
+      --  dispatch table slot number.
+
+      loop
+         case Nkind (Call_Nam) is
+            when N_Identifier =>
+               exit;
+
+            when N_Selected_Component =>
+               Call_Nam := Selector_Name (Call_Nam);
+
+            when others =>
+               raise Program_Error;
+
+         end case;
+      end loop;
+
+      Actuals  := Parameter_Associations (N);
+      Call_Ent := Entity (Call_Nam);
+      Formals  := Parameter_Specifications (Parent (Call_Ent));
+      Object   := First (Actuals);
+
+      if Present (Original_Node (Object)) then
+         Object := Original_Node (Object);
+      end if;
+   end Extract_Dispatching_Call;
+
    -------------------
    -- Extract_Entry --
    -------------------
@@ -8502,15 +9967,13 @@ package body Exp_Ch9 is
          Ename   := Selector_Name (Nam);
          Index   := Empty;
 
-         --  For a member of an entry family, the name is an indexed
-         --  component where the prefix is a selected component,
-         --  whose prefix in turn is the task value, and whose
-         --  selector is the entry family. The single expression in
-         --  the expressions list of the indexed component is the
-         --  subscript for the family.
+      --  For a member of an entry family, the name is an indexed component
+      --  where the prefix is a selected component, whose prefix in turn is
+      --  the task value, and whose selector is the entry family. The single
+      --  expression in the expressions list of the indexed component is the
+      --  subscript for the family.
 
-      else
-         pragma Assert (Nkind (Nam) = N_Indexed_Component);
+      else pragma Assert (Nkind (Nam) = N_Indexed_Component);
          Concval := Prefix (Prefix (Nam));
          Ename   := Selector_Name (Prefix (Nam));
          Index   := First (Expressions (Nam));
@@ -8899,6 +10362,8 @@ package body Exp_Ch9 is
       if Has_Entry
         or else Has_Interrupt_Handler (Ptyp)
         or else Has_Attach_Handler (Ptyp)
+        or else (Ada_Version >= Ada_05
+                   and then Present (Interface_List (Parent (Ptyp))))
       then
          --  Compiler_Info parameter. This parameter allows entry body
          --  procedures and barrier functions to be called from the runtime.
@@ -9287,6 +10752,168 @@ package body Exp_Ch9 is
       return Next_Op;
    end Next_Protected_Operation;
 
+   --------------------------
+   -- Parameter_Block_Pack --
+   --------------------------
+
+   function Parameter_Block_Pack
+     (Loc     : Source_Ptr;
+      Blk_Typ : Entity_Id;
+      Actuals : List_Id;
+      Formals : List_Id;
+      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;
+
+   begin
+      Actual := First (Actuals);
+      Formal := Defining_Identifier (First (Formals));
+      Params := New_List;
+
+      while Present (Actual) loop
+         if Is_By_Copy_Type (Etype (Actual)) then
+            --  Generate:
+            --    Jnn : aliased <formal-type>
+
+            Temp_Nam :=
+              Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
+
+            Append_To (Decls,
+              Make_Object_Declaration (Loc,
+                Aliased_Present =>
+                  True,
+                Defining_Identifier =>
+                  Temp_Nam,
+                Object_Definition =>
+                  New_Reference_To (Etype (Formal), Loc)));
+
+            if Ekind (Formal) /= E_Out_Parameter then
+
+               --  Generate:
+               --    Jnn := <actual>
+
+               Temp_Asn :=
+                 New_Reference_To (Temp_Nam, Loc);
+
+               Set_Assignment_OK (Temp_Asn);
+
+               Append_To (Stmts,
+                 Make_Assignment_Statement (Loc,
+                   Name =>
+                     Temp_Asn,
+                   Expression =>
+                     New_Copy_Tree (Actual)));
+            end if;
+
+            --  Generate:
+            --    Jnn'unchecked_access
+
+            Append_To (Params,
+              Make_Attribute_Reference (Loc,
+                Attribute_Name =>
+                  Name_Unchecked_Access,
+                Prefix =>
+                  New_Reference_To (Temp_Nam, Loc)));
+         else
+            Append_To (Params,
+              Make_Reference (Loc, New_Copy_Tree (Actual)));
+         end if;
+
+         Next_Actual (Actual);
+         Next_Formal_With_Extras (Formal);
+      end loop;
+
+      --  Generate:
+      --    P : Ann := (
+      --      J1'unchecked_access;
+      --      <actual2>'reference;
+      --      ...);
+
+      Blk_Nam := Make_Defining_Identifier (Loc, Name_uP);
+
+      Append_To (Decls,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier =>
+            Blk_Nam,
+          Object_Definition =>
+            New_Reference_To (Blk_Typ, Loc),
+          Expression =>
+            Make_Aggregate (Loc, Params)));
+
+      --  Return:
+      --    P'address
+
+      return
+        Make_Attribute_Reference (Loc,
+          Attribute_Name =>
+            Name_Address,
+          Prefix =>
+            New_Reference_To (Blk_Nam, Loc));
+   end Parameter_Block_Pack;
+
+   ----------------------------
+   -- Parameter_Block_Unpack --
+   ----------------------------
+
+   function Parameter_Block_Unpack
+     (Loc     : Source_Ptr;
+      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;
+
+   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>;
+
+            Asnmt :=
+              Make_Assignment_Statement (Loc,
+                Name =>
+                  New_Copy (Actual),
+                Expression =>
+                  Make_Explicit_Dereference (Loc,
+                    Make_Selected_Component (Loc,
+                      Prefix =>
+                        Make_Identifier (Loc, Name_uP),
+                      Selector_Name =>
+                        Make_Identifier (Loc, Chars (Formal)))));
+
+            Set_Assignment_OK (Name (Asnmt));
+
+            Append_To (Result, Asnmt);
+         end if;
+
+         Next_Actual (Actual);
+         Next_Formal_With_Extras (Formal);
+      end loop;
+
+      if At_Least_One_Asnmt then
+         return Result;
+      end if;
+
+      return New_List (Make_Null_Statement (Loc));
+   end Parameter_Block_Unpack;
+
    ----------------------
    -- Set_Discriminals --
    ----------------------
@@ -9302,7 +10929,6 @@ package body Exp_Ch9 is
 
       if Has_Discriminants (Pdef) then
          D := First_Discriminant (Pdef);
-
          while Present (D) loop
             D_Minal :=
               Make_Defining_Identifier (Sloc (D),
@@ -9366,11 +10992,10 @@ package body Exp_Ch9 is
                Set_Esize     (Priv, Esize (Etype (P_Id)));
                Set_Alignment (Priv, Alignment (Etype (P_Id)));
 
-               --  If the type of the component is an itype, we must
-               --  create a new itype for the corresponding prival in
-               --  each protected operation, to avoid scoping problems.
-               --  We create new itypes by copying the tree for the
-               --  component definition.
+               --  If the type of the component is an itype, we must create a
+               --  new itype for the corresponding prival in each protected
+               --  operation, to avoid scoping problems. We create new itypes
+               --  by copying the tree for the component definition.
 
                if Is_Itype (Etype (P_Id)) then
                   Append_Elmt (P_Id, Assoc_L);
@@ -9394,9 +11019,8 @@ package body Exp_Ch9 is
          end loop;
       end if;
 
-      --  There is one more implicit private declaration: the object
-      --  itself. A "prival" for this is attached to the protected
-      --  body defining identifier.
+      --  There is one more implicit private decl: the object itself. "prival"
+      --  for this is attached to the protected body defining identifier.
 
       Body_Ent := Corresponding_Body (Dec);
 
@@ -9492,11 +11116,12 @@ package body Exp_Ch9 is
             Update_Array_Bounds (Etype (Defining_Identifier (N)));
             return OK;
 
-         --  For array components of discriminated records, use the
-         --  base type directly, because it may depend indirectly
-         --  on the discriminants of the protected type. Cleaner would
-         --  be a systematic mechanism to compute actual subtypes of
-         --  private components ???
+         --  For array components of discriminated records, use the base type
+         --  directly, because it may depend indirectly on the discriminants of
+         --  the protected type.
+
+         --  Cleaner would be a systematic mechanism to compute actual subtypes
+         --  of private components???
 
          elsif Nkind (N) in N_Has_Etype
            and then Present (Etype (N))
@@ -9532,10 +11157,8 @@ package body Exp_Ch9 is
 
       procedure Update_Array_Bounds (E : Entity_Id) is
          Ind : Node_Id;
-
       begin
          Ind := First_Index (E);
-
          while Present (Ind) loop
             Update_Prival_Subtypes (Type_Low_Bound  (Etype (Ind)));
             Update_Prival_Subtypes (Type_High_Bound (Etype (Ind)));
@@ -9550,13 +11173,13 @@ package body Exp_Ch9 is
       procedure Update_Index_Types (N : Node_Id) is
          Indx1 : Node_Id;
          I_Typ : Node_Id;
+
       begin
-         --  If the prefix has an actual subtype that is different
-         --  from the nominal one, update the types of the indices,
-         --  so that the proper constraints are applied. Do not
-         --  apply this transformation to a packed array, where the
-         --  index type is computed for a byte array and is different
-         --  from the source index.
+         --  If the prefix has an actual subtype that is different from the
+         --  nominal one, update the types of the indices, so that the proper
+         --  constraints are applied. Do not apply this transformation to a
+         --  packed array, where the index type is computed for a byte array
+         --  and is different from the source index.
 
          if Nkind (Parent (N)) = N_Indexed_Component
            and then