------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              E X P _ C H 9                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.298 $                            --
--                                                                          --
--          Copyright (C) 1992-1997, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Atree;    use Atree;
with Einfo;    use Einfo;
with Elists;   use Elists;
with Expander; use Expander;
with Exp_Ch3;  use Exp_Ch3;
with Exp_Ch6;  use Exp_Ch6;
with Exp_TSS;  use Exp_TSS;
with Exp_Util; use Exp_Util;
with Freeze;   use Freeze;
with Hostparm;
with Namet;    use Namet;
with Nlists;   use Nlists;
with Nmake;    use Nmake;
with Output;   use Output;
with Rtsfind;  use Rtsfind;
with Sem;      use Sem;
with Sem_Ch3;  use Sem_Ch3;
with Sem_Ch5;
with Sem_Ch6;
with Sem_Ch8;  use Sem_Ch8;
with Sem_Ch11; use Sem_Ch11;
with Sem_Ch13; use Sem_Ch13;
with Sem_Util; use Sem_Util;
with Sinfo;    use Sinfo;
with Snames;   use Snames;
with Stand;    use Stand;
with Tbuild;   use Tbuild;
with Types;    use Types;
with Uintp;    use Uintp;

package body Exp_Ch9 is

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Add_Object_Pointer
     (Decls : List_Id;
      Pid   : Entity_Id;
      Loc   : Source_Ptr);
   --  Prepend an object pointer declaration to the declaration list
   --  Decls. This object pointer is initialized to a type conversion
   --  of the System.Address pointer passed to entry barrier functions
   --  and entry body procedures.

   function Array_Type (E : Entity_Id; Trec : Node_Id) return Entity_Id;
   --  Find the array type associated with an entry family in the
   --  associated record for the task type.

   function Build_Accept_Body
     (Stats : Node_Id;
      Loc   : Source_Ptr)
      return  Node_Id;
   --  Transform accept statement into a block with added exception handler.
   --  Cused both for simple accept statements and for accept alternatives in
   --  select statements.

   function Build_Barrier_Function
     (N    : Node_Id;
      Ent  : Entity_Id;
      Pid  : Node_Id)
      return Node_Id;
   --  Build the function body returning the value of the barrier expression
   --  for the specified entry body.

   function Build_Barrier_Function_Specification
     (Def_Id : Entity_Id;
      Loc    : Source_Ptr)
      return   Node_Id;
   --  Build a specification for a function implementing
   --  the protected entry barrier of the specified entry body.

   function Build_Corresponding_Record
     (N    : Node_Id;
      Ctyp : Node_Id;
      Loc  : Source_Ptr)
      return Node_Id;
   --  Common to tasks and protected types. Copy discriminant specifications,
   --  build record declaration. What are the parameters ???

   function Build_Entry_Count_Expression
     (Concurrent_Type : Node_Id;
      Component_List  : List_Id;
      Loc             : Source_Ptr)
      return            Node_Id;
   --  Compute number of entries for concurrent object. This is a count of
   --  simple entries, followed by an expression that computes the length
   --  of the range of each entry family.

   function Build_Protected_Entry
     (N         : Node_Id;
      Ent       : Entity_Id;
      Pid       : Node_Id)
      return Node_Id;
   --  Build the procedure implementing the statement sequence of
   --  the specified entry body.

   function Build_Protected_Entry_Specification
     (Def_Id : Entity_Id;
      Ent_Id : Entity_Id;
      Loc    : Source_Ptr)
      return Node_Id;
   --  Build a specification for a procedure implementing
   --  the statement sequence of the specified entry body.
   --  Add attributes associating it with the entry defining identifier
   --  Ent_Id.

   function Build_Protected_Subprogram_Body
     (N         : Node_Id;
      Pid       : Node_Id;
      N_Op_Spec : Node_Id)
      return      Node_Id;
   --  This function is used to construct the protected version of a protected
   --  subprogram. Its statement sequence first defers abortion, then locks
   --  the associated protected object, and then enters a block that contains
   --  a call to the unprotected version of the subprogram (for details, see
   --  Build_Unprotected_Subprogram_Body). This block statement requires
   --  a cleanup handler that unlocks the object in all cases.
   --  (see Exp_Ch7.Expand_Cleanup_Actions).

   function Build_Protected_Spec
     (N           : Node_Id;
      Obj_Type    : Entity_Id;
      Unprotected : Boolean := False;
      Ident       : Entity_Id)
      return        List_Id;
   --  Utility shared by Build_Protected_Sub_Spec and Expand_Access_Protected_
   --  Subprogram_Type. Builds signature of protected subprogram, adding the
   --  formal that corresponds to the object itself. For an access to protected
   --  subprogram, there is no object type to specify, so the additional
   --  parameter has type Address and mode In. An indirect call through such
   --  a pointer converts the address to a reference to the actual object.
   --  The object is a limited record and therefore a by_reference type.

   function Build_Selected_Name
     (Prefix, Selector : Name_Id;
      Append_Char      : Character := ' ')
      return Name_Id;
   --  Build a name in the form of Prefix__Selector, with an optional
   --  character appended. This is used for internal subprograms generated
   --  for operations of protected types, including barrier functions. In
   --  order to simplify the work of the debugger, the prefix includes the
   --  characters PT.

   procedure Build_Simple_Entry_Call
     (N       : Node_Id;
      Concval : Node_Id;
      Ename   : Node_Id;
      Index   : Node_Id);
   --  Some comments here would be useful ???

   function Build_Task_Proc_Specification (T : Entity_Id) return Node_Id;
   --  This routine constructs a specification for the procedure that we will
   --  build for the task body for task type T. The spec has the form:
   --
   --    procedure tnameB (_Task : access tnameV);
   --
   --  where name is the character name taken from the task type entity that
   --  is passed as the argument to the procedure, and tnameV is the task
   --  value type that is associated with the task type.

   function Build_Unprotected_Subprogram_Body
     (N    : Node_Id;
      Pid  : Node_Id)
      return Node_Id;
   --  This routine constructs the unprotected version of a protected
   --  subprogram body, which is contains all of the code in the
   --  original, unexpanded body. This is the version of the protected
   --  subprogram that is called from all protected operations on the same
   --  object, including the protected version of the same subprogram.

   procedure Collect_Entry_Families
     (Loc          : Source_Ptr;
      Cdecls       : List_Id;
      Current_Node : in out Node_Id;
      Conctyp      : Entity_Id);
   --  For each entry family in a concurrent type, create an anonymous array
   --  type of the right size, and add a component to the corresponding_record.

   function Entry_Range_Expression
     (Sloc  : Source_Ptr;
      Ent   : Entity_Id;
      Ttyp  : Entity_Id)
      return  Node_Id;
   --  Returns the entry index range allocated to an entry family.
   --  Ttyp is the concurrent type.

   procedure Extract_Entry
     (N       : Node_Id;
      Concval : out Node_Id;
      Ename   : out Node_Id;
      Index   : out Node_Id);
   --  Given an entry call, returns the associated concurrent object,
   --  the entry name, and the entry family index.

   function Find_Task_Or_Protected_Pragma
     (T    : Node_Id;
      P    : Name_Id)
      return Node_Id;
   --  Searches the task or protected definition T for the first occurrence
   --  of the pragma whose name is given by P. The caller has ensured that
   --  the pragma is present in the task definition. A special case is that
   --  when P is Name_uPriority, the call will also find Interrupt_Priority.

   procedure Update_Prival_Subtypes (D : Union_Id);
   --  If the protected type has discriminants, the actual subtypes of the
   --  privals will differ from the type of the private declaration in the
   --  original protected type. After generating the bodies for protected
   --  operations, set correctly the type of all references to privals. This
   --  is done with a recursive tree traversal, which is heavy-handed but
   --  correct.

   ----------------------------------
   -- Add_Discriminal_Declarations --
   ----------------------------------

   procedure Add_Discriminal_Declarations
     (Decls : List_Id;
      Typ   : Entity_Id;
      Name  : Name_Id;
      Loc   : Source_Ptr)
   is
      D     : Entity_Id;

   begin
      if Has_Discriminants (Typ) then
         D := First_Discriminant (Typ);

         while Present (D) loop

            Prepend_To (Decls,
              Make_Object_Renaming_Declaration (Loc,
                Defining_Identifier => Discriminal (D),
                Subtype_Mark => New_Reference_To (Etype (D), Loc),
                Name =>
                  Make_Selected_Component (Loc,
                    Prefix        => Make_Identifier (Loc, Name),
                    Selector_Name => Make_Identifier (Loc, Chars (D)))));

            D := Next_Discriminant (D);
         end loop;
      end if;
   end Add_Discriminal_Declarations;

   ------------------------
   -- Add_Object_Pointer --
   ------------------------

   procedure Add_Object_Pointer
     (Decls : List_Id;
      Pid   : Entity_Id;
      Loc   : Source_Ptr)
   is
      Obj_Ptr : Node_Id;

   begin
      --  Prepend the declaration of _object. This must be first in the
      --  declaration list, since it is used by the discriminal and
      --  prival declarations.
      --  ??? An attempt to make this a renaming was unsuccessful.
      --
      --     type poVP is access poV;
      --     _object : poVP := poVP!O;

      Obj_Ptr :=
        Make_Defining_Identifier (Loc,
          Chars =>
            New_External_Name
              (Chars (Corresponding_Record_Type (Pid)), 'P'));

      Prepend_To (Decls,
        Make_Object_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, Name_uObject),
          Object_Definition => New_Reference_To (Obj_Ptr, Loc),
          Expression =>
            Unchecked_Convert_To (Obj_Ptr,
              Make_Identifier (Loc, Name_uO))));

      Prepend_To (Decls,
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => Obj_Ptr,
          Type_Definition => Make_Access_To_Object_Definition (Loc,
            Subtype_Indication =>
              New_Reference_To (Corresponding_Record_Type (Pid), Loc))));

   end Add_Object_Pointer;

   ------------------------------
   -- Add_Private_Declarations --
   ------------------------------

   procedure Add_Private_Declarations
     (Decls : List_Id;
      Typ   : Entity_Id;
      Name  : Name_Id;
      Loc   : Source_Ptr)
   is
      P        : Node_Id;
      Pdef     : Entity_Id;
      Def      : Node_Id := Protected_Definition (Parent (Typ));
      Body_Ent : constant Entity_Id := Corresponding_Body (Parent (Typ));

   begin
      pragma Assert (Nkind (Def) = N_Protected_Definition);

      if Present (Private_Declarations (Def)) then
         P := First (Private_Declarations (Def));

         while Present (P) loop
            if Nkind (P) = N_Component_Declaration then
               Pdef := Defining_Identifier (P);
               Prepend_To (Decls,
                 Make_Object_Renaming_Declaration (Loc,
                   Defining_Identifier => Prival (Pdef),
                   Subtype_Mark => New_Reference_To (Etype (Pdef), Loc),
                   Name =>
                     Make_Selected_Component (Loc,
                       Prefix        => Make_Identifier (Loc, Name),
                       Selector_Name => Make_Identifier (Loc, Chars (Pdef)))));
            end if;
            P := Next (P);
         end loop;
      end if;

      --  One more "prival" for the object itself.

      Prepend_To (Decls,
        Make_Object_Renaming_Declaration (Loc,
          Defining_Identifier => Object_Ref (Body_Ent),
          Subtype_Mark => New_Reference_To (RTE (RE_Protection), Loc),
          Name =>
            Make_Selected_Component (Loc,
              Prefix        => Make_Identifier (Loc, Name),
              Selector_Name => Make_Identifier (Loc, Name_uObject))));

   end Add_Private_Declarations;

   ----------------
   -- Array_Type --
   ----------------

   function Array_Type (E : Entity_Id; Trec : Node_Id) return Entity_Id is
      Arr : Entity_Id := First_Component (Trec);

   begin
      while Present (Arr) loop
         exit when Ekind (Arr) = E_Component
           and then Is_Array_Type (Etype (Arr))
           and then Chars (Arr) = Chars (E);

         Arr := Next_Component (Arr);
      end loop;

      --  This used to return Arr itself, but this caused problems
      --  when used in expanding a protected type, possibly because
      --  the record of which it is a component is not frozen yet.
      --  I am going to try the type instead. This may pose visibility
      --  problems. ???

      return Etype (Arr);
   end Array_Type;

   -----------------------
   -- Build_Accept_Body --
   -----------------------

   function Build_Accept_Body
     (Stats : Node_Id;
      Loc   : Source_Ptr)
      return  Node_Id
   is
      New_S : Node_Id;
      Hand  : Node_Id;
      Call  : Node_Id;

   begin
      --  Add the end of the statement sequence, Complete_Rendezvous is called.
      --  A label skipping the Complete_Rendezvous, and all other
      --  accept processing, has already been added for the expansion
      --  of requeue statements.

      Call := Build_Runtime_Call (Loc, RE_Complete_Rendezvous);
      Insert_Before (Last (Statements (Stats)), Call);
      Analyze (Call);

      --  If exception handlers are present, then append Complete_Rendezvous
      --  calls to the handlers, and construct the required outer block.

      if Present (Exception_Handlers (Stats)) then
         Hand := First (Exception_Handlers (Stats));

         while Present (Hand) loop
            Call := Build_Runtime_Call (Loc, RE_Complete_Rendezvous);
            Append (Call, Statements (Hand));
            Analyze (Call);
            Hand := Next (Hand);
         end loop;

         New_S :=
           Make_Handled_Sequence_Of_Statements (Loc,
             Statements => New_List (
               Make_Block_Statement (Loc,
               Handled_Statement_Sequence => Stats)));

      else
         New_S := Stats;
      end if;

      --  At this stage we know that the new statement sequence does not
      --  have an exception handler part, so we supply one to call
      --  Exceptional_Complete_Rendezvous.

      Set_Exception_Handlers (New_S,
        New_List (
          Make_Exception_Handler (Loc,
            Exception_Choices =>
              New_List (Make_Others_Choice (Loc)),

            Statements =>  New_List (
              Make_Procedure_Call_Statement (Loc,
                Name => New_Reference_To (
                  RTE (RE_Exceptional_Complete_Rendezvous), Loc),
                Parameter_Associations => New_List (
                  Make_Function_Call (Loc,
                    Name => New_Reference_To (
                      RTE (RE_Current_Exception), Loc))))))));
      Analyze_Exception_Handlers (Exception_Handlers (New_S));

      return New_S;

   end Build_Accept_Body;

   -----------------------------------
   -- Build_Activation_Chain_Entity --
   -----------------------------------

   procedure Build_Activation_Chain_Entity (N : Node_Id) is
      P     : Node_Id;
      B     : Node_Id;
      Decls : List_Id;

   begin
      --  Loop to find enclosing construct containing activation chain variable

      P := Parent (N);

      while Nkind (P) /= N_Subprogram_Body
        and then Nkind (P) /= N_Package_Declaration
        and then Nkind (P) /= N_Package_Body
        and then Nkind (P) /= N_Block_Statement
        and then Nkind (P) /= N_Task_Body
      loop
         P := Parent (P);
      end loop;

      --  If we are in a package body, the activation chain variable is
      --  allocated in the corresponding spec. First, we save the package
      --  body node because we enter the new entity in its Declarations list.

      B := P;

      if Nkind (P) = N_Package_Body then
         P := Get_Declaration_Node (Corresponding_Spec (P));
         Decls := Declarations (B);

      elsif Nkind (P) = N_Package_Declaration then
         Decls := Visible_Declarations (Specification (B));

      else
         Decls := Declarations (B);
      end if;

      --  If activation chain entity not already declared, declare it

      if No (Activation_Chain_Entity (P)) then
         Set_Activation_Chain_Entity
           (P, Make_Defining_Identifier (Sloc (N), Name_uChain));

         Prepend_To (Decls,
           Make_Object_Declaration (Sloc (P),
             Defining_Identifier => Activation_Chain_Entity (P),
             Aliased_Present => True,
             Object_Definition   =>
               New_Reference_To (RTE (RE_Activation_Chain), Sloc (P))));

         Analyze (First (Decls));
      end if;

   end Build_Activation_Chain_Entity;

   ----------------------------
   -- Build_Barrier_Function --
   ----------------------------

   function Build_Barrier_Function
     (N    : Node_Id;
      Ent  : Entity_Id;
      Pid  : Node_Id)
      return Node_Id
   is
      Loc         : constant Source_Ptr := Sloc (N);
      Ent_Formals : constant Node_Id    := Entry_Body_Formal_Part (N);
      Index_Spec  : constant Node_Id    := Entry_Index_Specification
                                             (Ent_Formals);
      Bdef        : Entity_Id;
      Bspec       : Node_Id;
      Op_Decls    : List_Id := New_List;

   begin
      Bdef :=
        Make_Defining_Identifier (Loc, Chars (Barrier_Function (Ent)));
      Bspec := Build_Barrier_Function_Specification (Bdef, Loc);

      --  <object pointer declaration>
      --  <discriminant renamings>
      --  <private object renamings>
      --  Add discriminal and private renamings. These names have
      --  already been used to expand references to discriminants
      --  and private data.

      Add_Discriminal_Declarations (Op_Decls, Pid, Name_uObject, Loc);
      Add_Private_Declarations (Op_Decls, Pid, Name_uObject, Loc);
      Add_Object_Pointer (Op_Decls, Pid, Loc);

      --  If this is the barrier for an entry family, the entry index is
      --  visible in the body of the barrier. Create a local variable that
      --  converts the entry index (which is the last formal of the barrier
      --  function) into the appropriate offset into the entry array. The
      --  entry index constant must be set, as for the entry body, so that
      --  local references to the entry index are correctly replaced with
      --  the local variable. This parallels what is done for entry bodies.

      if Present (Index_Spec) then
         declare
            Index_Id  : constant Entity_Id := Defining_Identifier (Index_Spec);
            Index_Typ : constant Entity_Id := Etype (Index_Id);
            Index_Con : constant Entity_Id :=
              Make_Defining_Identifier (Loc, New_Internal_Name ('I'));

         begin
            Set_Entry_Index_Constant (Index_Id, Index_Con);

            Append_To (Op_Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Index_Con,
                Constant_Present => True,
                Object_Definition => New_Reference_To (Index_Typ, Loc),
                Expression =>
                  Make_Attribute_Reference (Loc,
                    Prefix => New_Reference_To (Index_Typ, Loc),
                    Attribute_Name => Name_Val,
                    Expressions => New_List (
                      Make_Op_Add (Loc,
                        Left_Opnd => Make_Op_Subtract (Loc,
                          Left_Opnd => Make_Identifier (Loc, Name_uE),
                          Right_Opnd =>
                            Entry_Index_Expression (Loc,
                              Defining_Identifier (N), Empty, Pid)),

                        Right_Opnd =>
                          Make_Attribute_Reference (Loc,
                            Prefix => New_Reference_To (Index_Typ, Loc),
                            Attribute_Name => Name_Pos,
                            Expressions => New_List (
                              Make_Attribute_Reference (Loc,
                                Prefix => New_Reference_To (Index_Typ, Loc),
                                Attribute_Name => Name_First))))))));
         end;
      end if;

      return
        Make_Subprogram_Body (Loc,
          Specification => Bspec,
          Declarations => Op_Decls,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc,
              Statements => New_List (
                Make_Return_Statement (Loc,
                  Expression => Condition (Ent_Formals)))));
   end Build_Barrier_Function;

   ------------------------------------------
   -- Build_Barrier_Function_Specification --
   ------------------------------------------

   function Build_Barrier_Function_Specification
     (Def_Id : Entity_Id;
      Loc    : Source_Ptr)
      return   Node_Id
   is
   begin
      return Make_Function_Specification (Loc,
        Defining_Unit_Name => Def_Id,
        Parameter_Specifications => New_List (
          Make_Parameter_Specification (Loc,
            Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO),
            Parameter_Type =>
              New_Reference_To (RTE (RE_Address), Loc)),

          Make_Parameter_Specification (Loc,
            Defining_Identifier => Make_Defining_Identifier (Loc, Name_uE),
            Parameter_Type =>
              New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),

        Subtype_Mark => New_Reference_To (Standard_Boolean, Loc));
   end Build_Barrier_Function_Specification;

   --------------------------
   -- Build_Call_With_Task --
   --------------------------

   function Build_Call_With_Task
     (N    : Node_Id;
      E    : Entity_Id)
      return Node_Id
   is
      Loc : constant Source_Ptr := Sloc (N);

   begin
      return
        Make_Function_Call (Loc,
          Name => New_Reference_To (E, Loc),
          Parameter_Associations => New_List (Concurrent_Ref (N)));
   end Build_Call_With_Task;

   --------------------------------
   -- Build_Corresponding_Record --
   --------------------------------

   function Build_Corresponding_Record
    (N    : Node_Id;
     Ctyp : Entity_Id;
     Loc  : Source_Ptr)
     return Node_Id
   is
      Disc     : Entity_Id;
      Dlist    : List_Id;
      Rec_Ent  : constant Entity_Id :=
                   Make_Defining_Identifier
                     (Loc, New_External_Name (Chars (Ctyp), 'V'));
      Rec_Decl : Node_Id;
      Cdecls   : List_Id;

   begin
      Set_Corresponding_Record_Type (Ctyp, Rec_Ent);
      Set_Ekind (Rec_Ent, E_Record_Type);
      Set_Has_Delayed_Freeze (Rec_Ent, Has_Delayed_Freeze (Ctyp))
;
      Set_Is_Concurrent_Record_Type (Rec_Ent, True);
      Set_Corresponding_Concurrent_Type (Rec_Ent, Ctyp);
      Set_Girder_Constraint (Rec_Ent, No_Elist);
      Cdecls := New_List;

      --  Make a copy of the discriminant specifications

      if Present (Discriminant_Specifications (N)) then
         Dlist := New_List;
         Disc := First_Discriminant (Ctyp);

         while Present (Disc) loop
            Append_To (Dlist,
              Make_Discriminant_Specification (Loc,
                Defining_Identifier =>
                  Make_Defining_Identifier (Loc,
                    Chars => Chars (Disc)),
                Discriminant_Type =>
                  New_Occurrence_Of (Etype (Disc), Loc),
                Expression =>
                  New_Copy (Discriminant_Default_Value (Disc))));

            Disc := Next_Discriminant (Disc);
         end loop;

      else
         Dlist := No_List;
      end if;

      --  Now we can construct the record type declaration. Note that this
      --  record is limited, reflecting the underlying limitedness of the
      --  task or protected object that it represents, and ensuring for
      --  example that it is properly passed by reference.

      Rec_Decl :=
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => Rec_Ent,
          Discriminant_Specifications => Dlist,
          Type_Definition =>
            Make_Record_Definition (Loc,
              Component_List =>
                Make_Component_List (Loc,
                  Component_Items => Cdecls),
              Limited_Present => True));

      return Rec_Decl;
   end Build_Corresponding_Record;

   ----------------------------------
   -- Build_Entry_Count_Expression --
   ----------------------------------

   function Build_Entry_Count_Expression
     (Concurrent_Type : Node_Id;
      Component_List  : List_Id;
      Loc             : Source_Ptr)
      return            Node_Id
   is
      Eindx  : Nat;
      Ent    : Entity_Id;
      Ecount : Node_Id;
      Comp   : Node_Id;

   begin
      Ent := First_Entity (Concurrent_Type);
      Eindx := 0;

      --  Count number of non-family entries

      while Present (Ent) loop
         if Ekind (Ent) = E_Entry then
            Eindx := Eindx + 1;
         end if;

         Ent := Next_Entity (Ent);
      end loop;

      Ecount := Make_Integer_Literal (Loc, UI_From_Int (Eindx));

      --  Loop through entry families building the addition nodes

      Ent := First_Entity (Concurrent_Type);
      Comp := First (Component_List);
      while Present (Ent) loop
         if Ekind (Ent) = E_Entry_Family then
            while Chars (Ent) /= Chars (Defining_Identifier (Comp)) loop
               Comp := Next (Comp);
            end loop;

            Ecount :=
              Make_Op_Add (Loc,
                Left_Opnd  => Ecount,
                Right_Opnd =>
                  Make_Attribute_Reference (Loc,
                    Prefix => New_Reference_To (
                      Etype (Subtype_Indication (Comp)),
                      Loc),
                    Attribute_Name => Name_Length));
         end if;

         Ent := Next_Entity (Ent);
      end loop;

      return Ecount;
   end Build_Entry_Count_Expression;

   -------------------------
   -- Build_Master_Entity --
   -------------------------

   procedure Build_Master_Entity (E : Entity_Id) is
      Loc  : constant Source_Ptr := Sloc (E);
      P    : Node_Id;
      Decl : Node_Id;

   begin
      --  Nothing to do if we already built a master entity for this scope

      if Has_Master_Entity (Scope (E)) then
         return;
      end if;

      --  Otherwise first build the master entity
      --    _Master : constant Master_Id := Current_Master;
      --  and insert it just before the current declaration

      Decl :=
        Make_Object_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, Name_uMaster),
          Constant_Present => True,
          Object_Definition => New_Reference_To (RTE (RE_Master_Id), Loc),
          Expression => New_Reference_To (RTE (RE_Current_Master), Loc));

      P := Parent (E);
      Insert_Before (P, Decl);
      Analyze (Decl);
      Set_Has_Master_Entity (Scope (E));

      --  Now mark the containing scope as a task master

      while Nkind (P) /= N_Compilation_Unit loop
         P := Parent (P);

         --  If we fall off the top, we are at the outer level, and the
         --  environment task is our effective master, so nothing to mark.

         if Nkind (P) = N_Task_Body
           or else Nkind (P) = N_Block_Statement
           or else Nkind (P) = N_Subprogram_Body
         then
            Set_Is_Task_Master (P, True);
            return;
         end if;
      end loop;
   end Build_Master_Entity;

   ---------------------------
   -- Build_Protected_Entry --
   ---------------------------

   function Build_Protected_Entry
     (N    : Node_Id;
      Ent       : Entity_Id;
      Pid  : Node_Id)
      return Node_Id
   is
      Loc      : constant Source_Ptr := Sloc (N);
      Edef     : Entity_Id;
      Espec    : Node_Id;
      Op_Decls : List_Id := New_List;
      Op_Stats : List_Id;

   begin
      Edef :=
        Make_Defining_Identifier (Loc,
          Chars => Chars (Protected_Body_Subprogram (Ent)));
      Espec := Build_Protected_Entry_Specification (Edef, Empty, Loc);

      --  <object pointer declaration>
      --  Add object pointer declaration. This is needed by the
      --  discriminal and prival renamings, which should already
      --  have been inserted into the declaration list.

      Add_Object_Pointer (Op_Decls, Pid, Loc);

      Op_Stats := New_List (
         Make_Block_Statement (Loc,
           Declarations => Declarations (N),
           Handled_Statement_Sequence =>
             Handled_Statement_Sequence (N)),

         Make_Procedure_Call_Statement (Loc,
           Name =>
             New_Reference_To (
               RTE (RE_Complete_Entry_Body), Loc),

           Parameter_Associations => New_List (
             Make_Attribute_Reference (Loc,
               Prefix =>
                 Make_Selected_Component (Loc,
                   Prefix =>
                     Make_Identifier (Loc, Name_uObject),

                   Selector_Name =>
                     Make_Identifier (Loc, Name_uObject)),
                 Attribute_Name => Name_Unchecked_Access))));

      return
        Make_Subprogram_Body (Loc,
          Specification => Espec,
          Declarations => Op_Decls,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc,
              Statements => Op_Stats,
              Exception_Handlers => New_List (
                Make_Exception_Handler (Loc,
                  Exception_Choices =>
                    New_List (Make_Others_Choice (Loc)),

                  Statements =>  New_List (
                    Make_Procedure_Call_Statement (Loc,
                      Name => New_Reference_To (
                        RTE (RE_Exceptional_Complete_Entry_Body), Loc),

                      Parameter_Associations => New_List (
                        Make_Attribute_Reference (Loc,
                          Prefix =>
                            Make_Selected_Component (Loc,
                              Prefix =>
                                Make_Identifier (Loc, Name_uObject),
                              Selector_Name =>
                                Make_Identifier (Loc, Name_uObject)),
                            Attribute_Name => Name_Unchecked_Access),

                        Make_Function_Call (Loc,
                          Name => New_Reference_To (
                            RTE (RE_Current_Exception), Loc)))))))));
   end Build_Protected_Entry;

   -----------------------------------------
   -- Build_Protected_Entry_Specification --
   -----------------------------------------

   function Build_Protected_Entry_Specification
     (Def_Id : Entity_Id;
      Ent_Id : Entity_Id;
      Loc    : Source_Ptr)
      return   Node_Id
   is
      P : Entity_Id;

   begin
      P := Make_Defining_Identifier (Loc, Name_uP);

      if Present (Ent_Id) then
         Append_Elmt (P, Accept_Address (Ent_Id));
      end if;

      return Make_Procedure_Specification (Loc,
        Defining_Unit_Name => Def_Id,
        Parameter_Specifications => New_List (
          Make_Parameter_Specification (Loc,
            Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO),
            Parameter_Type =>
              New_Reference_To (RTE (RE_Address), Loc)),

          Make_Parameter_Specification (Loc,
            Defining_Identifier => P,
            Parameter_Type =>
              New_Reference_To (RTE (RE_Address), Loc)),

          Make_Parameter_Specification (Loc,
            Defining_Identifier => Make_Defining_Identifier (Loc, Name_uE),
            Parameter_Type =>
              New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))));
   end Build_Protected_Entry_Specification;

   -------------------------------------
   -- Build_Protected_Subprogram_Body --
   -------------------------------------

   function Build_Protected_Subprogram_Body
     (N         : Node_Id;
      Pid       : Node_Id;
      N_Op_Spec : Node_Id)
      return      Node_Id
   is
      Loc         : constant Source_Ptr := Sloc (N);
      Op_Spec     : Node_Id;
      Op_Def      : Entity_Id;
      Sub_Name    : Name_Id;
      P_Op_Spec   : Node_Id;
      Uactuals    : List_Id;
      Pformal     : Node_Id;
      Unprot_Call : Node_Id;
      Sub_Body    : Node_Id;

   begin
      Op_Spec := Specification (N);
      Op_Def := Defining_Unit_Name (Op_Spec);

      Sub_Name := Chars (Defining_Unit_Name (Specification (N)));

      P_Op_Spec :=
        Build_Protected_Sub_Specification (N,
          Pid, Unprotected => False);

      --  Build a list of the formal parameters of the protected
      --  version of the subprogram to use as the actual parameters
      --  of the unprotected version.

      Uactuals := New_List;
      Pformal := First (Parameter_Specifications (P_Op_Spec));

      while Present (Pformal) loop
         Append (
           Make_Identifier (Loc, Chars (Defining_Identifier (Pformal))),
           Uactuals);
         Pformal := Next (Pformal);
      end loop;

      --  Make a call to the unprotected version of the subprogram
      --  built above for use by the protected version built below.

      if Nkind (Op_Spec) = N_Function_Specification then
         Unprot_Call := Make_Return_Statement (Loc,
           Expression => Make_Function_Call (Loc,
             Name =>
               Make_Identifier (Loc,
                 Chars (Defining_Unit_Name (N_Op_Spec))),
             Parameter_Associations => Uactuals));
      else
         Unprot_Call := Make_Procedure_Call_Statement (Loc,
           Name =>
             Make_Identifier (Loc,
               Chars (Defining_Unit_Name (N_Op_Spec))),
           Parameter_Associations => Uactuals);
      end if;

      --  Wrap call in block that will be covered by an at_end handler.

      Unprot_Call := Make_Block_Statement (Loc,
        Handled_Statement_Sequence =>
          Make_Handled_Sequence_Of_Statements (Loc,
            Statements => New_List (Unprot_Call)));

      --  Make the protected subprogram body. This locks the protected
      --  object and calls the unprotected version of the subprogram.

      Sub_Body :=
        Make_Subprogram_Body (Loc,
          Declarations => Empty_List,
          Specification => P_Op_Spec,

          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc,
              Statements => New_List (
                Make_Procedure_Call_Statement (Loc,
                  Name =>
                    New_Reference_To (RTE (RE_Abort_Defer), Loc),
                  Parameter_Associations => Empty_List),

                Make_Procedure_Call_Statement (Loc,
                  Name =>
                    New_Reference_To (RTE (RE_Lock), Loc),
                  Parameter_Associations => New_List (
                    Make_Attribute_Reference (Loc,
                      Prefix =>
                        Make_Selected_Component (Loc,
                          Prefix =>
                            Make_Identifier (Loc, Name_uObject),
                        Selector_Name =>
                            Make_Identifier (Loc, Name_uObject)),
                      Attribute_Name => Name_Unchecked_Access))),
                Unprot_Call)));

      Set_Is_Protected_Subprogram_Body (Sub_Body);
      return Sub_Body;

   end Build_Protected_Subprogram_Body;

   -------------------------------------
   -- Build_Protected_Subprogram_Call --
   -------------------------------------

   function Build_Protected_Subprogram_Call
     (N        : Node_Id;
      Name     : Node_Id;
      Rec      : Node_Id;
      External : Boolean := True)
      return     Node_Id
   is
      Loc     : constant Source_Ptr := Sloc (N);
      Sub     : Entity_Id := Entity (Name);
      New_Sub : Node_Id;
      Params  : List_Id;

   begin
      --  The following assumes that the protected version of the
      --  subprogram immediately follows the unprotected one in the entity
      --  chain for their common scope. There is currently no attribute to
      --  retrieve the protected version. Should there be one???

      if External then
         New_Sub := New_Occurrence_Of (
           Next_Entity (Protected_Body_Subprogram (Sub)), Loc);
      else
         New_Sub :=
           New_Occurrence_Of (Protected_Body_Subprogram (Sub), Loc);
      end if;

      if Present (Parameter_Associations (N)) then
         Params := New_List_Copy (Parameter_Associations (N));
      else
         Params := New_List;
      end if;

      Prepend (Rec, Params);

      if Ekind (Sub) = E_Procedure then
         return Make_Procedure_Call_Statement (Loc,
           Name => New_Sub,
           Parameter_Associations => Params);

      else
         pragma Assert (Ekind (Sub) = E_Function);
         return Make_Function_Call (Loc,
           Name => New_Sub,
           Parameter_Associations => Params);
      end if;
   end Build_Protected_Subprogram_Call;

   ---------------------------------------
   -- Build_Protected_Sub_Specification --
   ---------------------------------------

   function Build_Protected_Sub_Specification
     (N           : Node_Id;
      Prottyp     : Entity_Id;
      Unprotected : Boolean := False)
      return        Node_Id
   is
      Loc         : constant Source_Ptr := Sloc (N);
      Protnm      : constant Name_Id := Chars (Prottyp);
      Spec        : constant Node_Id    := Specification (N);
      Ident       : constant Entity_Id  := Defining_Unit_Name (Spec);
      Nam         : constant Name_Id    := Chars (Ident);
      New_Plist   : constant List_Id    :=
                      Build_Protected_Spec
                        (N, Corresponding_Record_Type (Prottyp),
                         Unprotected, Ident);
      Append_Char : Character;
      New_Spec    : Node_Id;

   begin
      if Unprotected then
         Append_Char := 'N';
      else
         Append_Char := 'P';
      end if;

      if Nkind (Spec) = N_Procedure_Specification then
         return
           Make_Procedure_Specification (Loc,
             Defining_Unit_Name =>
               Make_Defining_Identifier (Loc,
                 Chars => Build_Selected_Name (Protnm, Nam, Append_Char)),
             Parameter_Specifications => New_Plist);

      else
         New_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name =>
               Make_Defining_Identifier (Loc,
                 Chars => Build_Selected_Name (Protnm, Nam, Append_Char)),
             Parameter_Specifications => New_Plist,
             Subtype_Mark => New_Copy (Subtype_Mark (Spec)));
         Set_Return_Present (Defining_Unit_Name (New_Spec));
         return New_Spec;
      end if;
   end Build_Protected_Sub_Specification;

   --------------------------
   -- Build_Protected_Spec --
   --------------------------

   function Build_Protected_Spec
     (N           : Node_Id;
      Obj_Type    : Entity_Id;
      Unprotected : Boolean := False;
      Ident       : Entity_Id)
      return        List_Id
   is
      Loc         : constant Source_Ptr := Sloc (N);
      Formal      : Entity_Id;
      New_Plist   : List_Id;
      New_Param   : Node_Id;

   begin
      New_Plist := New_List;
      Formal := First_Formal (Ident);

      while Present (Formal) loop
         New_Param :=
           Make_Parameter_Specification (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Sloc (Formal), Chars (Formal)),
             In_Present => In_Present (Parent (Formal)),
             Out_Present => Out_Present (Parent (Formal)),
             Parameter_Type =>
               New_Reference_To (Etype (Formal), Loc));

         if Unprotected then
            Set_Protected_Formal (Formal, Defining_Identifier (New_Param));
         end if;

         Append (New_Param, New_Plist);
         Formal := Next_Formal (Formal);
      end loop;

      --  If the subprogram is a procedure and the context is not an access
      --  to protected subprogram, the parameter is in-out. Otherwise it is
      --  an in parameter.

      Prepend_To (New_Plist,
        Make_Parameter_Specification (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, Name_uObject),
          In_Present => True,
          Out_Present =>
           (Etype (Ident) = Standard_Void_Type
              and then Obj_Type /= RTE (RE_Address)),
          Parameter_Type => New_Reference_To (Obj_Type, Loc)));

      return New_Plist;
   end Build_Protected_Spec;

   -------------------------
   -- Build_Selected_Name --
   -------------------------

   function Build_Selected_Name
     (Prefix, Selector : Name_Id;
      Append_Char      : Character := ' ')
      return             Name_Id
   is
      Select_Buffer : String (1 .. Hostparm.Max_Name_Length);
      Select_Len    : Natural;

   begin
      Get_Name_String (Selector);
      Select_Len := Name_Len;
      Select_Buffer (1 .. Select_Len) := Name_Buffer (1 .. Name_Len);
      Get_Name_String (Prefix);

      --  If scope is anonymous type, discard suffix to recover name of
      --  single protected object. Otherwise use protected type name.

      if Name_Buffer (Name_Len) = 'T' then
         Name_Len := Name_Len - 1;
      end if;

      Name_Buffer (Name_Len + 1) := 'P';
      Name_Buffer (Name_Len + 2) := 'T';
      Name_Buffer (Name_Len + 3) := '_';
      Name_Buffer (Name_Len + 4) := '_';

      Name_Len := Name_Len + 4;
      for J in 1 .. Select_Len loop
         Name_Len := Name_Len + 1;
         Name_Buffer (Name_Len) := Select_Buffer (J);
      end loop;

      if Append_Char /= ' ' then
         Name_Len := Name_Len + 1;
         Name_Buffer (Name_Len) := Append_Char;
      end if;

      return Name_Find;
   end Build_Selected_Name;

   -----------------------------
   -- Build_Simple_Entry_Call --
   -----------------------------

   --  A task entry call is converted to a call to Call_Simple

   --    declare
   --       P : parms := (parm, parm, parm);
   --    begin
   --       Call_Simple (acceptor-task, entry-index, P'Address);
   --       parm := P.param;
   --       parm := P.param;
   --       ...
   --    end;

   --  Here Pnn is an aggregate of the type constructed for the entry to hold
   --  the parameters, and the constructed aggregate value contains either the
   --  parameters or, in the case of non-elementary types, references to these
   --  parameters. Then the address of this aggregate is passed to the runtime
   --  routine, along with the task id value and the task entry index value.
   --  Pnn is only required if parameters are present.

   --  The assignments after the call are present only in the case of in-out
   --  or out parameters for elementary types, and are used to assign back the
   --  resulting values of such parameters.

   --  Note: the reason that we insert a block here is that in the context
   --  of selects, conditional entry calls etc. the entry call statement
   --  appears on its own, not as an element of a list.

   --  A protected entry call is converted to a Protected_Entry_Call:

   --  declare
   --     P   : E1_Params := (param, param, param);
   --     Pnn : Boolean;
   --     Bnn : Communications_Block;

   --  declare
   --     P   : E1_Params := (param, param, param);
   --     Bnn : Communications_Block;

   --  begin
   --     Protected_Entry_Call (
   --       Object => po._object'Access,
   --       E => <entry index>;
   --       Uninterpreted_Data => P'Address;
   --       Mode => Simple_Call;
   --       Block => Bnn);
   --     parm := P.param;
   --     parm := P.param;
   --       ...
   --  end;

   procedure Build_Simple_Entry_Call
     (N       : Node_Id;
      Concval : Node_Id;
      Ename   : Node_Id;
      Index   : Node_Id)
   is
   begin
      Expand_Call (N);

      --  Convert entry call to Call_Simple call

      declare
         Loc       : constant Source_Ptr := Sloc (N);
         Parms     : constant List_Id    := Parameter_Associations (N);
         Pdecl     : Node_Id;
         Xdecl     : Node_Id;
         Decls     : List_Id;
         Conctyp   : Node_Id;
         Ent       : Entity_Id;
         Ent_Acc   : Entity_Id;
         P         : Entity_Id;
         X         : Entity_Id;
         Plist     : List_Id;
         Parm1     : Node_Id;
         Parm2     : Node_Id;
         Parm3     : Node_Id;
         Call      : Node_Id;
         Actual    : Node_Id;
         Formal    : Node_Id;
         N_Node    : Node_Id;
         N_Var     : Node_Id;
         Stats     : List_Id := New_List;
         Comm_Name : Entity_Id;

      begin
         --  Simple entry and entry family cases merge here

         Ent     := Entity (Ename);
         Ent_Acc := Entry_Parameters_Type (Ent);
         Conctyp := Etype (Concval);

         --  If prefix is an access type, dereference to obtain the task type

         if Is_Access_Type (Conctyp) then
            Conctyp := Designated_Type (Conctyp);
         end if;

         --  Special case for protected subprogram calls.

         if Is_Protected_Type (Conctyp)
           and then Is_Subprogram (Entity (Ename))
         then
            Rewrite_Substitute_Tree (N,
              Build_Protected_Subprogram_Call
                (N, Ename, Convert_Concurrent (Concval, Conctyp)));
            Analyze (N);
            return;
         end if;

         --  First parameter is the Task_Id value from the task value or the
         --  Object from the protected object value, obtained by selecting
         --  the _Task_Id or _Object from the result of doing an unchecked
         --  conversion to convert the value to the corresponding record type.

         Parm1 := Concurrent_Ref (Concval);

         --  Second parameter is the entry index, computed by the routine
         --  provided for this purpose. The value of this expression is
         --  assigned to an intermediate variable to assure that any entry
         --  family index expressions are evaluated before the entry
         --  parameters.

         X := Make_Defining_Identifier (Loc, Name_uX);

         Xdecl :=
           Make_Object_Declaration (Loc,
             Defining_Identifier => X,
             Object_Definition =>
               New_Reference_To (RTE (RE_Task_Entry_Index), Loc),
             Expression =>
               Entry_Index_Expression (Loc, Entity (Ename), Index, Conctyp));

         Decls := New_List (Xdecl);
         Parm2 := New_Reference_To (X, Loc);

         --  The third parameter is the packaged parameters. If there are
         --  none, then it is just the null address, since nothing is passed

         if No (Parms) then
            Parm3 := New_Reference_To (RTE (RE_Null_Address), Loc);

         --  Case of parameters present, where third argument is the address
         --  of a packaged record containing the required parameter values.

         else
            --  First build a list of parameter values, which are
            --  references to objects of the parameter types.

            Plist := New_List;

            Actual := First_Actual (N);
            Formal := First_Formal (Ent);

            while Present (Actual) loop

               --  If it is a by_copy_type, copy it to a new variable. The
               --  packaged record has a field that points to this variable.

               if Is_By_Copy_Type (Etype (Actual)) then
                  N_Node :=
                    Make_Object_Declaration (Loc,
                      Defining_Identifier =>
                        Make_Defining_Identifier (Loc,
                          Chars => New_Internal_Name ('I')),
                      Aliased_Present => True,
                      Object_Definition =>
                        New_Reference_To (Etype (Formal), Loc));

                  --  We have to make an assignment statement separate for
                  --  the case of limited type. We can not assign it unless
                  --  the Assignment_OK flag is set first.

                  if Ekind (Formal) /= E_Out_Parameter then
                     N_Var :=
                       New_Reference_To (Defining_Identifier (N_Node), Loc);
                     Set_Assignment_OK (N_Var);
                     Append_To (Stats,
                       Make_Assignment_Statement (Loc,
                         Name => N_Var,
                         Expression => New_Copy (Actual)));
                  end if;

                  Append (N_Node, Decls);

                  Append_To (Plist,
                    Make_Attribute_Reference (Loc,
                      Attribute_Name => Name_Unchecked_Access,
                    Prefix =>
                      New_Reference_To (Defining_Identifier (N_Node), Loc)));
               else
                  Append_To (Plist,
                    Make_Reference (Loc, Prefix => New_Copy (Actual)));
               end if;

               Actual := Next_Actual (Actual);
               Formal := Next_Formal_With_Extras (Formal);
            end loop;

            --  Now build the declaration of parameters initialized with the
            --  aggregate containing this constructed parameter list.

            P := Make_Defining_Identifier (Loc, Name_uP);

            Pdecl :=
              Make_Object_Declaration (Loc,
                Defining_Identifier => P,
                Object_Definition =>
                  New_Reference_To (Designated_Type (Ent_Acc), Loc),
                Expression =>
                  Make_Aggregate (Loc, Expressions => Plist));

            Parm3 :=
              Make_Attribute_Reference (Loc,
                Attribute_Name => Name_Address,
                Prefix => New_Reference_To (P, Loc));

            Append (Pdecl, Decls);
         end if;

         --  Now we can create the call

         if Is_Protected_Type (Conctyp) then

            --  Change they type of the index declaration.

            Set_Object_Definition (Xdecl,
              New_Reference_To (RTE (RE_Protected_Entry_Index), Loc));

            --  Some additional declarations for protected entry calls.

            if No (Decls) then
               Decls := New_List;
            end if;

            --  Bnn : Communications_Block;

            Comm_Name :=
              Make_Defining_Identifier (Loc, New_Internal_Name ('B'));

            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Comm_Name,
                Object_Definition =>
                  New_Reference_To (RTE (RE_Communication_Block), Loc)));

            --  Some additional statements for protected entry calls.

            --     Protected_Entry_Call (
            --       Object => po._object'Access,
            --       E => <entry index>;
            --       Uninterpreted_Data => P'Address;
            --       Mode => Simple_Call;
            --       Block => Bnn);

            Call :=
              Make_Procedure_Call_Statement (Loc,
                Name =>
                  New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),

                Parameter_Associations => New_List (
                  Make_Attribute_Reference (Loc,
                    Attribute_Name => Name_Unchecked_Access,
                    Prefix         => Parm1),
                  Parm2,
                  Parm3,
                  New_Reference_To (RTE (RE_Simple_Call), Loc),
                  New_Occurrence_Of (Comm_Name, Loc)));

         else
            Call :=
              Make_Procedure_Call_Statement (Loc,
                Name => New_Reference_To (RTE (RE_Call_Simple), Loc),
                Parameter_Associations => New_List (Parm1, Parm2, Parm3));

         end if;

         Append_To (Stats, Call);

         --  If there are out or in/out parameters by copy
         --  add assignment statements for the result values.

         if Present (Parms) then
            Actual := First_Actual (N);
            Formal := First_Formal (Ent);

            Set_Assignment_OK (Actual);
            while Present (Actual) loop
               if Is_By_Copy_Type (Etype (Actual))
                 and then Ekind (Formal) /= E_In_Parameter
               then
                  N_Node :=
                    Make_Assignment_Statement (Loc,
                      Name => New_Copy (Actual),
                      Expression =>
                        Make_Explicit_Dereference (Loc,
                          Make_Selected_Component (Loc,
                            Prefix => New_Reference_To (P, Loc),
                            Selector_Name =>
                              Make_Identifier (Loc, Chars (Formal)))));

                  --  In all cases (including limited private types) we
                  --  want the assignment to be valid.

                  Set_Assignment_OK (Name (N_Node));

                  --  If the call is the triggering alternative in an
                  --  asynchronous select, or the entry_call alternative
                  --  of a conditional entry call, the assignments for in-out
                  --  parameters are incorporated into the statement list
                  --  that follows, so that there are executed only if the
                  --  entry call succeeds.

                  if (Nkind (Parent (N)) = N_Triggering_Alternative
                       and then N = Triggering_Statement (Parent (N)))
                    or else
                     (Nkind (Parent (N)) = N_Entry_Call_Alternative
                       and then N = Entry_Call_Statement (Parent (N)))
                  then
                     if No (Statements (Parent (N))) then
                        Set_Statements (Parent (N), New_List);
                     end if;

                     Prepend (N_Node, Statements (Parent (N)));

                  else
                     Insert_After (Call, N_Node);
                  end if;
               end if;

               Actual := Next_Actual (Actual);
               Formal := Next_Formal_With_Extras (Formal);
            end loop;
         end if;

         --  Finally, create block and analyze it

         Rewrite_Substitute_Tree (N,
           Make_Block_Statement (Loc,
             Declarations => Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Stats)));

         Analyze (N);
      end;

   end Build_Simple_Entry_Call;

   --------------------------------
   -- Build_Task_Activation_Call --
   --------------------------------

   procedure Build_Task_Activation_Call (N : Node_Id) is
      Loc   : constant Source_Ptr := Sloc (N);
      Chain : Entity_Id;
      Call  : Node_Id;
      P     : Node_Id;

   begin
      --  Get the activation chain entity. Except in the case of a package
      --  body, this is in the node that was passed. For a package body,we
      --  have to find the corresponding package declaration node.

      if Nkind (N) = N_Package_Body then
         P := Corresponding_Spec (N);

         loop
            P := Parent (P);
            exit when Nkind (P) = N_Package_Declaration;
         end loop;

         Chain := Activation_Chain_Entity (P);

      else
         Chain := Activation_Chain_Entity (N);
      end if;

      if Present (Chain) then
         Call :=
           Make_Procedure_Call_Statement (Loc,
             Name => New_Reference_To (RTE (RE_Activate_Tasks), Loc),
             Parameter_Associations =>
               New_List (Make_Attribute_Reference (Loc,
                 Prefix => New_Occurrence_Of (Chain, Loc),
                 Attribute_Name => Name_Unchecked_Access)));

         if Nkind (N) = N_Package_Declaration then
            if Present (Corresponding_Body (N)) then
               null;

            elsif Present (Private_Declarations (Specification (N))) then
               Append (Call, Private_Declarations (Specification (N)));

            else
               Append (Call, Visible_Declarations (Specification (N)));
            end if;

         elsif Present (Handled_Statement_Sequence (N)) then
            Prepend (Call, Statements (Handled_Statement_Sequence (N)));

         else
            Set_Handled_Statement_Sequence (N,
               Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => New_List (Call)));
         end if;

         Analyze (Call);
      end if;

   end Build_Task_Activation_Call;

   -------------------------------
   -- Build_Task_Allocate_Block --
   -------------------------------

   procedure Build_Task_Allocate_Block
     (Actions : List_Id;
      N       : Node_Id;
      Args    : List_Id)
   is
      T    : constant Entity_Id  := Entity (Expression (N));
      Init : constant Entity_Id  := Base_Init_Proc (T);
      Loc  : constant Source_Ptr := Sloc (N);

      Chain  : Entity_Id := Make_Defining_Identifier (Loc, Name_uChain);
      Blkent : Entity_Id;
      Block  : Node_Id;

   begin
      Blkent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));

      Block :=
        Make_Block_Statement (Loc,
          Identifier => New_Reference_To (Blkent, Loc),
          Declarations => New_List (

            --  _Chain  : Activation_Chain;

            Make_Object_Declaration (Loc,
              Defining_Identifier => Chain,
              Aliased_Present => True,
              Object_Definition   =>
                New_Reference_To (RTE (RE_Activation_Chain), Loc))),

          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc,

              Statements => New_List (

               --  Init (Args);

                Make_Procedure_Call_Statement (Loc,
                  Name => New_Reference_To (Init, Loc),
                  Parameter_Associations => Args),

               --  Activate_Tasks (_Chain);

                Make_Procedure_Call_Statement (Loc,
                  Name => New_Reference_To (RTE (RE_Activate_Tasks), Loc),
                  Parameter_Associations => New_List (
                    Make_Attribute_Reference (Loc,
                      Prefix => New_Reference_To (Chain, Loc),
                      Attribute_Name => Name_Unchecked_Access))))),

          Has_Created_Identifier => True,
          Is_Task_Allocation_Block => True);

      Append_To (Actions,
        Make_Implicit_Label_Declaration (Loc,
          Defining_Identifier => Blkent));

      Append_To (Actions, Block);

      Set_Activation_Chain_Entity (Block, Chain);

   end Build_Task_Allocate_Block;

   -----------------------------------
   -- Build_Task_Proc_Specification --
   -----------------------------------

   function Build_Task_Proc_Specification (T : Entity_Id) return Node_Id is
      Loc : constant Source_Ptr := Sloc (T);
      Nam : constant Name_Id    := Chars (T);
      Ent : Entity_Id;

   begin
      Ent :=
        Make_Defining_Identifier (Loc,
          Chars => New_External_Name (Nam, 'B'));
      Set_Is_Internal (Ent);
      Set_Task_Body_Procedure (T, Ent);

      return
        Make_Procedure_Specification (Loc,
          Defining_Unit_Name       => Ent,
          Parameter_Specifications =>
            New_List (
              Make_Parameter_Specification (Loc,
                Defining_Identifier =>
                  Make_Defining_Identifier (Loc, Name_uTask),
                Parameter_Type =>
                  Make_Access_Definition (Loc,
                    Subtype_Mark =>
                      New_Reference_To
                        (Corresponding_Record_Type (T), Loc)))));

   end Build_Task_Proc_Specification;

   ---------------------------------------
   -- Build_Unprotected_Subprogram_Body --
   ---------------------------------------

   function Build_Unprotected_Subprogram_Body
     (N    : Node_Id;
      Pid  : Node_Id)
      return Node_Id
   is
      Loc       : constant Source_Ptr := Sloc (N);
      Sub_Name  : Name_Id;
      N_Op_Spec : Node_Id;
      Op_Decls  : List_Id;

   begin
      --  Make an unprotected version of the subprogram for use
      --  within the same object, with a new name and an additional
      --  parameter representing the object.

      Op_Decls := Declarations (N);
      Sub_Name := Chars (Defining_Unit_Name (Specification (N)));

      N_Op_Spec :=
        Build_Protected_Sub_Specification
          (N, Pid, Unprotected => True);

      return
        Make_Subprogram_Body (Loc,
          Specification => N_Op_Spec,
          Declarations => Op_Decls,
          Handled_Statement_Sequence =>
            Handled_Statement_Sequence (N));

   end Build_Unprotected_Subprogram_Body;

   ----------------------------
   -- Collect_Entry_Families --
   ----------------------------

   procedure Collect_Entry_Families
     (Loc          : Source_Ptr;
      Cdecls       : List_Id;
      Current_Node : in out Node_Id;
      Conctyp      : Entity_Id)
   is
      Efam      : Entity_Id;
      Efam_Decl : Node_Id;
      Efam_Type : Entity_Id;

   begin
      Efam := First_Entity (Conctyp);

      while Present (Efam) loop

         if Ekind (Efam) = E_Entry_Family then
            Efam_Type :=
              Make_Defining_Identifier (Loc,
                Chars => New_Internal_Name ('F'));

            Efam_Decl :=
              Make_Full_Type_Declaration (Loc,
                Defining_Identifier => Efam_Type,
                Type_Definition =>
                  Make_Constrained_Array_Definition (Loc,
                    Discrete_Subtype_Definitions => (New_List (
                      New_Occurrence_Of
                       (Etype
                         (Discrete_Subtype_Definition
                           (Parent (Efam))), Loc))),

                    Subtype_Indication =>
                      New_Reference_To (Standard_Character, Loc)));

            Insert_After (Current_Node, Efam_Decl);
            Current_Node := Efam_Decl;
            Analyze (Efam_Decl);

            Append_To (Cdecls,
              Make_Component_Declaration (Loc,
                Defining_Identifier =>
                  Make_Defining_Identifier (Sloc (Efam), Chars (Efam)),
                Subtype_Indication => New_Occurrence_Of (Efam_Type, Loc)));
         end if;

         Efam := Next_Entity (Efam);
      end loop;
   end Collect_Entry_Families;

   --------------------
   -- Concurrent_Ref --
   --------------------

   --  The expression returned for a reference to a concurrent
   --  object has the form:

   --    taskV!(name)._Task_Id

   --  for a task, and

   --    objectV!(name)._Object

   --  for a protected object.

   --  For the case of an access to a concurrent object,
   --  there is an extra explicit dereference:

   --    taskV!(name.all)._Task_Id
   --    objectV!(name.all)._Object

   --  here taskV and objectV are the types for the associated records, which
   --  contain the required _Task_Id and _Object fields for tasks and
   --  protected objects, respectively.

   --  For the case of a task type name, the expression is

   --    Self;

   --  i.e. a call to the Self function which returns precisely this Task_Id

   --  For the case of a protected type name, the expression is

   --    objectR

   --  which is a renaming of the _object field of the current object
   --  object record, passed into protected operations as a parameter.

   function Concurrent_Ref (N : Node_Id) return Node_Id is
      Loc  : constant Source_Ptr := Sloc (N);
      Ntyp : constant Entity_Id  := Etype (N);
      Dtyp : Entity_Id;
      Sel  : Name_Id;

      function Is_Current_Task (T : Entity_Id) return Boolean;
      --  Check whether the reference is to the immediately enclosing task
      --  type, or to an outer one (rare but legal).

      function Is_Current_Task (T : Entity_Id) return Boolean is
         Scop : Entity_Id;

      begin
         Scop := Current_Scope;
         while Present (Scop)
           and then Scop /= Standard_Standard
         loop

            if Scop = T then
               return True;

            elsif Is_Task_Type (Scop) then
               return False;

            else
               Scop := Scope (Scop);
            end if;
         end loop;

         --  We know that we are within the task body, so should have
         --  found it in scope.

         pragma Assert (False);
         raise Program_Error;
      end Is_Current_Task;

   --  Start of processing for Concurrent_Ref

   begin
      if Is_Access_Type (Ntyp) then
         Dtyp := Designated_Type (Ntyp);

         if Is_Protected_Type (Dtyp) then
            Sel := Name_uObject;
         else
            Sel := Name_uTask_Id;
         end if;

         return
           Make_Selected_Component (Loc,
             Prefix =>
               Unchecked_Convert_To (Corresponding_Record_Type (Dtyp),
                 Make_Explicit_Dereference (Loc, N)),
             Selector_Name => Make_Identifier (Loc, Sel));

      elsif Is_Entity_Name (N)
        and then Is_Concurrent_Type (Entity (N))
      then
         if Is_Task_Type (Entity (N)) then

            if Is_Current_Task (Entity (N)) then
               return
                 Make_Function_Call (Loc,
                   Name => New_Reference_To (RTE (RE_Self), Loc));

            else
               declare
                  Decl   : Node_Id;
                  T_Self : constant Entity_Id
                    := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
                  T_Body : constant Node_Id
                    := Parent (Corresponding_Body (Parent (Entity (N))));

               begin
                  Decl := Make_Object_Declaration (Loc,
                     Defining_Identifier => T_Self,
                     Object_Definition =>
                       New_Occurrence_Of (RTE (RO_ST_Task_ID), Loc),
                     Expression =>
                       Make_Function_Call (Loc,
                         Name => New_Reference_To (RTE (RE_Self), Loc)));
                  Prepend (Decl, Declarations (T_Body));
                  Analyze (Decl);
                  Set_Scope (T_Self, Entity (N));
                  return New_Occurrence_Of (T_Self,  Loc);
               end;
            end if;

         else
            pragma Assert (Is_Protected_Type (Entity (N)));
            return
              New_Reference_To (
                Object_Ref (Corresponding_Body (Parent (Base_Type (Ntyp)))),
                Loc);
         end if;

      else
         pragma Assert (Is_Concurrent_Type (Ntyp));

         if Is_Protected_Type (Ntyp) then
            Sel := Name_uObject;
         else
            Sel := Name_uTask_Id;
         end if;

         return
           Make_Selected_Component (Loc,
             Prefix =>
               Unchecked_Convert_To (Corresponding_Record_Type (Ntyp),
                 New_Copy_Tree (N)),
             Selector_Name => Make_Identifier (Loc, Sel));
      end if;
   end Concurrent_Ref;

   ------------------------
   -- Convert_Concurrent --
   ------------------------

   function Convert_Concurrent
     (N    : Node_Id;
      Typ  : Entity_Id)
      return Node_Id
   is
      Loc : constant Source_Ptr := Sloc (N);

   begin
      if not Is_Concurrent_Type (Typ) then
         return N;
      else
         return
           Unchecked_Convert_To (Corresponding_Record_Type (Typ),
             New_Copy_Tree (N));
      end if;
   end Convert_Concurrent;

   ----------------------------
   -- Entry_Index_Expression --
   ----------------------------

   function Entry_Index_Expression
     (Sloc  : Source_Ptr;
      Ent   : Entity_Id;
      Index : Node_Id;
      Ttyp  : Entity_Id)
      return  Node_Id
   is
      Expr : Node_Id;
      Num  : Node_Id;
      Prev : Entity_Id;
      S    : Node_Id;
      Trec : Node_Id := Corresponding_Record_Type (Ttyp);

   begin
      --  The queues of entries and entry families appear in  textual
      --  order in the associated record. The entry index is computed as
      --  the sum of the number of queues for all entries that precede the
      --  designated one, to which is added the index expression, if this
      --  expression denotes a member of a family.

      --  The following is a place holder for the count of simple entries.

      Num := Make_Integer_Literal (Sloc, Uint_1);

      --  We construct an expression which is a series of addition
      --  operations. The first operand is the number of single entries that
      --  precede this one, the second operand is the index value relative
      --  to the start of the referenced family, and the remaining operands
      --  are the lengths of the entry families that precede this entry, i.e.
      --  the constructed expression is:

      --    number_simple_entries +
      --      (s'pos (index-value) - s'pos (family'first)) + 1 +
      --      family'length + ...

      --  where index-value is the given index value, and s is the index
      --  subtype (we have to use pos because the subtype might be an
      --  enumeration type preventing direct subtraction).
      --  Note that the task entry array is one-indexed.

      if Present (Index) then
         S := Etype (Discrete_Subtype_Definition (Declaration_Node (Ent)));

         Expr :=
           Make_Op_Add (Sloc,
             Left_Opnd  => Num,

             Right_Opnd =>
               Make_Op_Subtract (Sloc,
                 Left_Opnd =>
                   Make_Attribute_Reference (Sloc,
                     Attribute_Name => Name_Pos,
                     Prefix => New_Reference_To (S, Sloc),
                     Expressions => New_List (New_Copy (Index))),

                 Right_Opnd =>
                   Make_Attribute_Reference (Sloc,
                     Attribute_Name => Name_Pos,
                     Prefix => New_Reference_To (S, Sloc),
                     Expressions => New_List (
                       Make_Attribute_Reference (Sloc,
                         Prefix => New_Reference_To (S, Sloc),
                         Attribute_Name => Name_First)))));
      else
         Expr := Num;
      end if;

      --  Now add lengths of preceding entries and entry families.

      Prev := First_Entity (Ttyp);

      while Chars (Prev) /= Chars (Ent)
        or else (Ekind (Prev) /= Ekind (Ent))
        or else not Sem_Ch6.Type_Conformant (Ent, Prev)
      loop
         if Ekind (Prev) = E_Entry then
            Set_Intval (Num, Intval (Num) + 1);

         elsif Ekind (Prev) = E_Entry_Family then
            Expr :=
              Make_Op_Add (Sloc,
              Left_Opnd  => Expr,
              Right_Opnd =>
                Make_Attribute_Reference (Sloc,
                  Attribute_Name => Name_Length,
                  Prefix => New_Reference_To (Array_Type (Prev, Trec), Sloc)));

         --  Other components are anonymous types to be ignored.

         else
            null;
         end if;

         Prev := Next_Entity (Prev);
      end loop;

      return Expr;
   end Entry_Index_Expression;

   ----------------------------
   -- Entry_Range_Expression --
   ----------------------------

   function Entry_Range_Expression
     (Sloc  : Source_Ptr;
      Ent   : Entity_Id;
      Ttyp  : Entity_Id)
      return  Node_Id
   is
      Trec   : constant Node_Id := Corresponding_Record_Type (Ttyp);
      Right  : Node_Id;
      Left   : Node_Id;
      Scount : Node_Id;
      Fcount : Node_Id;
      Prev   : Entity_Id;

   begin
      --  The following is a place holder for the count of simple entries.

      Scount := Make_Integer_Literal (Sloc, Uint_1);
      Fcount := Make_Integer_Literal (Sloc, Uint_0);

      Prev := First_Entity (Ttyp);

      while Chars (Prev) /= Chars (Ent) loop

         if Ekind (Prev) = E_Entry then
            Set_Intval (Scount, Intval (Scount) + 1);

         elsif Ekind (Prev) = E_Entry_Family then
            Fcount :=
              Make_Op_Add (Sloc,
              Left_Opnd  => Fcount,
              Right_Opnd =>
                Make_Attribute_Reference (Sloc,
                  Attribute_Name => Name_Length,
                  Prefix => New_Reference_To (Array_Type (Prev, Trec), Sloc)));

         --  Other components are anonymous types to be ignored.

         else
            null;
         end if;

         Prev := Next_Entity (Prev);
      end loop;

      Left :=
        Make_Op_Add (Sloc,
          Left_Opnd => Scount,
          Right_Opnd => Fcount);

      Right :=
        Make_Op_Add (Sloc,
          Left_Opnd => New_Copy_Tree (Left),
          Right_Opnd =>
            Make_Op_Subtract (Sloc,
              Left_Opnd => Make_Attribute_Reference (Sloc,
                Attribute_Name => Name_Length,
                Prefix => New_Reference_To (Array_Type (Prev, Trec), Sloc)),
              Right_Opnd => Make_Integer_Literal (Sloc, Uint_1)));

      return
        Make_Range (Sloc,
          Low_Bound => Left,
          High_Bound => Right);

   end Entry_Range_Expression;

   ---------------------------
   -- Establish_Task_Master --
   ---------------------------

   procedure Establish_Task_Master (N : Node_Id) is
      Call : Node_Id;

   begin
      Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
      Prepend_To (Declarations (N), Call);
      Analyze (Call);
   end Establish_Task_Master;

   --------------------------------
   -- Expand_Accept_Declarations --
   --------------------------------

   --  Part of the expansion of an accept statement involves the creation of
   --  a declaration that can be referenced from the statement sequence of
   --  the accept:

   --    Ann : Address;

   --  This declaration is inserted immediately before the accept statement
   --  and it is important that it be inserted before the statements of the
   --  statement sequence are analyzed. Thus it would be too late to create
   --  this declaration in the Expand_N_Accept_Statement routine, which is
   --  why there is a separate procedure to be called directly from Sem_Ch9.

   --  It is used to hold the address of the record containing the parameters
   --  (see Expand_N_Entry_Call for more details on how this record is built).
   --  References to the parameters do an unchecked conversion of this address
   --  to a pointer to the required record type, and then access the field that
   --  holds the value of the required parameter. The entity for the address
   --  variable is held as the top stack element (i.e. the last element) of the
   --  Accept_Address stack in the corresponding entry entity, and this element
   --  must be set in place  before the statements are processed.

   --  The above description applies to the case of a stand alone accept
   --  statement, i.e. one not appearing as part of a select alternative.

   --  For the case of an accept that appears as part of a select alternative
   --  of a selective accept, we must still create the declaration right away,
   --  since Ann is needed immediately, but there is an important difference:

   --    The declaration is inserted before the selective accept, not before
   --    the accept statement (which is not part of a list anyway, and so would
   --    not accommodate inserted declarations)

   --    We only need one address variable for the entire selective accept. So
   --    the Ann declaration is created only for the first accept alternative,
   --    and subsequent accept alternatives reference the same Ann variable.

   --  We can distinguish the two cases by seeing whether the accept statement
   --  is part of a list. If not, then it must be in an accept alternative.

   --  To expand the requeue statement, a label is provided at the end of
   --  the accept statement or alternative of which it is a part, so that
   --  the statement can be skipped after the requeue is complete.
   --  This label is created here rather than during the expansion of the
   --  accept statement, because it will be needed by any requeue
   --  statements within the accept, which are expanded before the
   --  accept.

   procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id) is
      Loc    : constant Source_Ptr := Sloc (N);
      Ttyp   : constant Entity_Id  := Scope (Ent);
      Ann    : Entity_Id := Empty;
      Adecl  : Node_Id;
      Lab_Id : Node_Id;
      Lab    : Node_Id;
      Ldecl  : Node_Id;

   begin
      if Expander_Active then

         --  Create and declare a label to be placed at the end of the
         --  accept statement. This is used to allow requeues to skip
         --  the remainder of entry processing.

         if Present (Handled_Statement_Sequence (N)) then
            Lab_Id := Make_Identifier (Loc, New_Internal_Name ('L'));
            Set_Entity (Lab_Id,
              Make_Defining_Identifier (Loc, Chars (Lab_Id)));
            Lab := Make_Label (Loc, Lab_Id);
            Ldecl :=
              Make_Implicit_Label_Declaration (Loc,
                Defining_Identifier  => Entity (Lab_Id));
            Append (Lab, Statements (Handled_Statement_Sequence (N)));
         end if;

         --  Case of stand alone accept statement

         if Is_List_Member (N) then

            if Present (Handled_Statement_Sequence (N)) then
               Ann :=
                 Make_Defining_Identifier (Loc,
                   Chars => New_Internal_Name ('A'));

               Adecl :=
                 Make_Object_Declaration (Loc,
                   Defining_Identifier => Ann,
                   Object_Definition =>
                     New_Reference_To (RTE (RE_Address), Loc));

               Insert_Before (N, Adecl);
               Analyze (Adecl);

               Insert_Before (N, Ldecl);
               Analyze (Ldecl);
            end if;

         --  Case of accept statement which is in an accept alternative

         else
            declare
               Acc_Alt : constant Node_Id := Parent (N);
               Sel_Acc : constant Node_Id := Parent (Acc_Alt);
               Alt     : Node_Id;

            begin
               pragma Assert (Nkind (Acc_Alt) = N_Accept_Alternative);
               pragma Assert (Nkind (Sel_Acc) = N_Selective_Accept);

               --  ??? Consider a single label for select statements.

               if Present (Handled_Statement_Sequence (N)) then
                  Prepend (Ldecl,
                     Statements (Handled_Statement_Sequence (N)));
                  Analyze (Ldecl);
               end if;

               --  Find first accept alternative of the selective accept. A
               --  valid selective accept must have at least one accept in it.

               Alt := First (Select_Alternatives (Sel_Acc));

               while Nkind (Alt) /= N_Accept_Alternative loop
                  Alt := Next (Alt);
               end loop;

               --  If we are the first accept statement, then we have to
               --  create the Ann variable, as for the stand alone case,
               --  except that it is inserted before the selective accept.
               --  Similarly, a label for requeue expansion must be
               --  declared.

               if N = Accept_Statement (Alt) then
                  Ann :=
                    Make_Defining_Identifier (Loc, New_Internal_Name ('A'));

                  Adecl :=
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Ann,
                      Object_Definition =>
                        New_Reference_To (RTE (RE_Address), Loc));

                  Insert_Before (Sel_Acc, Adecl);
                  Analyze (Adecl);

               --  If we are not the first accept statement, then find the
               --  Ann variable allocated by the first accept and use it.

               else
                  Ann :=
                    Node (Last_Elmt (Accept_Address
                      (Entity (Entry_Direct_Name (Accept_Statement (Alt))))));
               end if;
            end;
         end if;

         --  Merge here with Ann either created or referenced, and Adecl
         --  pointing to the corresponding declaration. Remaining processing
         --  is the same for the two cases.

         if Present (Ann) then
            Append_Elmt (Ann, Accept_Address (Ent));
         end if;
      end if;
   end Expand_Accept_Declarations;

   ------------------------------
   -- Next_Protected_Operation --
   ------------------------------

   function Next_Protected_Operation (N : Node_Id) return Node_Id is
      Next_Op : Node_Id;

   begin
      Next_Op := Next (N);

      while Present (Next_Op)
        and then Nkind (Next_Op) /= N_Subprogram_Body
        and then Nkind (Next_Op) /= N_Entry_Body
      loop
         Next_Op := Next (Next_Op);
      end loop;

      return Next_Op;
   end Next_Protected_Operation;

   -------------------------------
   -- First_Protected_Operation --
   -------------------------------

   function First_Protected_Operation (D : List_Id) return Node_Id is
      First_Op : Node_Id;

   begin
      First_Op := First (D);
      while Present (First_Op)
        and then Nkind (First_Op) /= N_Subprogram_Body
        and then Nkind (First_Op) /= N_Entry_Body
      loop
         First_Op := Next (First_Op);
      end loop;

      return First_Op;
   end First_Protected_Operation;

   --------------------------
   -- Expand_Entry_Barrier --
   --------------------------

   procedure Expand_Entry_Barrier (N : Node_Id; Ent : Entity_Id) is
      Loc       : constant Source_Ptr := Sloc (N);
      Func      : Node_Id;
      B_F       : Node_Id;
      Prot      : constant Entity_Id  := Scope (Ent);
      Spec_Decl : Node_Id := Parent (Prot);
      Body_Decl : Node_Id;

   begin
      --  The body of the entry barrier must be analyzed in the context of
      --  the protected object, but its scope is external to it, just as any
      --  other unprotected version of a protected operation. The specification
      --  has been produced when the protected type declaration was elaborated.
      --  We build the body, insert it in the enclosing scope, but analyze it
      --  in the current context. A more uniform approach would be to treat a
      --  barrier just as a protected function, and discard the protected
      --  version of it because it is never called.

      if Expander_Active then
         B_F := Build_Barrier_Function (N, Ent, Prot);
         Func := Barrier_Function (Ent);
         Set_Corresponding_Spec (B_F, Func);

         Body_Decl := Parent (Corresponding_Body (Spec_Decl));

         if Nkind (Parent (Body_Decl)) = N_Subunit then
            Body_Decl := Corresponding_Stub (Parent (Body_Decl));
         end if;

         Insert_Before_And_Analyze (Body_Decl, B_F);

         if Has_Discriminants (Prot) then
            Update_Prival_Subtypes (Union_Id (Body_Decl));
         end if;

         Set_Privals (Spec_Decl, N, Loc);
         Set_Discriminals (Spec_Decl, N, Loc);
         Set_Scope (Func, Scope (Prot));
      end if;
   end Expand_Entry_Barrier;

   ------------------------------------
   -- Expand_Entry_Body_Declarations --
   ------------------------------------

   procedure Expand_Entry_Body_Declarations (N : Node_Id) is
      Loc        : constant Source_Ptr := Sloc (N);
      Index_Spec : Node_Id;

   begin
      if Expander_Active then

         --  Expand entry bodies corresponding to entry families
         --  by assigning a placeholder for the constant that will
         --  be used to expand references to the entry index parameter.

         Index_Spec :=
           Entry_Index_Specification (Entry_Body_Formal_Part (N));

         if Present (Index_Spec) then
            Set_Entry_Index_Constant (
              Defining_Identifier (Index_Spec),
              Make_Defining_Identifier (Loc, New_Internal_Name ('I')));
         end if;

      end if;
   end Expand_Entry_Body_Declarations;

   -------------------------
   -- Expand_N_Entry_Body --
   -------------------------

   procedure Expand_N_Entry_Body (N : Node_Id) is
      Loc         : constant Source_Ptr := Sloc (N);
      Next_Op     : Node_Id;
      Dec         : Node_Id := Parent (Current_Scope);
      Ent_Formals : Node_Id := Entry_Body_Formal_Part (N);
      Index_Spec  : Node_Id := Entry_Index_Specification (Ent_Formals);

   begin
      --  If this is an entry family, declare the entry index specification.
      --  This is a declaration of the form
      --     I : Index_Type := Index_Type'Value (
      --       E - <<index of first family member>> +
      --       Protected_Entry_Index (Index_Type'Pos (Index_Type'First)));

      if Present (Index_Spec) then
         Prepend_To (Declarations (N),
           Make_Object_Declaration (Loc,
             Defining_Identifier => Entry_Index_Constant (
               Defining_Identifier (Index_Spec)),

             Constant_Present => True,

             Object_Definition => New_Reference_To (
               Etype (Defining_Identifier (Index_Spec)), Loc),

             Expression => Make_Attribute_Reference (Loc,
               Prefix => New_Reference_To (
                 Etype (Defining_Identifier (Index_Spec)), Loc),

               Attribute_Name => Name_Val,
               Expressions => New_List (
                 Make_Op_Add (Loc,
                   Left_Opnd => Make_Op_Subtract (Loc,
                     Left_Opnd => Make_Identifier (Loc, Name_uE),
                     Right_Opnd =>
                       Entry_Index_Expression (
                         Loc,
                         Defining_Identifier (N),
                         Empty,
                         Defining_Identifier (Dec))),

                   Right_Opnd =>
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (
                         Etype (Defining_Identifier (Index_Spec)), Loc),
                       Attribute_Name => Name_Pos,
                       Expressions => New_List (
                         Make_Attribute_Reference (Loc,
                           Prefix => New_Reference_To (
                             Etype (Defining_Identifier (Index_Spec)), Loc),
                           Attribute_Name => Name_First))))))));
      end if;

      --  Add the renamings for private declarations and discriminants.

      Add_Discriminal_Declarations
        (Declarations (N), Defining_Identifier (Dec), Name_uObject, Loc);
      Add_Private_Declarations
        (Declarations (N), Defining_Identifier (Dec), Name_uObject, Loc);

      --  Associate privals and discriminals with the next protected
      --  operation body to be expanded. These are used to expand
      --  references to private data objects and discriminants,
      --  respectively.

      Next_Op := Next_Protected_Operation (N);

      if Present (Next_Op) then
         Set_Privals (Dec, Next_Op, Loc);
         Set_Discriminals (Dec, Next_Op, Loc);
      end if;

   end Expand_N_Entry_Body;

   ----------------------------------------
   -- Expand_Protected_Body_Declarations --
   ----------------------------------------

   --  Part of the expansion of a protected body involves the creation of
   --  a declaration that can be referenced from the statement sequences of
   --  the entry bodies:

   --    A : Address;

   --  This declaration is inserted in the declarations of the service
   --  entries procedure for the protected body,
   --  and it is important that it be inserted before the statements of
   --  the entry body statement sequences are analyzed.
   --  Thus it would be too late to create
   --  this declaration in the Expand_N_Protected_Body routine, which is
   --  why there is a separate procedure to be called directly from Sem_Ch9.

   --  It is used to hold the address of the record containing the parameters
   --  (see Expand_N_Entry_Call for more details on how this record is built).
   --  References to the parameters do an unchecked conversion of this address
   --  to a pointer to the required record type, and then access the field that
   --  holds the value of the required parameter. The entity for the address
   --  variable is held as the top stack element (i.e. the last element) of the
   --  Accept_Address stack in the corresponding entry entity, and this element
   --  must be set in place  before the statements are processed.

   --  No stack is needed for entry bodies, since they cannot be nested, but
   --  it is kept for consistency between protected and task entries. The
   --  stack will never contain more than one element. There is also only one
   --  such variable for a given protected body, but this is placed on the
   --  Accept_Address stack of all of the entries, again for consistency.

   --  To expand the requeue statement, a label is provided at the end of
   --  the loop in the entry service routine created by the expander (see
   --  Expand_N_Protected_Body for details), so that the statement can be
   --  skipped after the requeue is complete. This label is created during the
   --  expansion of the entry body, which will take place after the expansion
   --  of the requeue statements that it contains, so a placeholder defining
   --  identifier is associated with the task type here.

   --  Another label is provided following case statement created by the
   --  expander. This label is need for implementing return statement from
   --  entry body so that a return can be expanded as a goto to this label.
   --  This label is created during the expansion of the entry body, which will
   --  take place after the expansion of the return statements that it
   --  contains. Therefore, just like the label for expanding requeues, we need
   --  another placeholder for the label.

   procedure Expand_Protected_Body_Declarations
     (N : Node_Id;
      Spec_Id : Entity_Id)
   is
      Loc     : constant Source_Ptr := Sloc (N);
      Body_Id : constant Entity_Id  := Corresponding_Body (Parent (Spec_Id));
      Op      : Node_Id;

   begin
      if Expander_Active then

         --  Associate privals with the first subprogram or entry
         --  body to be expanded. These are used to expand references
         --  to private data objects.

         Op := First_Protected_Operation (Declarations (N));

         if Present (Op) then
            Set_Discriminals (Parent (Spec_Id), Op, Sloc (N));
            Set_Privals (Parent (Spec_Id), Op, Sloc (N));
         end if;
      end if;
   end Expand_Protected_Body_Declarations;

   ------------------------------
   -- Expand_N_Abort_Statement --
   ------------------------------

   --  Expand abort T1, T2, .. Tn; into:
   --    Abort_Tasks (Task_List'(1 => T1.Task_Id, 2 => T2.Task_Id ...))

   procedure Expand_N_Abort_Statement (N : Node_Id) is
      Loc    : constant Source_Ptr := Sloc (N);
      Tlist  : constant List_Id    := Names (N);
      Count  : Nat;
      Aggr   : Node_Id;
      Tasknm : Node_Id;

   begin
      Aggr := Make_Aggregate (Loc, Component_Associations => New_List);
      Count := 0;

      Tasknm := First (Tlist);

      while Present (Tasknm) loop
         Count := Count + 1;
         Append_To (Component_Associations (Aggr),
           Make_Component_Association (Loc,
             Choices => New_List (
               Make_Integer_Literal (Loc, UI_From_Int (Count))),
             Expression => Concurrent_Ref (Tasknm)));
         Tasknm := Next (Tasknm);
      end loop;

      Rewrite_Substitute_Tree (N,
        Make_Procedure_Call_Statement (Loc,
          Name => New_Reference_To (RTE (RE_Abort_Tasks), Loc),
          Parameter_Associations => New_List (
            Make_Qualified_Expression (Loc,
              Subtype_Mark => New_Reference_To (RTE (RE_Task_List), Loc),
              Expression => Aggr))));

      Analyze (N);

   end Expand_N_Abort_Statement;

   -------------------------------
   -- Expand_N_Accept_Statement --
   -------------------------------

   --  This procedure handles expansion of accept statements that stand
   --  alone, i.e. they are not part of an accept alternative. The expansion
   --  of accept statement in accept alternatives is handled by the routines
   --  Expand_N_Accept_Alternative and Expand_N_Selective_Accept. The
   --  following description applies only to stand alone accept statements.

   --  If there is no handled statement sequence, then this is called a
   --  trivial accept, and the expansion is:

   --    Accept_Trivial (entry-index)

   --  If there is a handled statement sequence, then the expansion is:

   --    Ann : Address;
   --    {Lnn : Label}

   --    begin
   --       begin
   --          Accept_Call (entry-index, Ann);
   --          <statement sequence from N_Accept_Statement node>
   --          Complete_Rendezvous;
   --          <<Lnn>>
   --
   --       exception
   --          when ... =>
   --             <exception handler from N_Accept_Statement node>
   --             Complete_Rendezvous;
   --          when ... =>
   --             <exception handler from N_Accept_Statement node>
   --             Complete_Rendezvous;
   --          ...
   --       end;

   --    exception
   --       when others =>
   --          Exceptional_Complete_Rendezvous (Current_Exception);
   --    end;

   --  The first three declarations were already inserted ahead of the
   --  accept statement by the Expand_Accept_Declarations procedure, which
   --  was called directly from the semantics during analysis of the accept.
   --  statement, before analyzing its contained statements.

   --  The declarations from the N_Accept_Statement, as noted in Sinfo, come
   --  from possible expansion activity (the original source of course does
   --  not have any declarations associated with the accept statement, since
   --  an accept statement has no declarative part). In particular, if the
   --  expander is active, the first such declaration is the declaration of
   --  the Accept_Params_Ptr entity (see Sem_Ch9.Analyze_Accept_Statement).
   --
   --  The two blocks are merged into a single block if the inner block has
   --  no exception handlers, but otherwise two blocks are required, since
   --  exceptions might be raised in the exception handlers of the inner
   --  block, and Exceptional_Complete_Rendezvous must be called.

   procedure Expand_N_Accept_Statement (N : Node_Id) is
      Loc     : constant Source_Ptr := Sloc (N);
      Stats   : constant Node_Id    := Handled_Statement_Sequence (N);
      Ename   : constant Node_Id    := Entry_Direct_Name (N);
      Eindx   : constant Node_Id    := Entry_Index (N);
      Eent    : constant Entity_Id  := Entity (Ename);
      Acstack : constant Elist_Id   := Accept_Address (Eent);
      Ann     : constant Entity_Id  := Node (Last_Elmt (Acstack));
      Ttyp    : constant Entity_Id  := Etype (Scope (Eent));
      Call    : Node_Id;
      Block   : Node_Id;

   begin
      --  If accept statement is not part of a list, then its parent must be
      --  an accept alternative, and, as described above, we do not do any
      --  expansion for such accept statements at this level.

      if not Is_List_Member (N) then
         pragma Assert (Nkind (Parent (N)) = N_Accept_Alternative);
         return;

      --  Trivial accept case (no statement sequence). If the accept statement
      --  has declarations, then just insert them before the procedure call.

      elsif No (Stats) then
         if Present (Declarations (N)) then
            Insert_Actions (N, Declarations (N));
         end if;

         Rewrite_Substitute_Tree (N,
           Make_Procedure_Call_Statement (Loc,
             Name => New_Reference_To (RTE (RE_Accept_Trivial), Loc),
             Parameter_Associations => New_List (
               Entry_Index_Expression (Loc, Entity (Ename), Eindx, Ttyp))));

         Analyze (N);
         return;

      --  Case of statement sequence present

      else
         --  Construct the block, using the declarations from the accept
         --  statement if any to initialize the declarations of the block.

         Block :=
           Make_Block_Statement (Loc,
             Declarations               => Declarations (N),
             Handled_Statement_Sequence => Build_Accept_Body (Stats, Loc));

         --  Prepend call to Accept_Call to main statement sequence

         Call :=
           Make_Procedure_Call_Statement (Loc,
             Name => New_Reference_To (RTE (RE_Accept_Call), Loc),
             Parameter_Associations => New_List (
               Entry_Index_Expression (Loc, Entity (Ename), Eindx, Ttyp),
               New_Reference_To (Ann, Loc)));

         Prepend (Call, Statements (Stats));
         Analyze (Call);

         --  Replace the accept statement by the new block

         Rewrite_Substitute_Tree (N, Block);
         Analyze (N);

         --  Last step is to unstack the Accept_Address value

         Remove_Last_Elmt (Acstack);
         return;
      end if;

   end Expand_N_Accept_Statement;

   ----------------------------------
   -- 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.

   --  If the trigger is a task entry call, the select is implemented
   --  with Task_Entry_Call:

   --    declare
   --       B : Boolean;
   --       C : Boolean;
   --       P : parms := (parm, parm, parm);
   --
   --        --  Clean is added by Exp_Ch7.Expand_Cleanup_Actions.
   --
   --       procedure _clean is
   --       begin
   --          ...
   --          Cancel_Task_Entry_Call (C);
   --          ...
   --       end _clean;
   --    begin
   --       Abort_Defer;
   --       Task_Entry_Call
   --         (acceptor-task,
   --          entry-index,
   --          P'Address,
   --          Asynchronous_Call,
   --          B);
   --       begin
   --          begin
   --             Abort_Undefer;
   --             abortable-part
   --          at end
   --             _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
   --          end;
   --       exception
   --       when Abort_Signal => null;
   --       end;
   --       parm := P.param;
   --       parm := P.param;
   --       ...
   --       if not C then
   --          triggered-statements
   --       end if;
   --    end;

   --  Note that Build_Simple_Entry_Call is used to expand the entry
   --  of the asynchronous entry call (by the
   --  Expand_N_Entry_Call_Statement procedure) as follows:

   --    declare
   --       P : parms := (parm, parm, parm);
   --    begin
   --       Call_Simple (acceptor-task, entry-index, P'Address);
   --       parm := P.param;
   --       parm := P.param;
   --       ...
   --    end;

   --  so the task at hand is to convert the latter expansion into the former


   --  If the trigger is a protected entry call, the select is
   --  implemented with Protected_Entry_Call:

   --  declare
   --     P   : E1_Params := (param, param, param);
   --     Bnn : Communications_Block;
   --  begin
   --     declare
   --
   --        --  Clean is added by Exp_Ch7.Expand_Cleanup_Actions.
   --
   --        procedure _clean is
   --        begin
   --           ...
   --           if Enqueued (Bnn) then
   --              Cancel_Protected_Entry_Call (Bnn);
   --           end if;
   --           ...
   --        end _clean;
   --     begin
   --        begin
   --           Protected_Entry_Call (
   --             Object => po._object'Access,
   --             E => <entry index>;
   --             Uninterpreted_Data => P'Address;
   --             Mode => Asynchronous_Call;
   --             Block => Bnn);
   --           if Enqueued (Bnn) then
   --              <abortable part>
   --           end if;
   --        at end
   --           _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
   --        end;
   --     exception
   --     when Abort_Signal =>
   --        null;
   --     end;
   --     if not Cancelled (Bnn) then
   --        triggered statements
   --     end if;
   --  end;

   --  Build_Simple_Entry_Call is used to expand the all to a simple
   --  protected entry call:

   --  declare
   --     P   : E1_Params := (param, param, param);
   --     Bnn : Communications_Block;

   --  begin
   --     Protected_Entry_Call (
   --       Object => po._object'Access,
   --       E => <entry index>;
   --       Uninterpreted_Data => P'Address;
   --       Mode => Simple_Call;
   --       Block => Bnn);
   --     parm := P.param;
   --     parm := P.param;
   --       ...
   --  end;

   --  The job is to convert this to the asynchronous form.

   --  If the trigger is a delay statement, it will have been expanded
   --  into a call to one of the GNARL delay procedures. This routine
   --  will convert this into a protected entry call on a delay object
   --  and then continue processing as for a protected entry call trigger.
   --  This requires declaring a Delay_Block object and adding a pointer
   --  to this object to the parameter list of the delay procedure to form
   --  the parameter list of the entry call. This object is used by
   --  the runtime to queue the delay request.

   --  For a description of the use of P and the assignments after the
   --  call, see Expand_N_Entry_Call_Statement.

   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);

      Ecall           : Node_Id;
      Astats          : List_Id := Statements (Abrt);
      Concval         : Node_Id;
      Ename           : Node_Id;
      Index           : Node_Id;
      Hdle            : List_Id;
      Decls           : List_Id;
      Decl            : Node_Id;
      Parms           : List_Id;
      Parm            : Node_Id;
      Call            : Node_Id;
      Stmts           : List_Id;
      Stmt            : Node_Id;
      B               : Entity_Id;
      Pdef            : Entity_Id;
      Odef            : Entity_Id;
      Dblock_Ent      : Entity_Id;
      N_Orig          : Node_Id;
      Abortable_Block : Node_Id;
      Cancel_Param    : Entity_Id;
      Blkent          : Entity_Id;

   begin
      Blkent := 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
      --  may contain additional declarations for internal entities, and the
      --  original call is found by sequential search.

      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
            Ecall := Next (Ecall);
         end loop;
      end if;

      --  If a delay was used as a trigger, it will have been expanded
      --  into a procedure call. Convert it to a protected entry call
      --  on the appropriate delay object, based on the type.
      --  ??? This currently supports only Duration, Real_Time.Time,
      --      and Calendar.Time.

      if Nkind (Ecall) = N_Procedure_Call_Statement then

         --  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'));

         N_Orig := Relocate_Node (N);

         --  Wrap the asynchronous select in a block declaring the
         --  Delay_Block object. Note that this is in addition to the
         --  block that will be used to implement the select statement
         --  proper. This is because the delay trigger is expanded in two
         --  stages: once to convert the procedure call into an entry
         --  call, and once by Build_Simple_Entry_Call (below) to convert
         --  the entry call into GNARLI code for a simple entry call.

         Rewrite_Substitute_Tree (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,
                 Statements => New_List)));

         --  Note that the new block must be analyzed before the select
         --  statement is added to it, otherwise this procedure would be
         --  called recursively.
         --  ??? All of these machinations are the result of the
         --      questionable context-sensitive code in
         --      Expand_N_Entry_Call statement that delays expansion of
         --      an entry call trigger. This is not being fixed now,
         --      since there is some question as to whether the delay
         --      object interface will survive.

         Analyze (N);

         Pdef := Entity (Name (Ecall));

         if Is_RTE (Pdef, RO_CA_Delay_For) then
            Odef := RTE (RO_CA_Delay_Object);
         elsif Is_RTE (Pdef, RO_CA_Delay_Until) then
            Odef := RTE (RO_CA_Delay_Until_Object);
         elsif Is_RTE (Pdef, RO_RT_Delay_Until) then
            Odef := RTE (RO_RT_Delay_Until_Object);
         else
            Unimplemented (N, "This kind of trigger");
         end if;

         Append_To (Parameter_Associations (Ecall),
           Make_Attribute_Reference (Loc,
             Prefix => New_Reference_To (Dblock_Ent, Loc),
             Attribute_Name => Name_Unchecked_Access));

         Decl :=
           First (Visible_Declarations (Protected_Definition (
             Parent (Etype (Odef)))));
         while Nkind (Decl) /= N_Entry_Declaration loop
            Decl := Next (Decl);
         end loop;

         Rewrite_Substitute_Tree (Ecall,
           Make_Procedure_Call_Statement (Loc,
             Name => Make_Selected_Component (Loc,
               Prefix => New_Reference_To (Odef, Loc),
               Selector_Name => New_Reference_To (
                 Defining_Identifier (Decl), Loc)),
             Parameter_Associations => Parameter_Associations (Ecall)));

         Append_To (Statements (Handled_Statement_Sequence (N)), N_Orig);

         Analyze (Ecall);
      else
         N_Orig := N;
      end if;

      Extract_Entry (Ecall, Concval, Ename, Index);
      Build_Simple_Entry_Call (Ecall, Concval, Ename, Index);

      Stmts := Statements (Handled_Statement_Sequence (Ecall));
      Decls := Declarations (Ecall);

      if Is_Protected_Type (Etype (Concval)) then

         --  Get the declarations of the block expanded from the entry call

         Decl := First (Decls);
         while Present (Decl)
           and then (Nkind (Decl) /= N_Object_Declaration
                       or else Etype (Object_Definition (Decl)) /=
                               RTE (RE_Communication_Block))
         loop
            Decl := Next (Decl);
         end loop;

         pragma Assert (Present (Decl));
         Cancel_Param := Defining_Identifier (Decl);

         --  Change the mode of the Protected_Entry_Call call.
         --  Protected_Entry_Call (
         --    Object => po._object'Access,
         --    E => <entry index>;
         --    Uninterpreted_Data => P'Address;
         --    Mode => Asynchronous_Call;
         --    Block => Bnn);

         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
            Stmt := Next (Stmt);
         end loop;

         Call := Stmt;

         Parm := First (Parameter_Associations (Call));
         while Present (Parm)
           and then Etype (Parm) /= RTE (RE_Call_Modes)
         loop
            Parm := Next (Parm);
         end loop;

         pragma Assert (Present (Parm));
         Rewrite_Substitute_Tree (Parm,
           New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
         Analyze (Parm);

         --  Append an if statement to execute the abortable part.
         --  if Enqueued (Bnn) then

         Append_To (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 (Cancel_Param, Loc))),
             Then_Statements => Astats));

         Abortable_Block := Make_Block_Statement (Loc,
           Identifier => New_Reference_To (Blkent, Loc),
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc,
               Statements => Stmts),
           Has_Created_Identifier => True,
           Is_Asynchronous_Call_Block => True);

         Stmts := 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),
                   Abortable_Block),

               --  exception

                 Exception_Handlers => New_List (
                   Make_Exception_Handler (Loc,

               --  when Abort_Signal =>
               --     null;

                     Exception_Choices =>
                       New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
                     Statements =>  New_List (Make_Null_Statement (Loc)))))),

         --  if not Cancelled (Bnn) then
         --     triggered statements
         --  end if;

           Make_If_Statement (Loc,
             Condition => Make_Op_Not (Loc,
               Right_Opnd =>
                 Make_Function_Call (Loc,
                   Name => New_Occurrence_Of (RTE (RE_Cancelled), Loc),
                   Parameter_Associations => New_List (
                     New_Occurrence_Of (Cancel_Param, Loc)))),
             Then_Statements => Tstats));

      --  Asynchronous task entry call

      else
         if No (Decls) then
            Decls := New_List;
         end if;

         B := Make_Defining_Identifier (Loc, Name_uB);

         --  Insert declaration of B in declarations of existing block

         Prepend_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => B,
             Object_Definition => New_Reference_To (Standard_Boolean, Loc)));

         Cancel_Param := Make_Defining_Identifier (Loc, Name_uC);

         --  Insert declaration of C in declarations of existing block

         Prepend_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Cancel_Param,
             Object_Definition => New_Reference_To (Standard_Boolean, Loc)));

         --  Remove and save the call to Call_Simple.

         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
            Stmt := Next (Stmt);
         end loop;

         Call := Stmt;

         --  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_Null_Statement (Loc))));

         Prepend_To (Astats,
           Make_Procedure_Call_Statement (Loc,
             Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
             Parameter_Associations => Empty_List));

         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);

         Insert_After (Call,
           Make_Block_Statement (Loc,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => New_List (
                   Make_Implicit_Label_Declaration (Loc,
                     Defining_Identifier => Blkent),
                   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));
         Rewrite_Substitute_Tree (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

         Append_To (Stmts,
           Make_If_Statement (Loc,
             Condition => Make_Op_Not (Loc,
               New_Reference_To (Cancel_Param, Loc)),
             Then_Statements => Tstats));

         --  Protected the call against abortion

         Prepend_To (Stmts,
           Make_Procedure_Call_Statement (Loc,
             Name => New_Reference_To (RTE (RE_Abort_Defer), Loc),
             Parameter_Associations => Empty_List));

      end if;

      Set_Entry_Cancel_Parameter (Blkent, Cancel_Param);

      --  The result is the new block

      Rewrite_Substitute_Tree (N_Orig,
        Make_Block_Statement (Loc,
          Declarations => Decls,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc, Stmts)));

      Analyze (N_Orig);

   end Expand_N_Asynchronous_Select;

   -------------------------------------
   -- Expand_N_Conditional_Entry_Call --
   -------------------------------------

   --  The conditional task entry call is converted to a call to
   --  Task_Entry_Call:

   --    declare
   --       B : Boolean;
   --       P : parms := (parm, parm, parm);

   --    begin
   --       Task_Entry_Call
   --         (acceptor-task,
   --          entry-index,
   --          P'Address,
   --          Conditional_Call,
   --          B);
   --       parm := P.param;
   --       parm := P.param;
   --       ...
   --       if B then
   --          normal-statements
   --       else
   --          else-statements
   --       end if;
   --    end;

   --  For a description of the use of P and the assignments after the
   --  call, see Expand_N_Entry_Call_Statement. Note that the entry call
   --  of the conditional entry call has already been expanded (by the
   --  Expand_N_Entry_Call_Statement procedure) as follows:

   --    declare
   --       P : parms := (parm, parm, parm);
   --    begin
   --       Call_Simple (acceptor-task, entry-index, P'Address);
   --       parm := P.param;
   --       parm := P.param;
   --       ...
   --    end;

   --  so the task at hand is to convert the latter expansion into the former


   --  The conditional protected entry call is converted to a call to
   --  Protected_Entry_Call:

   --    declare
   --       P : parms := (parm, parm, parm);
   --       Bnn : Communications_Block;

   --    begin
   --       Protected_Entry_Call (
   --         Object => po._object'Access,
   --         E => <entry index>;
   --         Uninterpreted_Data => P'Address;
   --         Mode => Conditional_Call;
   --         Block => Bnn);
   --       parm := P.param;
   --       parm := P.param;
   --       ...
   --       if Cancelled (Bnn) then
   --          else-statements
   --       else
   --          normal-statements
   --       end if;
   --    end;

   --  As for tasks, the entry call of the conditional entry call has
   --  already been expanded (by the Expand_N_Entry_Call_Statement procedure)
   --  as follows:

   --    declare
   --       P   : E1_Params := (param, param, param);
   --       Bnn : Communications_Block;

   --    begin
   --       Protected_Entry_Call (
   --         Object => po._object'Access,
   --         E => <entry index>;
   --         Uninterpreted_Data => P'Address;
   --         Mode => Simple_Call;
   --         Block => Bnn);
   --       parm := P.param;
   --       parm := P.param;
   --         ...
   --    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 : constant Node_Id    := Entry_Call_Statement (Alt);

      Parms   : List_Id;
      Parm    : Node_Id;
      Call    : Node_Id;
      Stmts   : List_Id;
      B       : Entity_Id;
      Decl    : Node_Id;
      Stmt    : Node_Id;

   begin
      Stmts := Statements (Handled_Statement_Sequence (Blk));

      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
         Stmt := Next (Stmt);
      end loop;

      Call := Stmt;

      Parms := Parameter_Associations (Call);

      if Is_RTE (Entity (Name (Call)), RE_Protected_Entry_Call) then

         --  Substitute Conditional_Entry_Call for Simple_Call
         --  parameter.

         Parm := First (Parms);
         while Present (Parm)
           and then Etype (Parm) /= RTE (RE_Call_Modes)
         loop
            Parm := Next (Parm);
         end loop;

         pragma Assert (Present (Parm));
         Rewrite_Substitute_Tree (Parm,
           New_Reference_To (RTE (RE_Conditional_Call), Loc));

         Analyze (Parm);

         --  Find the Communication_Block parameter for the call
         --  to the Cancelled function.

         Decl := First (Declarations (Blk));
         while Present (Decl)
           and then Etype (Object_Definition (Decl)) /=
                                       RTE (RE_Communication_Block)
         loop
            Decl := 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).

         Append_To (Stmts,
           Make_If_Statement (Loc,
             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);

         --  Insert declaration of B in declarations of existing block

         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)));

         --  Create new call statement

         Append_To (Parms, New_Reference_To (RTE (RE_Conditional_Call), Loc));
         Append_To (Parms, New_Reference_To (B, Loc));

         Rewrite_Substitute_Tree (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

         Append_To (Stmts,
           Make_If_Statement (Loc,
             Condition => New_Reference_To (B, Loc),
             Then_Statements => Statements (Alt),
             Else_Statements => Else_Statements (N)));

      end if;

      --  The result is the new block

      Rewrite_Substitute_Tree (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;

   ---------------------------------------
   -- Expand_N_Delay_Relative_Statement --
   ---------------------------------------

   --  Delay statement is implemented as a procedure call to Delay_For
   --  defined in Ada.Calendar.Delays in order to reduce the overhead of
   --  simple delays imposed by the use of Protected Objects.

   procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
      Loc : constant Source_Ptr := Sloc (N);

   begin
      Rewrite_Substitute_Tree (N,
        Make_Procedure_Call_Statement (Loc,
          Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc),
          Parameter_Associations => New_List (Expression (N))));
      Analyze (N);
   end Expand_N_Delay_Relative_Statement;

   ------------------------------------
   -- Expand_N_Delay_Until_Statement --
   ------------------------------------

   --  Delay Until statement is implemented as a procedure call to
   --  Delay_Until defined in Ada.Calendar.Delays and Ada.Real_Time.Delays.

   procedure Expand_N_Delay_Until_Statement (N : Node_Id) is
      Loc : constant Source_Ptr := Sloc (N);
      Typ : Entity_Id;

   begin
      if Etype (Expression (N)) = Etype (RTE (RO_CA_Time)) then
         Typ := RTE (RO_CA_Delay_Until);
      else
         Typ := RTE (RO_RT_Delay_Until);
      end if;

      Rewrite_Substitute_Tree (N,
        Make_Procedure_Call_Statement (Loc,
          Name => New_Reference_To (Typ, Loc),
          Parameter_Associations => New_List (Expression (N))));

      Analyze (N);
   end Expand_N_Delay_Until_Statement;

   -----------------------------------
   -- Expand_N_Entry_Call_Statement --
   -----------------------------------

   --  An entry call is expanded into GNARLI calls to implement
   --  a simple entry call (see Build_Simple_Entry_Call).

   procedure Expand_N_Entry_Call_Statement (N : Node_Id) is
      Concval : Node_Id;
      Ename   : Node_Id;
      Index   : Node_Id;

   begin
      --  If this entry call is part of an asynchronous select, don't
      --  expand it here; it will be expanded with the select statement.
      --  Don't expand timed entry calls either, as they are translated
      --  into asynchronous entry calls.

      --  ??? This whole approach is questionable; it may be better
      --  to go back to allowing the expansion to take place and then
      --  attempting to fix it up in Expand_N_Asynchronous_Select.
      --  The tricky part is figuring out whether the expanded
      --  call is on a task or protected entry.


      if (Nkind (Parent (N)) /= N_Triggering_Alternative
           or else N /= Triggering_Statement (Parent (N)))
        and then (Nkind (Parent (N)) /= N_Entry_Call_Alternative
                   or else N /= Entry_Call_Statement (Parent (N))
                   or else Nkind (Parent (Parent (N))) /= N_Timed_Entry_Call)
      then
         Extract_Entry (N, Concval, Ename, Index);
         Build_Simple_Entry_Call (N, Concval, Ename, Index);
      end if;

   end Expand_N_Entry_Call_Statement;

   --------------------------------
   -- Expand_N_Entry_Declaration --
   --------------------------------

   --  If there are parameters, then first, each of the formals is marked
   --  by setting Is_Entry_Formal. Next a record type is built which is
   --  used to hold the parameter values. The name of this record type is
   --  entryP where entry is the name of the entry, with an additional
   --  corresponding access type called entryPA. The record type has matching
   --  components for each formal (the component names are the same as the
   --  formal names). For elementary types, the component type matches the
   --  formal type. For composite types, an access type is declared (with
   --  the name formalA) which designates the formal type, and the type of
   --  the component is this access type. Finally the Entry_Component of
   --  each formal is set to reference the corresponding record component.

   procedure Expand_N_Entry_Declaration (N : Node_Id) is
      Loc        : constant Source_Ptr := Sloc (N);
      Entry_Ent  : constant Entity_Id  := Defining_Identifier (N);
      Components : List_Id;
      Formal     : Node_Id;
      Ftype      : Entity_Id;
      Last_Decl  : Node_Id;
      Component  : Entity_Id;
      Ctype      : Entity_Id;
      Decl       : Node_Id;
      Rec_Ent    : Entity_Id;
      Acc_Ent    : Entity_Id;

   begin
      Formal := First_Formal (Entry_Ent);
      Last_Decl := N;

      --  Most processing is done only if parameters are present

      if Present (Formal) then
         Components := New_List;

         --  Loop through formals

         while Present (Formal) loop
            Set_Is_Entry_Formal (Formal);
            Component :=
              Make_Defining_Identifier (Sloc (Formal), Chars (Formal));
            Set_Entry_Component (Formal, Component);
            Set_Entry_Formal (Component, Formal);
            Ftype := Etype (Formal);

            --  Declare new access type and then append

            Ctype :=
              Make_Defining_Identifier (Loc, New_Internal_Name ('A'));

            Decl :=
              Make_Full_Type_Declaration (Loc,
                Defining_Identifier => Ctype,
                Type_Definition     =>
                  Make_Access_To_Object_Definition (Loc,
                    All_Present        => True,
                    Constant_Present   => Ekind (Formal) = E_In_Parameter,
                    Subtype_Indication => New_Reference_To (Ftype, Loc)));

            Insert_After (Last_Decl, Decl);
            Last_Decl := Decl;

            Append_To (Components,
              Make_Component_Declaration (Loc,
                Defining_Identifier => Component,
                Subtype_Indication  => New_Reference_To (Ctype, Loc)));

            Formal := Next_Formal_With_Extras (Formal);
         end loop;

         --  Create the Entry_Parameter_Record declaration

         Rec_Ent :=
           Make_Defining_Identifier (Loc, New_Internal_Name ('P'));

         Decl :=
           Make_Full_Type_Declaration (Loc,
             Defining_Identifier => Rec_Ent,
             Type_Definition     =>
               Make_Record_Definition (Loc,
                 Component_List =>
                   Make_Component_List (Loc,
                     Component_Items => Components)));

         Insert_After (Last_Decl, Decl);
         Last_Decl := Decl;

         --  Construct and link in the corresponding access type

         Acc_Ent :=
           Make_Defining_Identifier (Loc, New_Internal_Name ('A'));

         Set_Entry_Parameters_Type (Entry_Ent, Acc_Ent);

         Decl :=
           Make_Full_Type_Declaration (Loc,
             Defining_Identifier => Acc_Ent,
             Type_Definition     =>
               Make_Access_To_Object_Definition (Loc,
                 All_Present        => True,
                 Subtype_Indication => New_Reference_To (Rec_Ent, Loc)));

         Insert_After (Last_Decl, Decl);
         Last_Decl := Decl;

      end if;

   end Expand_N_Entry_Declaration;

   ---------------------------------------------
   -- Expand_Access_Protected_Subprogram_Type --
   ---------------------------------------------

   procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id) is
      Loc    : constant Source_Ptr := Sloc (N);
      Comps  : List_Id;
      T      : constant Entity_Id  := Defining_Identifier (N);
      D_T    : constant Entity_Id  := Designated_Type (T);
      D_T2   : constant Entity_Id  := Make_Defining_Identifier
                                        (Loc, New_Internal_Name ('D'));
      E_T    : constant Entity_Id  := Make_Defining_Identifier
                                        (Loc, New_Internal_Name ('E'));
      P_List : constant List_Id    := Build_Protected_Spec
                                        (N, RTE (RE_Address), False, D_T);
      Decl1  : Node_Id;
      Decl2  : Node_Id;
      Def1   : Node_Id;

   begin
      --  Create access to protected subprogram with full signature.

      if Nkind (Type_Definition (N)) = N_Access_Function_Definition then
         Def1 :=
           Make_Access_Function_Definition (Loc,
             Parameter_Specifications => P_List,
             Subtype_Mark => New_Copy (Subtype_Mark (Type_Definition (N))));

      else
         Def1 :=
           Make_Access_Procedure_Definition (Loc,
             Parameter_Specifications => P_List);
      end if;

      Decl1 :=
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => D_T2,
          Type_Definition => Def1);

      Insert_After (N, Decl1);

      --  Create Equivalent_Type, a record with two components for an
      --  an access to object an an access to subprogram.

      Comps := New_List (
        Make_Component_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, New_Internal_Name ('P')),
          Subtype_Indication  =>
            New_Occurrence_Of (RTE (RE_Address), Loc)),

        Make_Component_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
          Subtype_Indication  =>
            New_Occurrence_Of (D_T2, Loc)));

      Decl2 :=
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => E_T,
          Type_Definition     =>
            Make_Record_Definition (Loc,
              Component_List =>
                Make_Component_List (Loc,
                  Component_Items => Comps)));

      Insert_After (Decl1, Decl2);
      Set_Equivalent_Type (T, E_T);

   end Expand_Access_Protected_Subprogram_Type;

   -----------------------------
   -- Expand_N_Protected_Body --
   -----------------------------

   --  Protected bodies are expanded to the completion of the subprograms
   --  created for the corresponding protected type. These are a protected
   --  and unprotected version of each protected subprogram in the object,
   --  a function to calculate each entry barrier, and a procedure to
   --  execute the sequence of statements of each protected entry body.
   --  For example, for protected type ptype:

   --  function entB
   --    (O : System.Address;
   --     E : Protected_Entry_Index)
   --     return Boolean
   --  is
   --     <discriminant renamings>
   --     <private object renamings>
   --  begin
   --     return <barrier expression>;
   --  end entB;

   --  procedure pprocN (_object : in out poV;...) is
   --     <discriminant renamings>
   --     <private object renamings>
   --  begin
   --     <sequence of statements>
   --  end pprocN;

   --  procedure pproc (_object : in out poV;...) is
   --     procedure pprocF is
   --       Pn : Boolean;
   --     begin
   --       ptypeS (_object, Pn);
   --       System.Tasking.Protected_Objects.Unlock (_object._object'Access);
   --       System.Tasking.Abortion.Undefer_Abortion;
   --     end pprocF;
   --  begin
   --     System.Tasking.Abortion.Defer_Abortion;
   --     System.Tasking.Protected_Objects.Lock (_object._object'Access);
   --     pprocN (_object;...);
   --  at end
   --     pprocF (_object._object'Access);
   --  end pproc;

   --  function pfuncN (_object : poV;...) return Return_Type is
   --     <discriminant renamings>
   --     <private object renamings>
   --  begin
   --     <sequence of statements>
   --  end pfuncN;

   --  function pfunc (_object : poV) return Return_Type is
   --     procedure pfuncF is
   --     begin
   --       System.Tasking.Protected_Objects.Unlock (_object._object'Access);
   --       System.Tasking.Abortion.Undefer_Abortion;
   --     end pprocF;
   --  begin
   --     System.Tasking.Abortion.Defer_Abortion;
   --     System.Tasking.Protected_Objects.Lock (_object._object'Access);
   --     return pfuncN (_object);
   --  at end
   --     ptypeF (_object);
   --  end pfunc;

   --  procedure entE
   --    (O : System.Address;
   --     P : System.Address;
   --     E : Protected_Entry_Index)
   --  is
   --     <discriminant renamings>
   --     <private object renamings>
   --     type poVP is access poV;
   --     _Object : ptVP := ptVP!(O);
   --  begin
   --     begin
   --        <statement sequence>
   --        Complete_Entry_Body (_Object._Object);
   --     exception
   --        when others =>
   --           Exceptional_Complete_Entry_Body (
   --             _Object._Object, Current_Exception);
   --     end;
   --  end entE;

   --  The type poV is the record created for the protected type to hold
   --  the state of the protected object.

   procedure Expand_N_Protected_Body (N : Node_Id) is
      Loc          : constant Source_Ptr := Sloc (N);
      Pid          : constant Entity_Id  := Corresponding_Spec (N);
      Ptyp         : constant Node_Id    := Parent (Pid);
      Body_Id      : constant Entity_Id  := Corresponding_Body (Ptyp);
      Op_Decl      : Node_Id;
      Op_Body      : Node_Id;
      Op_Id        : Entity_Id;
      New_Op_Body  : Node_Id;
      Current_Node : Node_Id;
      Lab_Decl     : Node_Id;

   begin
      if Nkind (Parent (N)) = N_Subunit then

         --  This is the proper body corresponding to a stub. The declarations
         --  must be inserted at the point of the stub, which is in the decla-
         --  rative part of the parent unit.

         Current_Node := Corresponding_Stub (Parent (N));

      else
         Current_Node := N;
      end if;

      Op_Body := First (Declarations (N));

      --  The protected body is replaced with the bodies of its
      --  protected operations.

      Rewrite_Substitute_Tree (N, Make_Null_Statement (Sloc (N)));
      Analyze (N);

      while Present (Op_Body) loop

         case Nkind (Op_Body) is
            when N_Subprogram_Declaration =>
               null;

            when N_Subprogram_Body =>

               New_Op_Body :=
                 Build_Unprotected_Subprogram_Body (Op_Body, Pid);

               Insert_After (Current_Node, New_Op_Body);
               Current_Node := New_Op_Body;
               Analyze (New_Op_Body);

               if Has_Discriminants (Pid) then
                  Update_Prival_Subtypes (Union_Id (Op_Body));
               end if;

               --  Build the corresponding protected operation only if this
               --  is a visible operation of the type. Otherwise it is only
               --  callable from within the object, and the unprotected version
               --  is sufficient.

               if Present (Corresponding_Spec (Op_Body)) then
                  Op_Decl :=
                    Get_Declaration_Node (Corresponding_Spec (Op_Body));

                  if Nkind (Parent (Op_Decl)) = N_Protected_Definition
                    and then List_Containing (Op_Decl) =
                               Visible_Declarations (Parent (Op_Decl))
                  then
                     New_Op_Body :=
                        Build_Protected_Subprogram_Body (
                          Op_Body, Pid, Specification (New_Op_Body));

                     Insert_After (Current_Node, New_Op_Body);
                     Analyze (New_Op_Body);
                  end if;
               end if;

            when N_Entry_Body =>
               Op_Id := Defining_Identifier (Op_Body);

               New_Op_Body := Build_Protected_Entry (Op_Body, Op_Id, Pid);

               Insert_After (Current_Node, New_Op_Body);
               Current_Node := New_Op_Body;
               Analyze (New_Op_Body);

               if Has_Discriminants (Pid) then
                  Update_Prival_Subtypes (Union_Id (Op_Body));
               end if;

            when N_Implicit_Label_Declaration =>
               Lab_Decl := Op_Body;

            when N_Freeze_Entity =>
               New_Op_Body := New_Copy (Op_Body);

               if Present (Entity (Op_Body))
                 and then Freeze_Node (Entity (Op_Body)) = Op_Body
               then
                  Set_Freeze_Node (Entity (Op_Body), New_Op_Body);
               end if;

               Insert_After (Current_Node, New_Op_Body);
               Current_Node := New_Op_Body;
               Analyze (New_Op_Body);

            when N_Pragma =>
               New_Op_Body := New_Copy (Op_Body);
               Insert_After (Current_Node, New_Op_Body);
               Current_Node := New_Op_Body;
               Analyze (New_Op_Body);

            when others =>
               pragma Assert (False);
               null;

         end case;

         Op_Body := Next (Op_Body);
      end loop;

   end Expand_N_Protected_Body;

   -----------------------------------------
   -- Expand_N_Protected_Type_Declaration --
   -----------------------------------------

   --  First we create a corresponding record type declaration used to
   --  represent values of this protected type.
   --  The general form of this type declaration is

   --    type poV (discriminants) is record
   --      _Object       : aliased Protection(<entry count>);
   --      entry_family  : array (bounds) of Void;
   --      _Priority     : Integer   := priority_expression;
   --      <private data fields>
   --    end record;

   --  The discriminants are present only if the corresponding protected
   --  type has discriminants, and they exactly mirror the protected type
   --  discriminants. The private data fields similarly mirror the
   --  private declarations of the protected type.

   --  The Object field is always present. It contains RTS specific data
   --  used to control the protected object. It is declared as Aliased
   --  so that it can be passed as a pointer to the RTS. This allows the
   --  protected record to be referenced within RTS data structures.

   --  The Service field is present for protected objects with entries. It
   --  contains sufficient information to allow the entry service procedure
   --  for this object to be called when the object is not known till runtime.

   --  One entry_family component is present for each entry family in the
   --  task definition (see Expand_N_Task_Type_Declaration).

   --  The _Priority field is present only if a Priority or Interrupt_Priority
   --  pragma appears in the protected definition. The expression captures the
   --  argument that was present in the pragma, and is used to provide
   --  the Ceiling_Priority parameter to the call to Initialize_Protection.

   --  When a protected object is declared, an instance of the protected type
   --  value record is created. The elaboration of this declaration creates
   --  the correct bounds for the entry families, and also evaluates the
   --  priority expression if needed. The initialization routine for
   --  the protected type itself then calls Initialize_Protection with
   --  appropriate parameters to initialize the value of the Task_Id field.

   --  Note: this record is passed to the subprograms created by the
   --  expansion of protected subprograms and entries. It is an in parameter
   --  to protected functions and an in out parameter to procedures and
   --  entry bodies. The Entity_Id for this created record type is placed
   --  in the Corresponding_Record_Type field of the associated protected
   --  type entity.

   --  Next we create a procedure specifications for protected subprograms
   --  and entry bodies. For each protected subprograms two subprograms are
   --  created, an unprotected and a protected version. The unprotected
   --  version is called from within other operations of the same protected
   --  object.

   --  We also build the needed call to the RTS if a pragma Interrupt_Handler
   --  applies.

   --  A single subprogram is created to service all entry bodies; it has an
   --  additional boolean out parameter indicating that the previous entry
   --  call made by the current task was serviced immediately, i.e. not by
   --  proxy. The O parameter contains a pointer to a record object of the
   --  type described above. An untyped interface is used here to allow this
   --  procedure to be called in places where the type of the object to be
   --  serviced is not known. This must be done, for example, when a call
   --  that may have been requeued is cancelled; the corresponding object
   --  must be serviced, but which object that is is not known till runtime.

   --  procedure ptypeS
   --    (O : System.Address; P : out Boolean);
   --  procedure pprocN (_object : in out poV);
   --  procedure pproc (_object : in out poV);
   --  function pfuncN (_object : poV);
   --  function pfunc (_object : poV);
   --  ...

   --  Note that this must come after the record type declaration, since
   --  the specs refer to this type.

   procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
      Loc     : constant Source_Ptr := Sloc (N);
      Prottyp : constant Entity_Id  := Defining_Identifier (N);
      Protnm  : constant Name_Id    := Chars (Prottyp);

      Pdef : constant Node_Id    := Protected_Definition (N);
      --  This contains two lists; one for visible and one for private decls

      Rec_Decl : Node_Id   := Build_Corresponding_Record (N, Prottyp, Loc);
      Rec_Ent  : Entity_Id := Defining_Identifier (Rec_Decl);
      Cdecls   : List_Id   := Component_Items (Component_List
                                    (Type_Definition (Rec_Decl)));
      Discr_Map    : Elist_Id := New_Elmt_List;
      Priv         : Node_Id;
      Pent         : Entity_Id;
      New_Priv     : Node_Id;
      Comp         : Node_Id;
      Comp_Id      : Entity_Id;
      Sub          : Node_Id;
      Component    : Node_Id;
      Current_Node : Node_Id := N;
      Nam          : Name_Id;
      Bdef         : Entity_Id;
      Edef         : Entity_Id;
      Body_List    : List_Id := New_List;
      Body_Id      : Entity_Id;
      Body_Arr     : Node_Id;
      Body_Aggr    : Node_Id;
      Body_Assign  : Node_Id;
      Index_Exp    : Node_Id;
      Index_Range  : Node_Id;

   begin

      --  If the type has discriminants, their occurrences in the declaration
      --  have been replaced by the corresponding discriminals. For components
      --  that are constrained by discriminants, their homologues in the
      --  corresponding record type must refer to the discriminants of that
      --  record, so we must apply a new renaming to subtypes_indications:

      --     protected discriminant => discriminal => record discriminant.
      --  This replacement is not applied to default expressions, for which
      --  the discriminal is correct.

      if Has_Discriminants (Prottyp) then
         declare
            Disc : Entity_Id;
            Decl : Node_Id;

         begin
            Disc := First_Discriminant (Prottyp);
            Decl := First (Discriminant_Specifications (Rec_Decl));

            while Present (Disc) loop
               Append_Elmt (Discriminal (Disc), Discr_Map);
               Append_Elmt (Defining_Identifier (Decl), Discr_Map);
               Disc := Next_Discriminant (Disc);
               Decl := Next (Decl);
            end loop;
         end;
      end if;

      --  Fill in the component declarations.

      --  Add components for entry families. For each entry family,
      --  create an anonymous type declaration with the same size, and
      --  analyze the type.

      Collect_Entry_Families (Loc, Cdecls, Current_Node, Prottyp);

      --  Prepend the _Object field to the component list. This
      --  needs the family components to computer the number of entries.

      Component :=
        Make_Component_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, Name_uObject),
          Aliased_Present => True,

          Subtype_Indication =>
            Make_Subtype_Indication (
              Sloc => Loc,
              Subtype_Mark => New_Reference_To (RTE (RE_Protection), Loc),

              Constraint =>
                Make_Index_Or_Discriminant_Constraint (
                  Sloc => Loc,
                  Constraints => New_List (
                    Build_Entry_Count_Expression (Prottyp, Cdecls, Loc)))));

      Prepend_To (Cdecls, Component);

      --  Add private field components.

      if Present (Private_Declarations (Pdef)) then
         Priv := First (Private_Declarations (Pdef));

         while Present (Priv) loop

            if Nkind (Priv) = N_Component_Declaration then
               Pent := Defining_Identifier (Priv);
               New_Priv :=
                 Make_Component_Declaration (Loc,
                   Defining_Identifier =>
                     Make_Defining_Identifier (Sloc (Pent), Chars (Pent)),
                   Subtype_Indication =>
                     New_Copy_Tree (Subtype_Indication (Priv), Discr_Map),
                   Expression => Expression (Priv));

               Append_To (Cdecls, New_Priv);

            elsif Nkind (Priv) = N_Subprogram_Declaration then

               --  Make the unprotected version of the subprogram available
               --  for expansion of intra object calls. There is no need for
               --  a protected version because this operation can only be
               --  be called from within the body.

               Sub :=
                 Make_Subprogram_Declaration (Loc,
                   Specification =>
                     Build_Protected_Sub_Specification
                       (Priv, Prottyp, Unprotected => True));

               Insert_After (Current_Node, Sub);
               Analyze (Sub);

               Set_Protected_Body_Subprogram
                 (Defining_Unit_Name (Specification (Priv)),
                  Defining_Unit_Name (Specification (Sub)));

            end if;
            Priv := Next (Priv);
         end loop;
      end if;

      --  Add the priority ceiling component if a priority pragma is present

      if Present (Pdef) and then Has_Priority_Pragma (Pdef) then
         Append_To (Cdecls,
           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_uPriority),
             Subtype_Indication => New_Reference_To (Standard_Integer, Loc),
             Expression => New_Copy (
               Expression (First (
                 Pragma_Argument_Associations (
                   Find_Task_Or_Protected_Pragma (Pdef, Name_Priority)))))));
      end if;

      Insert_After (Current_Node, Rec_Decl);
      Current_Node := Rec_Decl;

      --  Analyze the record declaration immediately after construction,
      --  because the initialization procedure is needed for single object
      --  declarations before the next entity is analyzed (the freeze call
      --  that generates this initialization procedure is found below).

      Analyze (Rec_Decl);

      --  Declare the array of entry body and barrier function
      --  subprogram pointers. It has to be initialized here, otherwise
      --  it will be initialized using _init_proc at the end of the
      --  declarations. This would be too late, as code to initialize
      --  the array is intermixed with the declarations of the entry body
      --  subprograms.
      --  ??? There has to be some better way to prevent this late
      --      initialization; the following works, but it declares
      --      a whole new array, calls _init_proc to null it out,
      --      explicitly nulls it out, and then assigns it to the
      --      real entry body array.

      if Has_Entries (Prottyp) then
         Body_Id := Make_Defining_Identifier (Sloc (Prottyp),
           New_External_Name (Chars (Prottyp), 'A'));

         Body_Arr := Make_Object_Declaration (Loc,
           Defining_Identifier => Body_Id,
           Aliased_Present => True,
           Object_Definition =>
             Make_Subtype_Indication (Loc,
               Subtype_Mark =>
                 New_Reference_To (RTE (RE_Protected_Entry_Body_Array), Loc),
               Constraint =>
                 Make_Index_Or_Discriminant_Constraint (Loc,
                   Constraints => New_List (
                      Make_Range (Loc,
                        Make_Integer_Literal (Loc, Uint_1),
                        Build_Entry_Count_Expression (
                          Prottyp,
                          Component_Items (Component_List (
                             Type_Definition (Parent (
                               Corresponding_Record_Type (Prottyp))))),
                          Loc))))),
           Expression => Make_Aggregate (Loc,
             Component_Associations => New_List (
               Make_Component_Association (Loc,
                 Choices => New_List (Make_Others_Choice (Loc)),
                 Expression => Make_Aggregate (Loc,
                   Expressions =>
                     New_List (Make_Null (Loc), Make_Null (Loc)))))));

         Insert_After (Current_Node, Body_Arr);
         Current_Node := Body_Arr;

         --  A pointer to this array will be placed in the corresponding
         --  record by its initialization procedure, so this needs to be
         --  analyzed here.

         Analyze (Body_Arr);

         Set_Entry_Bodies_Array (Prottyp, Body_Id);

      end if;

      --  Build two new procedure specifications for each protected
      --  subprogram; one to call from outside the object and one to
      --  call from inside. Build a barrier function and an entry
      --  body action procedure specification for each protected entry.
      --  Initialize the entry body array.

      Comp := First (Visible_Declarations (Pdef));
      while Present (Comp) loop
         if Nkind (Comp) = N_Subprogram_Declaration then
            Sub :=
              Make_Subprogram_Declaration (Loc,
                Specification =>
                  Build_Protected_Sub_Specification
                    (Comp, Prottyp, Unprotected => True));

            Insert_After (Current_Node, Sub);
            Analyze (Sub);

            Set_Protected_Body_Subprogram
              (Defining_Unit_Name (Specification (Comp)),
               Defining_Unit_Name (Specification (Sub)));

            --  Make the protected version of the subprogram available
            --  for expansion of external calls.

            Current_Node := Sub;

            Sub :=
              Make_Subprogram_Declaration (Loc,
                Specification =>
                  Build_Protected_Sub_Specification
                    (Comp, Prottyp, Unprotected => False));

            Insert_After (Current_Node, Sub);
            Analyze (Sub);
            Current_Node := Sub;

            --  If a pragma Interrupt_Handler applies, build and add
            --  a call to Register_Interrupt_Handler to the freezing actions
            --  of the protected version (Current_Node) of the subprogram:
            --    system.interrupts.register_interrupt_handler
            --       (prot_procP'address);

            --  ??? The only way to get the protected version of the
            --  subprogram is to call Next_Entity on the unprotected version.
            --  (No need to do it here though, but it's done in the expansion
            --  of protected procedure calls.)

            if Is_Interrupt_Handler (
              Defining_Unit_Name (Specification (Comp)))
            then
               declare
                  --  All needed checks already done in Sem_Prag.

                  Prot_Proc : constant Entity_Id :=
                                Defining_Unit_Name
                                  (Specification (Current_Node));

                  Proc_Address : constant Node_Id :=
                                   Make_Attribute_Reference (Loc,
                                   Prefix => New_Reference_To (Prot_Proc, Loc),
                                   Attribute_Name => Name_Address);

                  RTS_Call : constant Entity_Id :=
                               Make_Procedure_Call_Statement (Loc,
                                 Name =>
                                   New_Reference_To (
                                     RTE (RE_Register_Interrupt_Handler), Loc),
                                 Parameter_Associations =>
                                   New_List (Proc_Address));

               begin
                  Append_Freeze_Action (Prot_Proc, RTS_Call);
               end;
            end if;

         elsif Nkind (Comp) = N_Entry_Declaration then
            Comp_Id := Defining_Identifier (Comp);
            Set_Privals_Chain (Comp_Id, New_Elmt_List);
            Nam := Chars (Comp_Id);
            Edef :=
              Make_Defining_Identifier (Loc,
                Build_Selected_Name (Protnm, New_Internal_Name ('E')));
            Sub :=
              Make_Subprogram_Declaration (Loc,
                Specification =>
                  Build_Protected_Entry_Specification (Edef, Comp_Id, Loc));

            Insert_After (Current_Node, Sub);
            Analyze (Sub);

            Set_Protected_Body_Subprogram (
              Defining_Identifier (Comp),
              Defining_Unit_Name (Specification (Sub)));

            Current_Node := Sub;

            Bdef :=
              Make_Defining_Identifier (Loc,
                Build_Selected_Name (Protnm, New_Internal_Name ('B')));
            Sub :=
              Make_Subprogram_Declaration (Loc,
                Specification =>
                  Build_Barrier_Function_Specification (Bdef, Loc));

            Insert_After (Current_Node, Sub);
            Analyze (Sub);
            Set_Protected_Body_Subprogram (Bdef, Bdef);
            Set_Barrier_Function (Comp_Id, Bdef);
            Set_Scope (Bdef, Scope (Comp_Id));
            Current_Node := Sub;

            --  Initialize the entry body array components corresponding
            --  to this entry or entry family to a record of pointers
            --  to the barrier function and action procedure.

            Body_Aggr :=
              Make_Aggregate (Loc,
                Expressions => New_List (
                  Make_Attribute_Reference (Loc,
                    Prefix => New_Reference_To (Bdef, Loc),
                    Attribute_Name => Name_Unrestricted_Access),
                  Make_Attribute_Reference (Loc,
                    Prefix => New_Reference_To (Edef, Loc),
                    Attribute_Name => Name_Unrestricted_Access)));

            if Ekind (Comp_Id) = E_Entry_Family then
               Index_Range := Entry_Range_Expression (Loc, Comp_Id, Prottyp);
               Body_Assign :=
                 Make_Assignment_Statement (Loc,
                   Name =>
                     Make_Slice (Loc,
                       Prefix => New_Reference_To (Body_Id, Loc),
                       Discrete_Range => Index_Range),

                   Expression =>
                     Make_Aggregate (Loc,
                       Component_Associations => New_List (
                         Make_Component_Association (Loc,
                           Choices => New_List (Make_Others_Choice (Loc)),
                           Expression => Body_Aggr))));
            else
               Index_Exp :=
                 Entry_Index_Expression (Loc, Comp_Id, Empty, Prottyp);

               Body_Assign := Make_Assignment_Statement (Loc,
                  Name => Make_Indexed_Component (Loc,
                    Prefix => New_Reference_To (Body_Id, Loc),
                    Expressions => New_List (Index_Exp)),
                  Expression => Body_Aggr);
            end if;

            Insert_After (Current_Node, Body_Assign);
            Analyze (Body_Assign);
            Current_Node := Body_Assign;

         end if;

         Comp := Next (Comp);
      end loop;

      --  If there are some private entry declarations, expand it as if they
      --  were visible entries.

      if Present (Private_Declarations (Pdef)) then
         Comp := First (Private_Declarations (Pdef));
         while Present (Comp) loop
            if Nkind (Comp) = N_Entry_Declaration then
               Comp_Id := Defining_Identifier (Comp);
               Set_Privals_Chain (Comp_Id, New_Elmt_List);
               Nam := Chars (Comp_Id);
               Edef :=
                 Make_Defining_Identifier (Loc,
                   Build_Selected_Name (Protnm, New_Internal_Name ('E')));

               Sub :=
                 Make_Subprogram_Declaration (Loc,
                   Specification =>
                     Build_Protected_Entry_Specification (Edef, Comp_Id, Loc));

               Insert_After (Current_Node, Sub);
               Analyze (Sub);

               Set_Protected_Body_Subprogram (
                 Defining_Identifier (Comp),
                 Defining_Unit_Name (Specification (Sub)));

               Current_Node := Sub;

               Bdef :=
                 Make_Defining_Identifier (Loc,
                   Build_Selected_Name (Protnm, New_Internal_Name ('B')));
               Sub :=
                 Make_Subprogram_Declaration (Loc,
                   Specification =>
                     Build_Barrier_Function_Specification (Bdef, Loc));

               Insert_After (Current_Node, Sub);
               Analyze (Sub);
               Set_Protected_Body_Subprogram (Bdef, Bdef);
               Set_Barrier_Function (Comp_Id, Bdef);
               Set_Scope (Bdef, Scope (Comp_Id));
               Current_Node := Sub;

               --  Initialize the entry body array components corresponding
               --  to this entry or entry family to a record of pointers
               --  to the barrier function and action procedure.

               Body_Aggr :=
                 Make_Aggregate (Loc,
                   Expressions => New_List (
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (Bdef, Loc),
                       Attribute_Name => Name_Unrestricted_Access),
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (Edef, Loc),
                       Attribute_Name => Name_Unrestricted_Access)));

               if Ekind (Comp_Id) = E_Entry_Family then
                  Index_Range :=
                     Entry_Range_Expression (Loc, Comp_Id, Prottyp);
                  Body_Assign :=
                    Make_Assignment_Statement (Loc,
                      Name =>
                        Make_Slice (Loc,
                          Prefix => New_Reference_To (Body_Id, Loc),
                          Discrete_Range => Index_Range),

                      Expression =>
                        Make_Aggregate (Loc,
                          Component_Associations => New_List (
                            Make_Component_Association (Loc,
                              Choices => New_List (Make_Others_Choice (Loc)),
                              Expression => Body_Aggr))));
               else
                  Index_Exp :=
                    Entry_Index_Expression (Loc, Comp_Id, Empty, Prottyp);

                  Body_Assign := Make_Assignment_Statement (Loc,
                     Name => Make_Indexed_Component (Loc,
                       Prefix => New_Reference_To (Body_Id, Loc),
                       Expressions => New_List (Index_Exp)),
                     Expression => Body_Aggr);
               end if;

               Insert_After (Current_Node, Body_Assign);
               Analyze (Body_Assign);
               Current_Node := Body_Assign;

            end if;

            Comp := Next (Comp);
         end loop;
      end if;

      --  Complete the expansion of access types to the current protected
      --  type, if any were declared.
      --  ??? Pure cargo cult, imitated from Expand_N_Task_Type_Declaration.

      Expand_Previous_Access_Type (N, Prottyp);

   end Expand_N_Protected_Type_Declaration;

   --------------------------------
   -- Expand_N_Requeue_Statement --
   --------------------------------

   --  A requeue statement is expanded into one of four GNARLI operations,
   --  depending on the source and destination (task or protected object).
   --  In addition, code must be generated to jump around the remainder of
   --  processing for the original entry and, if the destination is a
   --  (different) protected object, to attempt to service it.
   --  The following illustrates the various cases:

   --  procedure entE
   --    (O : System.Address;
   --     P : System.Address;
   --     E : Protected_Entry_Index)
   --  is
   --     <discriminant renamings>
   --     <private object renamings>
   --     type poVP is access poV;
   --     _Object : ptVP := ptVP!(O);
   --
   --  begin
   --     begin
   --        <start of statement sequence for entry>
   --
   --        -- Requeue from one protected entry body to another protected
   --        -- entry.
   --
   --        Requeue_Protected_Entry (
   --          _object._object'Access,
   --          new._object'Access,
   --          E,
   --          Abort_Present);
   --        return;
   --
   --        <some more of the statement sequence for entry>
   --
   --        --  Requeue from an entry body to a task entry.
   --
   --        Requeue_Protected_To_Task_Entry (
   --          New._task_id,
   --          E,
   --          Abort_Present);
   --        return;
   --
   --        <rest of statement sequence for entry>
   --        Complete_Entry_Body (_Object._Object);
   --
   --     exception
   --        when others =>
   --           Exceptional_Complete_Entry_Body (
   --             _Object._Object, Current_Exception);
   --     end;
   --  end entE;

   --  Requeue of a task entry call to a task entry.
   --
   --  Accept_Call (E, Ann);
   --     <start of statement sequence for accept statement>
   --     Requeue_Task_Entry (New._task_id, E, Abort_Present);
   --     goto Lnn;
   --     <rest of statement sequence for accept statement>
   --  Complete_Rendezvous;
   --  <<Lnn>>

   --  Requeue of a task entry call to a protected entry.
   --
   --  Accept_Call (E, Ann);
   --     <start of statement sequence for accept statement>
   --     Requeue_Task_To_Protected_Entry (
   --       new._object'Access,
   --       E,
   --       Abort_Present);
   --     newS (new, Pnn);
   --     goto Lnn;
   --     <rest of statement sequence for accept statement>
   --  Complete_Rendezvous;
   --  <<Lnn>>

   --  Further details on these expansions can be found in
   --  Expand_N_Protected_Body and Expand_N_Accept_Statement.

   procedure Expand_N_Requeue_Statement (N : Node_Id) is
      Loc        : constant Source_Ptr := Sloc (N);
      Acc_Stat   : Node_Id;
      Concval    : Node_Id;
      Ename      : Node_Id;
      Index      : Node_Id;
      Conctyp    : Entity_Id;
      Oldtyp     : Entity_Id;
      Lab_Node   : Node_Id;
      Rcall      : Node_Id;
      Abortable  : Node_Id;
      Skip_Stat  : Node_Id;
      Self_Param : Node_Id;
      New_Param  : Node_Id;
      Params     : List_Id;
      RTS_Call   : Entity_Id;

   begin
      if Abort_Present (N) then
         Abortable := New_Occurrence_Of (Standard_True, Loc);
      else
         Abortable := New_Occurrence_Of (Standard_False, Loc);
      end if;

      --  Set up the target object.

      Extract_Entry (N, Concval, Ename, Index);
      Conctyp := Etype (Concval);
      New_Param := Concurrent_Ref (Concval);

      --  The target entry index and abortable flag are the same for all cases.

      Params := New_List (
        Entry_Index_Expression (Loc, Entity (Ename), Index, Conctyp),
        Abortable);

      --  Determine proper GNARLI call and required additional parameters
      --  Loop to find nearest enclosing task type or protected type

      Oldtyp := Current_Scope;
      loop
         if Is_Task_Type (Oldtyp) then
            if Is_Task_Type (Conctyp) then
               RTS_Call := RTE (RE_Requeue_Task_Entry);

            else
               pragma Assert (Is_Protected_Type (Conctyp));
               RTS_Call := RTE (RE_Requeue_Task_To_Protected_Entry);
               New_Param :=
                 Make_Attribute_Reference (Loc,
                   Prefix => New_Param,
                   Attribute_Name => Name_Unchecked_Access);
            end if;

            Prepend (New_Param, Params);
            exit;

         elsif Is_Protected_Type (Oldtyp) then
            Self_Param :=
              Make_Attribute_Reference (Loc,
                Prefix => Concurrent_Ref (New_Occurrence_Of (Oldtyp, Loc)),
                Attribute_Name => Name_Unchecked_Access);

            if Is_Task_Type (Conctyp) then
               RTS_Call := RTE (RE_Requeue_Protected_To_Task_Entry);

            else
               pragma Assert (Is_Protected_Type (Conctyp));
               RTS_Call := RTE (RE_Requeue_Protected_Entry);
               New_Param :=
                 Make_Attribute_Reference (Loc,
                   Prefix => New_Param,
                   Attribute_Name => Name_Unchecked_Access);
            end if;

            Prepend (New_Param, Params);
            Prepend (Self_Param, Params);
            exit;

         --  If neither task type or protected type, must be in some
         --  inner enclosing block, so move on out

         else
            Oldtyp := Scope (Oldtyp);
         end if;
      end loop;

      --  Create the GNARLI call.

      Rcall := Make_Procedure_Call_Statement (Loc,
        Name =>
          New_Occurrence_Of (RTS_Call, Loc),
        Parameter_Associations => Params);

      Rewrite_Substitute_Tree (N, Rcall);
      Analyze (N);

      if Is_Protected_Type (Oldtyp) then

         --  Build the return statement to skip the rest of the entry body

         Skip_Stat := Make_Return_Statement (Loc);

      else
         --  If the requeue is within a task, find the end label of the
         --  enclosing accept statement.

         Acc_Stat := Parent (N);
         while Nkind (Acc_Stat) /= N_Accept_Statement loop
            Acc_Stat := Parent (Acc_Stat);
         end loop;

         Lab_Node :=
            Last (Statements (Handled_Statement_Sequence (Acc_Stat)));

         --  Build the goto statement to skip the rest of the accept
         --  statement.

         Skip_Stat :=
           Make_Goto_Statement (Loc,
             Name => New_Occurrence_Of (Entity (Identifier (Lab_Node)), Loc));
      end if;

      Set_Analyzed (Skip_Stat);

      Insert_After (N, Skip_Stat);

   end Expand_N_Requeue_Statement;

   -------------------------------
   -- Expand_N_Selective_Accept --
   -------------------------------

   procedure Expand_N_Selective_Accept (N : Node_Id) is
      Loc  : constant Source_Ptr := Sloc (N);
      Alts : constant List_Id    := Select_Alternatives (N);

      Accept_Case : List_Id;
      Accept_List : List_Id := New_List;

      Alt       : Node_Id;
      Alt_List  : List_Id := New_List;
      Alt_Stats : List_Id;
      Ann       : Entity_Id := Empty;

      Block       : Node_Id;
      Check_Guard : Boolean := True;
      Decls       : List_Id := New_List;
      Stats       : List_Id := New_List;

      Body_List     : List_Id := New_List;
      Trailing_List : List_Id := New_List;

      Choices       : List_Id;
      Else_Present  : Boolean := False;
      Terminate_Alt : Node_Id := Empty;
      Select_Mode   : Node_Id;

      Delay_Case     : List_Id;
      Delay_Count    : Integer := 0;
      Delay_Val      : Entity_Id;
      Delay_Index    : Entity_Id;
      Delay_Min      : Entity_Id;
      Delay_Alt_List : List_Id := New_List;
      Delay_List     : List_Id := New_List;

      First_Delay : Boolean := True;
      Guard_Open  : Entity_Id;

      End_Lab    : Node_Id;
      Index      : Int := 1;
      Lab        : Node_Id;
      Num_Alts   : Int;
      Num_Accept : Nat := 0;
      Proc       : Node_Id;
      Q          : Node_Id;
      Time_Type  : Entity_Id;
      X          : Node_Id;

      Qnam : constant Entity_Id :=
               Make_Defining_Identifier (Loc, New_External_Name ('S', 0));

      Xnam : constant Entity_Id :=
               Make_Defining_Identifier (Loc, New_External_Name ('J', 1));

      -----------------------
      -- Local subprograms --
      -----------------------

      procedure Add_Accept (Alt : Node_Id);
      --  Process a single accept statement in a select alternative. Build
      --  procedure for body of accept, and add entry to dispatch table with
      --  expression for guard, in preparation for call to run time select.

      function Make_And_Declare_Label (Num : Int) return Node_Id;
      --  Manufacture a label using Num as a serial number and declare it.
      --  The declaration is appended to Decls. The label marks the trailing
      --  statements of an accept or delay alternative.

      function Make_Select_Call (Select_Mode : Entity_Id) return Node_Id;
      --  Build call to Selective_Wait runtime routine.

      procedure Process_Delay_Alternative (Alt : Node_Id; Index : Int);
      --  Add code to compare value of delay with previous values, and
      --  generate case entry for trailing statements.

      procedure Process_Accept_Alternative
        (Alt   : Node_Id;
         Index : Int;
         Proc  : Node_Id);
      --  Add code to call corresponding procedure, and branch to
      --  trailing statements, if any.

      function Accept_Or_Raise return List_Id;
      --  For the rare case where delay alternatives all have guards, and
      --  all of them are closed, it is still possible that there were open
      --  accept alternatives with no callers. We must reexamine the
      --  Accept_List, and execute a selective wait with no else if some
      --  accept is open. If none, we raise program_error.

      ----------------
      -- Add_Accept --
      ----------------

      procedure Add_Accept (Alt : Node_Id) is
         Acc_Stm   : constant Node_Id    := Accept_Statement (Alt);
         Ename     : constant Node_Id    := Entry_Direct_Name (Acc_Stm);
         Eent      : constant Entity_Id  := Entity (Ename);
         Index     : constant Node_Id    := Entry_Index (Acc_Stm);
         Null_Body : Node_Id;
         Proc_Body : Node_Id;
         Expr      : Node_Id;
         Call      : Node_Id;

      begin
         if Present (Declarations (Acc_Stm)) then
            Insert_Actions (N, Declarations (Acc_Stm));
         end if;

         if No (Ann) then
            Ann := Node (First_Elmt (Accept_Address (Eent)));
         end if;

         if Present (Condition (Alt)) then
            Expr :=
              Make_Conditional_Expression (Loc, New_List (
                Condition (Alt),
                Entry_Index_Expression (Loc, Eent, Index, Scope (Eent)),
                New_Reference_To (RTE (RE_Null_Task_Entry), Loc)));
         else
            Expr :=
              Entry_Index_Expression
                (Loc, Eent, Index, Scope (Eent));
         end if;

         if Present (Handled_Statement_Sequence (Accept_Statement (Alt))) then
            Null_Body := New_Reference_To (Standard_False, Loc);

            Call :=
              Make_Procedure_Call_Statement (Loc,
                Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
                Parameter_Associations => Empty_List);
            Insert_Before (First (Statements (Handled_Statement_Sequence (
              Accept_Statement (Alt)))), Call);
            Analyze (Call);

            Proc_Body :=
              Make_Subprogram_Body (Loc,
                Specification =>
                  Make_Procedure_Specification (Loc,
                    Defining_Unit_Name =>
                      Make_Defining_Identifier (Sloc (Ename),
                        New_External_Name (Chars (Ename), 'A', Num_Accept))),

               Declarations => New_List,
               Handled_Statement_Sequence =>
                 Build_Accept_Body
                   (Handled_Statement_Sequence (Accept_Statement (Alt)), Loc));

            Append (Proc_Body, Body_List);

         else
            Null_Body := New_Reference_To (Standard_True,  Loc);
         end if;

         Append_To (Accept_List,
           Make_Aggregate (Loc, Expressions => New_List (Null_Body, Expr)));

         Num_Accept := Num_Accept + 1;

      end Add_Accept;

      -------------------------------
      -- Process_Delay_Alternative --
      -------------------------------

      procedure Process_Delay_Alternative (Alt : Node_Id; Index : Int) is
         Choices   : List_Id;
         Cond      : Node_Id;
         Delay_Alt : List_Id;

      begin
         --  Determine the smallest specified delay.
         --  for each delay alternative generate:

         --    if guard-expression then
         --       Delay_Val  := delay-expression;
         --       Guard_Open := True;
         --       if Delay_Val < Delay_Min then
         --          Delay_Min   := Delay_Val;
         --          Delay_Index := Index;
         --       end if;
         --    end if;

         --  The enclosing if-statement is omitted if there is no guard.

         if Delay_Count = 1
           or else First_Delay
         then
            First_Delay := False;

            Delay_Alt := New_List (
              Make_Assignment_Statement (Loc,
                Name => New_Reference_To (Delay_Min, Loc),
                Expression => Expression (Delay_Statement (Alt))));

            if Delay_Count > 1 then
               Append_To (Delay_Alt,
                 Make_Assignment_Statement (Loc,
                   Name       => New_Reference_To (Delay_Index, Loc),
                   Expression => Make_Integer_Literal (Loc,
                     Intval   => UI_From_Int (Index))));
            end if;

         else
            Delay_Alt := New_List (
              Make_Assignment_Statement (Loc,
                Name => New_Reference_To (Delay_Val, Loc),
                Expression => Expression (Delay_Statement (Alt))));

            if Time_Type = Standard_Duration then
               Cond :=
                  Make_Op_Lt (Loc,
                    Left_Opnd  => New_Reference_To (Delay_Val, Loc),
                    Right_Opnd => New_Reference_To (Delay_Min, Loc));

            else
               --  The scope of the time type must define a comparison
               --  operator. The scope itself may not be visible, so we
               --  construct a node with entity information to insure that
               --  semantic analysis can find the proper operator.

               Cond :=
                 Make_Function_Call (Loc,
                   Name => Make_Selected_Component (Loc,
                     Prefix => New_Reference_To (Scope (Time_Type), Loc),
                     Selector_Name =>
                       Make_Operator_Symbol (Loc,
                         Chars => Name_Op_Lt,
                         Strval => No_String)),
                    Parameter_Associations =>
                      New_List (
                        New_Reference_To (Delay_Val, Loc),
                        New_Reference_To (Delay_Min, Loc)));

               Set_Entity (Prefix (Name (Cond)), Scope (Time_Type));
            end if;

            Append_To (Delay_Alt,
              Make_If_Statement (Loc,
                Condition => Cond,
                Then_Statements => New_List (
                  Make_Assignment_Statement (Loc,
                    Name       => New_Reference_To (Delay_Min, Loc),
                    Expression => New_Reference_To (Delay_Val, Loc)),

                  Make_Assignment_Statement (Loc,
                    Name       => New_Reference_To (Delay_Index, Loc),
                    Expression => Make_Integer_Literal (Loc,
                      Intval   => UI_From_Int (Index))))));
         end if;

         if Check_Guard then
            Append_To (Delay_Alt,
              Make_Assignment_Statement (Loc,
                Name => New_Reference_To (Guard_Open, Loc),
                Expression => New_Reference_To (Standard_True, Loc)));
         end if;

         if Present (Condition (Alt)) then
            Delay_Alt := New_List (
              Make_If_Statement (Loc,
                Condition => Condition (Alt),
                Then_Statements => Delay_Alt));
         end if;

         Append_List (Delay_Alt, Delay_List);

         --  If the delay alternative has a statement part, add a
         --  choice to the case statements for delays.

         if Present (Statements (Alt)) then

            if Delay_Count = 1 then
               Append_List (Statements (Alt), Delay_Alt_List);

            else
               Choices := New_List (
                 Make_Integer_Literal (Loc,
                   Intval => UI_From_Int (Index)));

               Append_To (Delay_Alt_List,
                 Make_Case_Statement_Alternative (Loc,
                   Discrete_Choices => Choices,
                   Statements => Statements (Alt)));
            end if;

         elsif Delay_Count = 1 then

            --  If the single delay has no trailing statements, add a branch
            --  to the exit label to the selective wait.

            Delay_Alt_List := New_List (
              Make_Goto_Statement (Loc,
                Name => New_Copy (Identifier (End_Lab))));

         end if;
      end Process_Delay_Alternative;

      --------------------------------
      -- Process_Accept_Alternative --
      --------------------------------

      procedure Process_Accept_Alternative
        (Alt   : Node_Id;
         Index : Int;
         Proc  : Node_Id)
      is
         Choices   : List_Id;
         Alt_Stats : List_Id;

      begin
         Alt_Stats := No_List;

         if Present (Handled_Statement_Sequence (Accept_Statement (Alt))) then
            Choices := New_List (
              Make_Integer_Literal (Loc,
                Intval => UI_From_Int (Index)));

            Alt_Stats := New_List (
              Make_Procedure_Call_Statement (Loc,
                Name => New_Reference_To (
                  Defining_Unit_Name (Specification (Proc)), Loc)));
         end if;

         if Statements (Alt) /= Empty_List then

            if No (Alt_Stats) then

               --  Accept with no body, followed by trailing statements.

               Choices := New_List (
                 Make_Integer_Literal (Loc,
                   Intval => UI_From_Int (Index)));

               Alt_Stats := New_List;
            end if;

            --  After the call, if any, branch to to trailing statements.
            --  We create a label for each, as well as the corresponding
            --  label declaration.

            Lab := Make_And_Declare_Label (Index);
            Append_To (Alt_Stats,
              Make_Goto_Statement (Loc,
                Name => New_Copy (Identifier (Lab))));

            Append (Lab, Trailing_List);
            Append_List (Statements (Alt), Trailing_List);
            Append_To (Trailing_List,
              Make_Goto_Statement (Loc,
                Name => New_Copy (Identifier (End_Lab))));
         end if;

         if Present (Alt_Stats) then

            --  Procedure call. and/or trailing statements.

            Append_To (Alt_List,
              Make_Case_Statement_Alternative (Loc,
                Discrete_Choices => Choices,
                Statements => Alt_Stats));
         end if;
      end Process_Accept_Alternative;

      ----------------------
      -- Make_Select_Call --
      ----------------------

      function Make_Select_Call (Select_Mode : Entity_Id) return Node_Id is
         Params : List_Id := New_List;

      begin
         Append (
           Make_Attribute_Reference (Loc,
             Prefix => New_Reference_To (Qnam, Loc),
             Attribute_Name => Name_Unchecked_Access),
           Params);
         Append (Select_Mode, Params);
         Append (New_Reference_To (Ann, Loc), Params);
         Append (New_Reference_To (Xnam, Loc), Params);

         return
           Make_Procedure_Call_Statement (Loc,
             Name => New_Reference_To (RTE (RE_Selective_Wait), Loc),
             Parameter_Associations => Params);
      end Make_Select_Call;

      ----------------------------
      -- Make_And_Declare_Label --
      ----------------------------

      function Make_And_Declare_Label (Num : Int) return Node_Id is
         Lab_Id : Node_Id;

      begin
         Lab_Id := Make_Identifier (Loc, New_External_Name ('L', Num));
         Lab := Make_Label (Loc, Lab_Id);

         Append_To (Decls,
           Make_Implicit_Label_Declaration (Loc,
             Defining_Identifier  =>
               Make_Defining_Identifier (Loc, Chars (Lab_Id))));

         return Lab;
      end Make_And_Declare_Label;

      ---------------------
      -- Accept_Or_Raise --
      ---------------------

      function Accept_Or_Raise return List_Id is
         Cond  : Node_Id;
         Stats : List_Id;
         J     : constant Entity_Id := Make_Defining_Identifier (Loc,
                                                  New_Internal_Name ('J'));

      begin
         --  We generate the following:

         --    for J in q'range loop
         --       if q(J).S /=null_task_entry then
         --          selective_wait (simple_mode,...);
         --          done := True;
         --          exit;
         --       end if;
         --    end loop;
         --
         --    if no rendez_vous then
         --       raise program_error;
         --    end if;

         --    Note that the code needs to know that the selector name
         --    in an Accept_Alternative is named S.

         Cond := Make_Op_Ne (Loc,
           Left_Opnd =>
             Make_Selected_Component (Loc,
               Prefix => Make_Indexed_Component (Loc,
                 Prefix => New_Reference_To (Qnam, Loc),
                   Expressions => New_List (New_Reference_To (J, Loc))),
             Selector_Name => Make_Identifier (Loc, Name_S)),
           Right_Opnd =>
             New_Reference_To (RTE (RE_Null_Task_Entry), Loc));

         Stats := New_List (
           Make_Loop_Statement (Loc,
             Identifier => Empty,
             Iteration_Scheme =>
               Make_Iteration_Scheme (Loc,
                 Loop_Parameter_Specification =>
                   Make_Loop_Parameter_Specification (Loc,
                     Defining_Identifier => J,
                     Discrete_Subtype_Definition =>
                       Make_Attribute_Reference (Loc,
                         Prefix => New_Reference_To (Qnam, Loc),
                         Attribute_Name => Name_Range,
                         Expressions => New_List (
                           Make_Integer_Literal (Loc,
                             Intval => UI_From_Int (1)))))),

             Statements => New_List (
               Make_If_Statement (Loc,
                 Condition =>  Cond,
                 Then_Statements => New_List (
                   Make_Select_Call (
                    New_Reference_To (RTE (RE_Simple_Mode), Loc)),
                   Make_Exit_Statement (Loc))))));

         Append_To (Stats,
           Make_If_Statement (Loc,
             Condition => Make_Op_Eq (Loc,
               Left_Opnd  => New_Reference_To (Xnam, Loc),
               Right_Opnd =>
                 New_Reference_To (RTE (RE_No_Rendezvous), Loc)),
             Then_Statements => New_List (Make_Raise_Statement (Loc,
               Name => New_Reference_To (Standard_Program_Error, Loc)))));

         return Stats;
      end Accept_Or_Raise;

   --  Start of processing for Expand_N_Selective_Accept

   begin
      --  First insert some declarations before the select. The first is:

      --    Ann : Address

      --  This variable holds the parameters passed to the accept body. This
      --  declaration has already been inserted by the time we get here by
      --  a call to Expand_Accept_Declarations made from the semantics when
      --  processing the first accept statement contained in the select. We
      --  can find this entity as Accept_Address (E), where E is any of the
      --  entries references by contained accept statements.

      --  The first step is to scan the list of Selective_Accept_Statements
      --  to find this entity, and also count the number of accepts, and
      --  determine if terminated, delay or else is present:

      Num_Alts := 0;

      Alt := First (Alts);
      while Present (Alt) loop

         if Nkind (Alt) = N_Accept_Alternative then
            Add_Accept (Alt);

         elsif Nkind (Alt) = N_Delay_Alternative then
            Delay_Count   := Delay_Count + 1;

            --   If the delays are relative delays, the delay expressions have
            --   type Standard_Duration. Otherwise they have some time type.
            --   This has been verified by the front-end.

            if Nkind (Delay_Statement (Alt)) = N_Delay_Relative_Statement then
               Time_Type := Standard_Duration;
            else
               Time_Type := Etype (Expression (Delay_Statement (Alt)));
            end if;

            if No (Condition (Alt)) then

               --  this guard will always be open.

               Check_Guard := False;
            end if;

         elsif Nkind (Alt) = N_Terminate_Alternative then
            Terminate_Alt := Alt;
         end if;

         Num_Alts := Num_Alts + 1;
         Alt := Next (Alt);
      end loop;

      Else_Present := Present (Else_Statements (N));

      --  At the same time (see procedure Add_Accept) we build the accept list:

      --    Qnn : Accept_List (1 .. num-select) := (
      --          (null-body, entry-index),
      --          (null-body, entry-index),
      --          ..
      --          (null_body, entry-index));

      --  In the above declaration, null-body is True if the corresponding
      --  accept has no body, and false otherwise. The entry is either the
      --  entry index expression if there is no guard, or if a guard is
      --  present, then a conditional expression of the form:

      --    (if guard then entry-index else Null_Task_Entry)

      --  If a guard is statically known to be false, the entry can simply
      --  be omitted from the accept list.

      Q :=
        Make_Object_Declaration (Loc,
          Defining_Identifier => Qnam,
          Object_Definition =>
            New_Reference_To (RTE (RE_Accept_List), Loc),
          Aliased_Present => True,

          Expression =>
             Make_Qualified_Expression (Loc,
               Subtype_Mark =>
                 New_Reference_To (RTE (RE_Accept_List), Loc),
               Expression =>
                 Make_Aggregate (Loc, Expressions => Accept_List)));

      Append (Q, Decls);

      --  Then we declare the variable that holds the index for the accept
      --  that will be selected for service:

      --    Xnn : Select_Index;

      X :=
        Make_Object_Declaration (Loc,
          Defining_Identifier => Xnam,
          Object_Definition =>
            New_Reference_To (RTE (RE_Select_Index), Loc));

      Append (X, Decls);

      --  After this follow  procedure declarations for each accept body.

      --    procedure Pnn is
      --    begin
      --       ...
      --    end;

      --  where the ... are statements from the corresponding procedure body.
      --  No parameters are involved, since the parameters are passed via Ann
      --  and the parameter references have already been expanded to be direct
      --  references to Ann (see Exp_Ch2.Expand_Entry_Parameter). Furthermore,
      --  any embedded tasking statements (which would normally be illegal in
      --  procedures, have been converted to calls to the tasking runtime so
      --  there is no problem in putting them into procedures.

      --  The original accept statement has been expanded into a block in
      --  the same fashion as for simple accepts (see Build_Accept_Body).

      --  Note: we don't really need to build these procedures for the case
      --  where no delay statement is present, but is is just as easy to
      --  build them unconditionally, and not significantly inefficient,
      --  since if they are short they will be inlined anyway.

      --  The procedure declarations have been assembled in Body_List.

      --  If delays are present, we must compute the required delay.
      --  We first generate the declarations:

      --    Delay_Index : Boolean := 0;
      --    Delay_Min   : Some_Time_Type.Time;
      --    Delay_Val   : Some_Time_Type.Time;

      --  Delay_Index will be set to the index of the minimum delay, i.e. the
      --   active delay that is actually chosen as the basis for the possible
      --   delay if an immediate rendez-vous is not possible.
      --   In the most common case there is a single delay statement, and this
      --   is handled specially.

      if Delay_Count > 0 then

         --  Generate the required declarations

         Delay_Val :=
           Make_Defining_Identifier (Loc, New_External_Name ('D', 1));
         Delay_Index :=
           Make_Defining_Identifier (Loc, New_External_Name ('D', 2));
         Delay_Min :=
           Make_Defining_Identifier (Loc, New_External_Name ('D', 3));

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Delay_Val,
             Object_Definition   => New_Reference_To (Time_Type, Loc)));

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Delay_Index,
             Object_Definition   => New_Reference_To (Standard_Integer, Loc),
             Expression          => Make_Integer_Literal (Loc, Uint_0)));

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Delay_Min,
             Object_Definition   => New_Reference_To (Time_Type, Loc),
             Expression          =>
               Unchecked_Convert_To (Time_Type,
                 Make_Attribute_Reference (Loc,
                   Prefix =>
                     New_Occurrence_Of (Underlying_Type (Time_Type), Loc),
                   Attribute_Name => Name_Last))));

         if Check_Guard then
            Guard_Open :=
              Make_Defining_Identifier (Loc, New_External_Name ('G', 1));

            Append_To (Decls,
              Make_Object_Declaration (Loc,
                 Defining_Identifier => Guard_Open,
                 Object_Definition => New_Reference_To (Standard_Boolean, Loc),
                 Expression        => New_Reference_To (Standard_False, Loc)));
         end if;
      end if;

      if Present (Terminate_Alt) then

         --  If the terminate alternative guard is False, use
         --  Simple_Mode; otherwise use Terminate_Mode.

         if Present (Condition (Terminate_Alt)) then
            Select_Mode := Make_Conditional_Expression (Loc,
              New_List (Condition (Terminate_Alt),
                        New_Reference_To (RTE (RE_Terminate_Mode), Loc),
                        New_Reference_To (RTE (RE_Simple_Mode), Loc)));
         else
            Select_Mode := New_Reference_To (RTE (RE_Terminate_Mode), Loc);
         end if;

      elsif Else_Present or Delay_Count > 0 then
         Select_Mode := New_Reference_To (RTE (RE_Else_Mode), Loc);

      else
         Select_Mode := New_Reference_To (RTE (RE_Simple_Mode), Loc);
      end if;

      Append (Make_Select_Call (Select_Mode), Stats);

      --  Now generate code to act on the result. There is an entry
      --  in this case for each accept statement with a non-null body,
      --  followed by a branch to the statements that follow the Accept.
      --  In the absence of delay alternatives, we generate:

      --    case X is
      --      when No_Rendezvous =>  --  omitted if simple mode
      --         goto Lab0;

      --      when 1 =>
      --         P1n;
      --         goto Lab1;

      --      when 2 =>
      --         P2n;
      --         goto Lab2;

      --      when others =>
      --         goto Exit;
      --    end case;
      --
      --    Lab0: Else_Statements;
      --    goto exit;

      --    Lab1:  Trailing_Statements1;
      --    goto Exit;
      --
      --    Lab2:  Trailing_Statements2;
      --    goto Exit;
      --    ...
      --    Exit:

      --  Generate label for common exit.

      End_Lab := Make_And_Declare_Label (Num_Alts + 1);

      --  First entry is the default case, when no rendezvous is possible.

      Choices := New_List (
        New_Reference_To (RTE (RE_No_Rendezvous), Loc));

      if Else_Present then

         --  If no rendezvous is possible, the else part is executed.

         Lab := Make_And_Declare_Label (0);
         Alt_Stats := New_List (
           Make_Goto_Statement (Loc,
             Name => New_Copy (Identifier (Lab))));

         Append (Lab, Trailing_List);
         Append_List (Else_Statements (N), Trailing_List);
         Append_To (Trailing_List,
           Make_Goto_Statement (Loc,
             Name => New_Copy (Identifier (End_Lab))));
      else
         Alt_Stats := New_List (
           Make_Goto_Statement (Loc,
             Name => New_Copy (Identifier (End_Lab))));
      end if;

      Append_To (Alt_List,
        Make_Case_Statement_Alternative (Loc,
          Discrete_Choices => Choices,
          Statements => Alt_Stats));

      --  We make use of the fact that Accept_Index is an integer type,
      --  and generate successive literals for entries for each accept.
      --  Only those for which there is a body or trailing statements are
      --  given a case entry.

      Alt := First (Select_Alternatives (N));
      Proc := First (Body_List);

      while Present (Alt) loop

         if Nkind (Alt) = N_Accept_Alternative then
            Process_Accept_Alternative (Alt, Index, Proc);

            if Present
              (Handled_Statement_Sequence (Accept_Statement (Alt)))
            then
               Proc := Next (Proc);
            end if;

         elsif Nkind (Alt) = N_Delay_Alternative then
            Process_Delay_Alternative (Alt, Index);
         end if;

         Index := Index + 1;
         Alt := Next (Alt);
      end loop;

      --  An others choice is always added to the main case, as well
      --  as the delay case (to satisfy the compiler).

      Append_To (Alt_List,
        Make_Case_Statement_Alternative (Loc,
          Discrete_Choices =>
            New_List (Make_Others_Choice (Loc)),
          Statements       =>
            New_List (Make_Goto_Statement (Loc,
              Name => New_Copy (Identifier (End_Lab))))));

      Accept_Case := New_List (
        Make_Case_Statement (Loc,
          Expression   => New_Reference_To (Xnam, Loc),
          Alternatives => Alt_List));

      Append_List (Trailing_List, Accept_Case);
      Append (End_Lab, Accept_Case);
      Append_List (Body_List, Decls);

      --  Construct case statement for trailing statements of delay
      --  alternatives, if there are several of them.

      if Delay_Count > 1 then
         Append_To (Delay_Alt_List,
           Make_Case_Statement_Alternative (Loc,
             Discrete_Choices =>
               New_List (Make_Others_Choice (Loc)),
             Statements       =>
               New_List (Make_Null_Statement (Loc))));

         Delay_Case := New_List (
           Make_Case_Statement (Loc,
             Expression   => New_Reference_To (Delay_Index, Loc),
             Alternatives => Delay_Alt_List));
      else
         Delay_Case := Delay_Alt_List;
      end if;

      --  If there are no delay alternatives, we append the case statement
      --  to the statement list.

      if Delay_Count = 0 then
         Append_List (Accept_Case, Stats);

      else
         --  If delay alternatives are present, we generate:

         --    find minimum delay.
         --    if X = No_Rendezvous then
         --      Select
         --         Delay Delay_Min;
         --      then Abort
         --         Selective_Wait (Q'Unchecked_Access, Simple_mode, P, X);
         --      end select;
         --    end if;
         --
         --    if X = No_Rendezvous then
         --      case statement for delay statements.
         --    else
         --      case statement for accept alternatives.
         --    end if;

         declare
            First_Try : Node_Id;
            Asynch    : Node_Id;
            Cases     : Node_Id;
            Trigger   : Node_Id;

         begin
            Append_List (Delay_List, Stats);

            if Time_Type = Standard_Duration then
               Trigger :=
                 Make_Delay_Relative_Statement (Loc,
                   Expression => New_Reference_To (Delay_Min, Loc));
            else
               Trigger :=
                 Make_Delay_Until_Statement (Loc,
                   Expression => New_Reference_To (Delay_Min, Loc));
            end if;

            Asynch :=
              Make_Asynchronous_Select (Loc,
                Triggering_Alternative =>
                  Make_Triggering_Alternative (Loc,
                    Triggering_Statement => Trigger,
                    Statements => New_List),

                Abortable_Part =>
                  Make_Abortable_Part (Loc,
                    Statements =>  New_List (

                      Make_Select_Call (
                        New_Reference_To (RTE (RE_Delay_Mode), Loc)))));

            if Check_Guard then
               Asynch :=
                 Make_If_Statement (Loc,
                   Condition => New_Reference_To (Guard_Open, Loc),
                   Then_Statements => New_List (Asynch),
                   Else_Statements => Accept_Or_Raise);
            end if;

            First_Try :=
              Make_If_Statement (Loc,
                Condition => Make_Op_Eq (Loc,
                  Left_Opnd  => New_Reference_To (Xnam, Loc),
                  Right_Opnd =>
                    New_Reference_To (RTE (RE_No_Rendezvous), Loc)),
                Then_Statements => New_List (Asynch));

            Append (First_Try, Stats);

            Cases :=
              Make_If_Statement (Loc,
                Condition => Make_Op_Eq (Loc,
                  Left_Opnd  => New_Reference_To (Xnam, Loc),
                  Right_Opnd =>
                    New_Reference_To (RTE (RE_No_Rendezvous), Loc)),

                Then_Statements => Delay_Case,
                Else_Statements => Accept_Case);

            Append (Cases, Stats);
         end;
      end if;

      --  Replace accept statement with appropriate block

      Block :=
        Make_Block_Statement (Loc,
          Declarations => Decls,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc,
              Statements => Stats));

      Rewrite_Substitute_Tree (N, Block);
      Analyze (N);

      --  Note: have to worry more about abort deferral in above code ???

      --  Final step is to unstack the Accept_Address entries for all accept
      --  statements appearing in accept alternatives in the select statement

      Alt := First (Alts);
      while Present (Alt) loop
         if Nkind (Alt) = N_Accept_Alternative then
            Remove_Last_Elmt (Accept_Address
              (Entity (Entry_Direct_Name (Accept_Statement (Alt)))));
         end if;

         Alt := Next (Alt);
      end loop;

   end Expand_N_Selective_Accept;

   --------------------------------------
   -- Expand_N_Single_Task_Declaration --
   --------------------------------------

   --  Single task declarations should never be present after semantic
   --  analysis, since we expect them to be replaced by a declaration of
   --  an anonymous task type, followed by a declaration of the task
   --  object. We include this routine to make sure that is happening!

   procedure Expand_N_Single_Task_Declaration (N : Node_Id) is
   begin
      pragma Assert (False); null;
   end Expand_N_Single_Task_Declaration;

   ------------------------
   -- Expand_N_Task_Body --
   ------------------------

   --  Given a task body

   --    task body tname is
   --       declarations
   --    begin
   --       statements
   --    end x;

   --  This expansion routine converts it into a procedure and sets the
   --  elaboration flag for the procedure to true, to represent the fact
   --  that the task body is now elaborated:

   --    procedure tnameB (_Task : access tnameV) is
   --       discriminal : dtype renames _Task.discriminant;

   --    begin
   --       System.Task_Stages.Complete_Activation;
   --       statements
   --    at end
   --       System.Task_Stages.Complete_Task;
   --    end tnameB;

   --    tnameE := True;

   --  In addition, if the task body is an activator, then a call to
   --  activate tasks is added at the start of the statements, before
   --  the call to Complete_Activation, and if in addition the task is
   --  a master then it must be established as a master. These calls are
   --  inserted and analyzed in Expand_Cleanup_Actions, when the
   --  Handled_Sequence_Of_Statements is expanded.

   --  There is one discriminal declaration line generated for each
   --  discriminant that is present to provide an easy reference point
   --  for discriminant references inside the body (see Exp_Ch2.Expand_Name).

   --  Note on relationship to GNARLI definition. In the GNARLI definition,
   --  task body procedures have a profile (Arg : System.Address). That is
   --  needed because GNARLI has to use the same access-to-subprogram type
   --  for all task types. We depend here on knowing that in GNAT, passing
   --  an address argument by value is identical to passing a a record value
   --  by access (in either case a single pointer is passed), so even though
   --  this procedure has the wrong profile. In fact it's all OK, since the
   --  callings sequence is identical.

   procedure Expand_N_Task_Body (N : Node_Id) is
      Loc   : constant Source_Ptr := Sloc (N);
      Ttyp  : constant Entity_Id  := Corresponding_Spec (N);
      Call  : Node_Id;
      New_N : Node_Id;

   begin
      Add_Discriminal_Declarations (Declarations (N), Ttyp, Name_uTask, Loc);

      --  The statement part has already been protected with an at_end and
      --  cleanup actions. The call to Complete_Activation must be placed
      --  at the head of the sequence of statements of that block. The
      --  declarations have been merged in this sequence of statements but
      --  the first real statement is accessible from the First_Real_Statement
      --  field (which was set for exactly this purpose)

      Call := Build_Runtime_Call (Loc, RE_Complete_Activation);
      Insert_Before
        (First_Real_Statement (Handled_Statement_Sequence (N)), Call);
      Analyze (Call);

      New_N :=
        Make_Subprogram_Body (Loc,
          Specification => Build_Task_Proc_Specification (Ttyp),
          Declarations  => Declarations (N),
          Handled_Statement_Sequence => Handled_Statement_Sequence (N));

      --  If the task contains generic instantiations, cleanup actions
      --  are delayed until after instantiation. Transfer the activation
      --  chain to the subprogram, to insure that the activation call is
      --  properly generated.

      if Has_Pending_Instantiations (Ttyp) then
         Set_Activation_Chain_Entity (New_N, Activation_Chain_Entity (N));
      end if;

      Rewrite_Substitute_Tree (N, New_N);
      Analyze (N);

      --  Set elaboration flag immediately after task body. If the body
      --  is a subunit, the flag is set in  the declarative part that
      --  contains the stub.

      if Nkind (Parent (N)) /= N_Subunit then
         Insert_After (N,
           Make_Assignment_Statement (Loc,
             Name =>
               Make_Identifier (Loc, New_External_Name (Chars (Ttyp), 'E')),
             Expression => New_Reference_To (Standard_True, Loc)));
      end if;

   end Expand_N_Task_Body;

   ------------------------------------
   -- Expand_N_Task_Type_Declaration --
   ------------------------------------

   --  We have several things to do. First we must create a Boolean flag used
   --  to mark if the body is elaborated yet. This variable gets set to True
   --  when the body of the task is elaborated (we can't rely on the normal
   --  ABE mechanism for the task body, since we need to pass an access to
   --  this elaboration boolean to the runtime routines).

   --    taskE : aliased Boolean := False;

   --  Next a variable is declared to hold the task stack size (either
   --  the default, which is the initial value given here, or a value that
   --  is set by a pragma Storage_Size appearing later on.

   --    taskZ : Size_Type := Unspecified_Size;

   --  Next we create a corresponding record type declaration used to represent
   --  values of this task. The general form of this type declaration is

   --    type taskV (discriminants) is record
   --      _Task_Id     : Task_Id;
   --      entry_family : array (bounds) of Void;
   --      _Priority    : Integer        := priority_expression;
   --      _Size        : Size_Type      := Size_Type (size_expression);
   --      _Task_Info   : Task_Info_Type := task_info_expression;
   --    end record;

   --  The discriminants are present only if the corresponding task type has
   --  discriminants, and they exactly mirror the task type discriminants.

   --  The Id field is always present. It contains the Task_Id value, as
   --  set by the call to Create_Task. Note that although the task is
   --  limited, the task value record type is not limited, so there is no
   --  problem in passing this field as an out parameter to Create_Task.

   --  One entry_family component is present for each entry family in the
   --  task definition. The bounds correspond to the bounds of the entry
   --  family (which may depend on discriminants). The element type is
   --  void, since we only need the bounds information for determining
   --  the entry index. Note that the use of an anonymous array would
   --  normally be illegal in this context, but this is a parser check,
   --  and the semantics is quite prepared to handle such a case.

   --  The _Size field is present only if a Storage_Size pragma appears in
   --  the task definition. The expression captures the argument that was
   --  present in the pragma, and is used to override the task stack size
   --  otherwise associated with the task type.

   --  The _Priority field is present only if a Priority or Interrupt_Priority
   --  pragma appears in the task definition. The expression captures the
   --  argument that was present in the pragma, and is used to provide
   --  the Size parameter to the call to Create_Task.

   --  The _Task_Info field is present only if a Task_Info pragma appears in
   --  the task definition. The expression captures the argument that was
   --  present in the pragma, and is used to provide the Task_Info parameter
   --  to the call to Create_Task.

   --  When a task is declared, an instance of the task value record is
   --  created. The elaboration of this declaration creates the correct
   --  bounds for the entry families, and also evaluates the size, priority,
   --  and task_Info expressions if needed. The initialization routine for
   --  the task type itself then calls Create_Task with appropriate
   --  parameters to initialize the value of the Task_Id field.

   --  Note: the address of this record is passed as the "Discriminants"
   --  parameter for Create_Task. Since Create_Task merely passes this onto
   --  the body procedure, it does not matter that it does not quite match
   --  the GNARLI model of what is being passed (the record contains more
   --  than just the discriminants, but the discriminants can be found from
   --  the record value).

   --  The Entity_Id for this created record type is placed in the
   --  Corresponding_Record_Type field of the associated task type entity.

   --  Next we create a procedure specification for the task body procedure:

   --    procedure taskB (_Task : access taskV);

   --  Note that this must come after the record type declaration, since
   --  the spec refers to this type. It turns out that the initialization
   --  procedure for the value type references the task body spec, but that's
   --  fine, since it won't be generated till the freeze point for the type,
   --  which is certainly after the task body spec declaration.

   --  Finally, we set the task index value field of the entry attribute in
   --  the case of a simple entry.

   procedure Expand_N_Task_Type_Declaration (N : Node_Id) is
      Loc       : constant Source_Ptr := Sloc (N);
      Ent       : Entity_Id;
      Tasktyp   : constant Entity_Id  := Etype (Defining_Identifier (N));
      Tasknm    : constant Name_Id    := Chars (Tasktyp);
      Taskdef   : constant Node_Id    := Task_Definition (N);
      Proc_Spec : Node_Id;

      Rec_Decl  : Node_Id   := Build_Corresponding_Record (N, Tasktyp, Loc);
      Rec_Ent   : Entity_Id := Defining_Identifier (Rec_Decl);
      Cdecls    : List_Id   := Component_Items (Component_List
                                 (Type_Definition (Rec_Decl)));

      Elab_Decl : Node_Id;
      Size_Decl : Node_Id;
      Body_Decl : Node_Id;

   begin
      --  First create the elaboration variable

      Elab_Decl :=
        Make_Object_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Sloc (Tasktyp),
              Chars => New_External_Name (Tasknm, 'E')),
          Aliased_Present      => True,
          Object_Definition    => New_Reference_To (Standard_Boolean, Loc),
          Expression           => New_Reference_To (Standard_False, Loc));
      Insert_After (N, Elab_Decl);

      --  Next create the declaration of the size variable (tasknmZ)

      Set_Storage_Size_Variable (Tasktyp,
        Make_Defining_Identifier (Sloc (Tasktyp),
          Chars => New_External_Name (Tasknm, 'Z')));

      Size_Decl :=
        Make_Object_Declaration (Loc,
          Defining_Identifier => Storage_Size_Variable (Tasktyp),
          Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc),
          Expression => New_Reference_To (RTE (RE_Unspecified_Size), Loc));

      Insert_After (Elab_Decl, Size_Decl);

      --  Next build the rest of the corresponding record declaration.
      --  This is done last, since the corresponding record initialization
      --  procedure will reference the previously created entities.

      --  Fill in the component declarations. First the _Task_Id field:

      Append_To (Cdecls,
        Make_Component_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, Name_uTask_Id),
          Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_ID), Loc)));

      --  Add components for entry families

      Collect_Entry_Families (Loc, Cdecls, Size_Decl, Tasktyp);

      --  Add the _Priority component if a Priority pragma is present

      if Present (Taskdef) and then Has_Priority_Pragma (Taskdef) then
         Append_To (Cdecls,
           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_uPriority),
             Subtype_Indication => New_Reference_To (Standard_Integer, Loc),
             Expression => New_Copy (
               Expression (First (
                 Pragma_Argument_Associations (
                   Find_Task_Or_Protected_Pragma
                     (Taskdef, Name_Priority)))))));
      end if;

      --  Add the _Task_Size component if a Storage_Size pragma is present

      if Present (Taskdef)
        and then Has_Storage_Size_Pragma (Taskdef)
      then
         Append_To (Cdecls,
           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_uSize),

             Subtype_Indication => New_Reference_To (RTE (RE_Size_Type), Loc),

             Expression =>
               Convert_To (RTE (RE_Size_Type),
                 Relocate_Node (
                   Expression (First (
                     Pragma_Argument_Associations (
                       Find_Task_Or_Protected_Pragma
                         (Taskdef, Name_Storage_Size))))))));
      end if;

      --  Add the _Task_Info component if a Priority pragma is present

      if Present (Taskdef) and then Has_Task_Info_Pragma (Taskdef) then
         Append_To (Cdecls,
           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_uTask_Info),
             Subtype_Indication =>
               New_Reference_To (RTE (RE_Task_Info_Type), Loc),
             Expression => New_Copy (
               Expression (First (
                 Pragma_Argument_Associations (
                   Find_Task_Or_Protected_Pragma
                     (Taskdef, Name_Task_Info)))))));
      end if;

      Insert_After (Size_Decl, Rec_Decl);

      --  Analyze the record declaration immediately after construction,
      --  because the initialization procedure is needed for single task
      --  declarations before the next entity is analyzed.

      Analyze (Rec_Decl);

      --  Create the declaration of the task body procedure

      Proc_Spec := Build_Task_Proc_Specification (Tasktyp);
      Body_Decl :=
        Make_Subprogram_Declaration (Loc,
          Specification => Proc_Spec);

      Insert_After (Rec_Decl, Body_Decl);

      --  Now we can freeze the corresponding record. This needs manually
      --  freezing, since it is really part of the task type, and the task
      --  type is frozen at this stage. We of course need the initialization
      --  procedure for this corresponding record type and we won't get it
      --  in time if we don't freeze now.

      declare
         L : constant List_Id := Freeze_Entity (Rec_Ent, Loc);

      begin
         if Is_Non_Empty_List (L) then
            Insert_List_After (Body_Decl, L);
         end if;
      end;

      --  Complete the expansion of access types to the current task
      --  type, if any were declared.

      Expand_Previous_Access_Type (N, Tasktyp);

      --  Expand the default parameters of entries. The default functions
      --  must be global to the task declaration (they are called externally).

      Ent := First_Entity (Tasktyp);

      while Present (Ent) loop

         if Is_Entry (Ent) then
            Make_Default_Expr_Functions (N, Ent);
         end if;

         Ent := Next_Entity (Ent);
      end loop;

   end Expand_N_Task_Type_Declaration;

   -------------------------------
   -- Expand_N_Timed_Entry_Call --
   -------------------------------

   --  The timed entry call:

   --     select
   --        T.E;
   --        S1;
   --     or
   --        Delay D;
   --        S2;
   --     end select;

   --  is expanded into an asynchronous select:

   --    declare
   --       Timed_Out : Boolean := True;
   --    begin
   --       select
   --          T.E;
   --          Timed_Out := False;
   --          S1;
   --       then abort
   --          Delay D;
   --          S2;
   --       end select;
   --       if Timed_Out then
   --          S2;
   --       end if;
   --    end

   procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
      Loc     : constant Source_Ptr := Sloc (N);
      E_Call  : constant Node_Id    := Entry_Call_Statement
                                         (Entry_Call_Alternative (N));
      E_Stats : constant List_Id    := Statements (Entry_Call_Alternative (N));
      D_Stat  : constant Node_Id    := Delay_Statement (Delay_Alternative (N));
      Stats   : constant List_Id    := Statements (Delay_Alternative (N));

      Asynch  : Node_Id;
      Blk     : Node_Id;
      T_Out   : Entity_Id := Make_Defining_Identifier
                               (Loc, New_Internal_Name ('T'));

   begin
      Asynch :=
         Make_Asynchronous_Select (Loc,
           Triggering_Alternative =>
             Make_Triggering_Alternative (Loc,
               Triggering_Statement => E_Call,
               Statements => New_List (
                 Make_Assignment_Statement (Loc,
                   Name => New_Reference_To (T_Out, Loc),
                   Expression => New_Reference_To (Standard_False, Loc)))),

           Abortable_Part =>
             Make_Abortable_Part (Loc,
               Statements =>  New_List (D_Stat)));

      Append_List (E_Stats, Statements (Triggering_Alternative (Asynch)));

      Blk :=
        Make_Block_Statement (Loc,
          Declarations => New_List (
              Make_Object_Declaration (Loc,
                Defining_Identifier => T_Out,
                Object_Definition => New_Reference_To (Standard_Boolean, Loc),
                Expression => New_Reference_To (Standard_True, Loc))),

           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc,
             Statements => New_List (
                 Asynch,
                 Make_If_Statement (Loc,
                   Condition => New_Reference_To (T_Out, Loc),
                   Then_Statements => Stats))));

      Rewrite_Substitute_Tree (N, Blk);
      Analyze (N);

   end Expand_N_Timed_Entry_Call;

   -------------------
   -- Extract_Entry --
   -------------------

   procedure Extract_Entry
     (N       : Node_Id;
      Concval : out Node_Id;
      Ename   : out Node_Id;
      Index   : out Node_Id)
   is
      Nam : constant Node_Id := Name (N);

   begin

      --  For a simple entry, the name is a selected component, with the
      --  prefix being the task value, and the selector being the entry.

      if Nkind (Nam) = N_Selected_Component then
         Concval := Prefix (Nam);
         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.

      else
         pragma Assert (Nkind (Nam) = N_Indexed_Component);
         Concval := Prefix (Prefix (Nam));
         Ename   := Selector_Name (Prefix (Nam));
         Index   := First (Expressions (Nam));
      end if;

   end Extract_Entry;

   -----------------------------------
   -- Find_Task_Or_Protected_Pragma --
   -----------------------------------

   function Find_Task_Or_Protected_Pragma
     (T    : Node_Id;
      P    : Name_Id)
      return Node_Id
   is
      N : Node_Id;

   begin
      N := First (Visible_Declarations (T));

      while Present (N) loop
         if Nkind (N) = N_Pragma then
            if Chars (N) = P then
               return N;

            elsif P = Name_Priority
              and then Chars (N) = Name_Interrupt_Priority
            then
               return N;

            else
               N := Next (N);
            end if;

         else
            N := Next (N);
         end if;
      end loop;

      N := First (Private_Declarations (T));

      while Present (N) loop
         if Nkind (N) = N_Pragma then
            if  Chars (N) = P then
               return N;

            elsif P = Name_Priority
              and then Chars (N) = Name_Interrupt_Priority
            then
               return N;
            end if;

         else
            N := Next (N);
         end if;
      end loop;

      pragma Assert (False);
      raise Program_Error;
   end Find_Task_Or_Protected_Pragma;

   -------------------------------------
   -- Make_Initialize_Protection_Call --
   -------------------------------------

   function Make_Initialize_Protection_Call
     (Protect_Rec : Entity_Id)
      return        Node_Id
   is
      Loc    : constant Source_Ptr := Sloc (Protect_Rec);
      Pdef   : Node_Id;
      Pdec   : Node_Id;
      Ptyp   : Node_Id;
      Pnam   : Name_Id;
      Args   : List_Id;

   begin
      Ptyp := Corresponding_Concurrent_Type (Protect_Rec);
      Pnam := Chars (Ptyp);

      --  Get protected declaration. In the case of a task type declaration,
      --  this is simply the parent of the protected type entity.
      --  In the single protected object
      --  declaration, this parent will be the implicit type, and we can find
      --  the corresponding single protected object declaration by
      --  searching forward in the declaration list in the tree.
      --  ??? I am not sure that the test for N_Single_Protected_Declaration
      --      is needed here. Nodes of this type should have been removed
      --      during semantic analysis.

      Pdec := Parent (Ptyp);

      while Nkind (Pdec) /= N_Protected_Type_Declaration
        and then Nkind (Pdec) /= N_Single_Protected_Declaration
      loop
         Pdec := Next (Pdec);
      end loop;

      --  Now we can find the object definition from this declaration

      Pdef := Protected_Definition (Pdec);

      --  Build the parameter list for the call. Note that _Init is the name
      --  of the formal for the object to be initialized, which is the task
      --  value record itself.

      Args := New_List;

      --  Object parameter. This is a pointer to the object of type
      --  Protection used by the GNARL to control the protected object.

      Append_To (Args,
        Make_Attribute_Reference (Loc,
          Prefix =>
            Make_Selected_Component (Loc,
              Prefix => Make_Identifier (Loc, Name_uInit),
              Selector_Name => Make_Identifier (Loc, Name_uObject)),
          Attribute_Name => Name_Unchecked_Access));

      --  Priority parameter. Set to Unspecified_Priority unless there is a
      --  priority pragma, in which case we take the value from the pragma.

      if Present (Pdef)
        and then Has_Priority_Pragma (Pdef)
      then
         Append_To (Args,
           Make_Selected_Component (Loc,
             Prefix => Make_Identifier (Loc, Name_uInit),
             Selector_Name => Make_Identifier (Loc, Name_uPriority)));

      else
         Append_To (Args,
           New_Reference_To (RTE (RE_Unspecified_Priority), Loc));
      end if;

      --  Compiler_Info parameter. This parameter allows entry body
      --  procedures and barrier functions to be called from the runtime.
      --  It is a pointer to the record generated by the compiler to
      --  represent the protected object.

      Append_To (Args,
         Make_Attribute_Reference (Loc,
           Prefix => Make_Identifier (Loc, Name_uInit),
           Attribute_Name => Name_Address));

      --  Entry_Bodies parameter. This is a pointer to an array of
      --  pointers to the entry body procedures and barrier functions
      --  of the object. If the protected type has no entries this
      --  object will not exist; in this case, pass a null.

      if Has_Entries (Ptyp) then
         Append_To (Args,
           Make_Attribute_Reference (Loc,
             Prefix => New_Reference_To (Entry_Bodies_Array (Ptyp), Loc),
             Attribute_Name => Name_Unchecked_Access));
      else
         Append_To (Args, Make_Null (Loc));
      end if;

      return
        Make_Procedure_Call_Statement (Loc,
          Name => New_Reference_To (RTE (RE_Initialize_Protection), Loc),
          Parameter_Associations => Args);

   end Make_Initialize_Protection_Call;

   ---------------------------
   -- Make_Task_Create_Call --
   ---------------------------

   function Make_Task_Create_Call (Task_Rec : Entity_Id) return Node_Id is
      Loc    : constant Source_Ptr := Sloc (Task_Rec);
      Tdef   : Node_Id;
      Tdec   : Node_Id;
      Ttyp   : Node_Id;
      Tnam   : Name_Id;
      Args   : List_Id;
      Ecount : Node_Id;

   begin
      Ttyp := Corresponding_Concurrent_Type (Task_Rec);
      Tnam := Chars (Ttyp);

      --  Get task declaration. In the case of a task type declaration, this
      --  is simply the parent of the task type entity. In the single task
      --  declaration, this parent will be the implicit type, and we can find
      --  the corresponding single task declaration by searching forward in
      --  the declaration list in the tree.
      --  ??? I am not sure that the test for N_Single_Task_Declaration
      --      is needed here. Nodes of this type should have been removed
      --      during semantic analysis.

      Tdec := Parent (Ttyp);

      while Nkind (Tdec) /= N_Task_Type_Declaration
        and then Nkind (Tdec) /= N_Single_Task_Declaration
      loop
         Tdec := Next (Tdec);
      end loop;

      --  Now we can find the task definition from this declaration

      Tdef := Task_Definition (Tdec);

      --  Build the parameter list for the call. Note that _Init is the name
      --  of the formal for the object to be initialized, which is the task
      --  value record itself.

      Args := New_List;

      --  Priority parameter. Set to Unspecified_Priority unless there is a
      --  priority pragma, in which case we take the value from the pragma.

      if Present (Tdef)
        and then Has_Priority_Pragma (Tdef)
      then
         Append_To (Args,
           Make_Selected_Component (Loc,
             Prefix => Make_Identifier (Loc, Name_uInit),
             Selector_Name => Make_Identifier (Loc, Name_uPriority)));

      else
         Append_To (Args,
           New_Reference_To (RTE (RE_Unspecified_Priority), Loc));
      end if;

      --  Size parameter. If no Storage_Size pragma is present, then
      --  the size is taken from the taskZ variable for the type, which
      --  is either Unspecified_Size, or has been reset by the use of
      --  a Storage_Size attribute definition clause. If a pragma is
      --  present, then the size is taken from the _Size field of the
      --  task value record, which was set from the pragma value.

      if Present (Tdef)
        and then Has_Storage_Size_Pragma (Tdef)
      then
         Append_To (Args,
           Make_Selected_Component (Loc,
             Prefix => Make_Identifier (Loc, Name_uInit),
             Selector_Name => Make_Identifier (Loc, Name_uSize)));

      else
         Append_To (Args,
           New_Reference_To (Storage_Size_Variable (Ttyp), Loc));
      end if;

      --  Task_Info parameter. Set to Unspecified_Task_Info unless there is a
      --  Task_Info pragma, in which case we take the value from the pragma.

      if Present (Tdef)
        and then Has_Task_Info_Pragma (Tdef)
      then
         Append_To (Args,
           Make_Selected_Component (Loc,
             Prefix => Make_Identifier (Loc, Name_uInit),
             Selector_Name => Make_Identifier (Loc, Name_uTask_Info)));

      else
         Append_To (Args,
           New_Reference_To (RTE (RE_Unspecified_Task_Info), Loc));
      end if;

      --  Number of entries. This is an expression of the form:
      --
      --    n + _Init.a'Length + _Init.a'B'Length + ...
      --
      --  where a,b... are the entry family names for the task definition

      Ecount := Build_Entry_Count_Expression (
        Ttyp,
        Component_Items (Component_List (
          Type_Definition (Parent (
            Corresponding_Record_Type (Ttyp))))),
        Loc);
      Append_To (Args, Ecount);

      --  Master parameter. This is a reference to the _Master parameter of
      --  the initialization procedure.

      Append_To (Args, Make_Identifier (Loc, Name_uMaster));

      --  State parameter. This is a pointer to the task body procedure. The
      --  required value is obtained by taking the address of the task body
      --  procedure and converting it (with an unchecked conversion) to the
      --  type required by the task kernel. For further details, see the
      --  description of Expand_Task_Body

      Append_To (Args,
        Unchecked_Convert_To (RTE (RE_Task_Procedure_Access),
          Make_Attribute_Reference (Loc,
            Prefix => New_Occurrence_Of (Task_Body_Procedure (Ttyp), Loc),
            Attribute_Name => Name_Address)));

      --  Discriminants parameter. This is just the address of the task
      --  value record itself (which contains the discriminant values

      Append_To (Args,
        Make_Attribute_Reference (Loc,
          Prefix => Make_Identifier (Loc, Name_uInit),
          Attribute_Name => Name_Address));

      --  Elaborated parameter. This is an access to the elaboration Boolean

      Append_To (Args,
        Make_Attribute_Reference (Loc,
          Prefix => Make_Identifier (Loc, New_External_Name (Tnam, 'E')),
          Attribute_Name => Name_Unchecked_Access));

      --  Chain parameter. This is a reference to the _Chain parameter of
      --  the initialization procedure.

      Append_To (Args, Make_Identifier (Loc, Name_uChain));

      --  Created_Task parameter. This is the _Task_Id field of the task
      --  record value

      Append_To (Args,
        Make_Selected_Component (Loc,
          Prefix => Make_Identifier (Loc, Name_uInit),
          Selector_Name => Make_Identifier (Loc, Name_uTask_Id)));

      return
        Make_Procedure_Call_Statement (Loc,
          Name => New_Reference_To (RTE (RE_Create_Task), Loc),
          Parameter_Associations => Args);

   end Make_Task_Create_Call;

   ----------------------
   -- Set_Discriminals --
   ----------------------

   procedure Set_Discriminals
     (Dec : Node_Id;
      Op  : Node_Id;
      Loc : Source_Ptr)
   is
      D       : Entity_Id;
      Pdef    : Entity_Id;
      D_Minal : Entity_Id;

   begin
      pragma Assert (Nkind (Dec) = N_Protected_Type_Declaration);
      Pdef := Defining_Identifier (Dec);

      if Has_Discriminants (Pdef) then
         D := First_Discriminant (Pdef);

         while Present (D) loop
            D_Minal :=
              Make_Defining_Identifier (Sloc (D),
                Chars => New_External_Name (Chars (D), 'D'));

            Set_Ekind (D_Minal, E_Constant);
            Set_Etype (D_Minal, Etype (D));
            Set_Discriminal (D, D_Minal);

            D := Next_Discriminant (D);
         end loop;
      end if;
   end Set_Discriminals;

   -----------------
   -- Set_Privals --
   -----------------

   procedure Set_Privals
      (Dec : Node_Id;
       Op  : Node_Id;
       Loc : Source_Ptr)
   is
      P_Decl    : Node_Id;
      P_Id      : Entity_Id;
      Priv      : Entity_Id;
      Def       : Node_Id;
      Body_Ent  : Entity_Id;
      Prec_Decl : constant Node_Id :=
                    Parent (Corresponding_Record_Type
                             (Defining_Identifier (Dec)));
      Prec_Def  : constant Entity_Id := Type_Definition (Prec_Decl);
      Obj_Decl  : Node_Id;
      P_Subtype : Entity_Id;
      New_Decl  : Entity_Id;
      Assoc_L   : Elist_Id := New_Elmt_List;

   begin
      pragma Assert (Nkind (Dec) = N_Protected_Type_Declaration);
      pragma Assert
        (Nkind (Op) = N_Subprogram_Body or else Nkind (Op) = N_Entry_Body);

      Def := Protected_Definition (Dec);

      if Present (Private_Declarations (Def)) then

         P_Decl := First (Private_Declarations (Def));

         while Present (P_Decl) loop
            if Nkind (P_Decl) = N_Component_Declaration then
               P_Id := Defining_Identifier (P_Decl);
               Priv :=
                 Make_Defining_Identifier (Loc,
                   New_External_Name (Chars (P_Id), 'P'));

               Set_Ekind (Priv, E_Variable);
               Set_Etype (Priv, Etype (P_Id));
               Set_Scope (Priv, Scope (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 Is_Itype (Etype (P_Id)) then
                  Append_Elmt (P_Id, Assoc_L);
                  Append_Elmt (Priv, Assoc_L);
                  New_Decl := New_Copy_Tree (P_Decl, Assoc_L);
               end if;

               Set_Protected_Operation (P_Id, Op);
               Set_Prival (P_Id, Priv);
            end if;

            P_Decl := Next (P_Decl);
         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.

      Body_Ent := Corresponding_Body (Dec);

      Priv :=
        Make_Defining_Identifier (Sloc (Body_Ent),
          Chars => New_External_Name (Chars (Body_Ent), 'R'));

      --  Set the Etype to the implicit subtype of Protection created when
      --  the protected type declaration was expanded. This node will not
      --  be analyzed until it is used as the defining identifier for the
      --  renaming declaration in the protected operation body, and it will
      --  be needed in the references expanded before that body is expanded.
      --  Since the Protection field is aliased, set Is_Aliased as well.

      Obj_Decl := First (Component_Items (Component_List (Prec_Def)));
      while Chars (Defining_Identifier (Obj_Decl)) /= Name_uObject loop
         Obj_Decl := Next (Obj_Decl);
      end loop;
      P_Subtype  := Etype (Defining_Identifier (Obj_Decl));
      Set_Etype (Priv, P_Subtype);
      Set_Is_Aliased (Priv);
      Set_Object_Ref (Body_Ent, Priv);

   end Set_Privals;

   ----------------------------
   -- Update_Prival_Subtypes --
   ----------------------------

   procedure Update_Prival_Subtypes (D : Union_Id) is
      use Atree.Unchecked_Access;

   begin
      if D in Node_Range then
         if D = Union_Id (Empty) then
            null;

         elsif Is_Entity_Name (Node_Id (D))  then
            declare
               E : Entity_Id := Entity (Node_Id (D));

            begin
               if Present (E)
                 and then (Ekind (E) = E_Constant
                            or else Ekind (E) = E_Variable)
                 and then not Is_Scalar_Type (Etype (E))
                 and then Etype (Node_Id (D)) /= Etype (E)
               then
                  Set_Etype (Node_Id (D),
                    Etype (Entity (Original_Node (Node_Id (D)))));
               end if;
            end;

         elsif Nkind (Node_Id (D)) = N_Defining_Identifier
           or else Nkind (Node_Id (D)) = N_Defining_Operator_Symbol
           or else Nkind (Node_Id (D)) = N_Defining_Character_Literal
         then
            null;

         else
            Update_Prival_Subtypes (Field1 (Node_Id (D)));
            Update_Prival_Subtypes (Field2 (Node_Id (D)));
            Update_Prival_Subtypes (Field3 (Node_Id (D)));
            Update_Prival_Subtypes (Field4 (Node_Id (D)));
            Update_Prival_Subtypes (Field5 (Node_Id (D)));
         end if;

      elsif D in List_Range then
         if D = Union_Id (No_List)
           or else Is_Empty_List (List_Id (D))
         then
            null;

         else
            declare
               N1 : Node_Id := First (List_Id (D));

            begin
               while Present (N1) loop
                  Update_Prival_Subtypes (Union_Id (N1));
                  N1 := Next (N1);
               end loop;
            end;
         end if;

      elsif D in Elist_Range then
         if D = Union_Id (No_Elist) then
            null;

         else
            declare
               E1 : Elmt_Id := First_Elmt (Elist_Id (D));

            begin
               while Present (E1) loop
                  Update_Prival_Subtypes (Union_Id (Node (E1)));
                  E1 := Next_Elmt (E1);
               end loop;
            end;
         end if;

      --  Literal or other non-node field, nothing to do

      else
         null;
      end if;
   end Update_Prival_Subtypes;

end Exp_Ch9;
