Merged trunk at revision 161680 into branch.

[official-gcc.git] / gcc / ada / exp_dist.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              E X P_ D I S T                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2010, 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 3,  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 COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Atree;    use Atree;
with Einfo;    use Einfo;
with Elists;   use Elists;
with Exp_Atag; use Exp_Atag;
with Exp_Disp; use Exp_Disp;
with Exp_Strm; use Exp_Strm;
with Exp_Tss;  use Exp_Tss;
with Exp_Util; use Exp_Util;
with Lib;      use Lib;
with Nlists;   use Nlists;
with Nmake;    use Nmake;
with Opt;      use Opt;
with Rtsfind;  use Rtsfind;
with Sem;      use Sem;
with Sem_Aux;  use Sem_Aux;
with Sem_Cat;  use Sem_Cat;
with Sem_Ch3;  use Sem_Ch3;
with Sem_Ch8;  use Sem_Ch8;
with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo;    use Sinfo;
with Stand;    use Stand;
with Stringt;  use Stringt;
with Tbuild;   use Tbuild;
with Ttypes;   use Ttypes;
with Uintp;    use Uintp;

with GNAT.HTable; use GNAT.HTable;

package body Exp_Dist is

   --  The following model has been used to implement distributed objects:
   --  given a designated type D and a RACW type R, then a record of the form:

   --    type Stub is tagged record
   --       [...declaration similar to s-parint.ads RACW_Stub_Type...]
   --    end record;

   --  is built. This type has two properties:

   --    1) Since it has the same structure as RACW_Stub_Type, it can
   --       be converted to and from this type to make it suitable for
   --       System.Partition_Interface.Get_Unique_Remote_Pointer in order
   --       to avoid memory leaks when the same remote object arrives on the
   --       same partition through several paths;

   --    2) It also has the same dispatching table as the designated type D,
   --       and thus can be used as an object designated by a value of type
   --       R on any partition other than the one on which the object has
   --       been created, since only dispatching calls will be performed and
   --       the fields themselves will not be used. We call Derive_Subprograms
   --       to fake half a derivation to ensure that the subprograms do have
   --       the same dispatching table.

   First_RCI_Subprogram_Id : constant := 2;
   --  RCI subprograms are numbered starting at 2. The RCI receiver for
   --  an RCI package can thus identify calls received through remote
   --  access-to-subprogram dereferences by the fact that they have a
   --  (primitive) subprogram id of 0, and 1 is used for the internal RAS
   --  information lookup operation. (This is for the Garlic code generation,
   --  where subprograms are identified by numbers; in the PolyORB version,
   --  they are identified by name, with a numeric suffix for homonyms.)

   type Hash_Index is range 0 .. 50;

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

   function Hash (F : Entity_Id) return Hash_Index;
   --  DSA expansion associates stubs to distributed object types using a hash
   --  table on entity ids.

   function Hash (F : Name_Id) return Hash_Index;
   --  The generation of subprogram identifiers requires an overload counter
   --  to be associated with each remote subprogram name. These counters are
   --  maintained in a hash table on name ids.

   type Subprogram_Identifiers is record
      Str_Identifier : String_Id;
      Int_Identifier : Int;
   end record;

   package Subprogram_Identifier_Table is
      new Simple_HTable (Header_Num => Hash_Index,
                         Element    => Subprogram_Identifiers,
                         No_Element => (No_String, 0),
                         Key        => Entity_Id,
                         Hash       => Hash,
                         Equal      => "=");
   --  Mapping between a remote subprogram and the corresponding subprogram
   --  identifiers.

   package Overload_Counter_Table is
      new Simple_HTable (Header_Num => Hash_Index,
                         Element    => Int,
                         No_Element => 0,
                         Key        => Name_Id,
                         Hash       => Hash,
                         Equal      => "=");
   --  Mapping between a subprogram name and an integer that counts the number
   --  of defining subprogram names with that Name_Id encountered so far in a
   --  given context (an interface).

   function Get_Subprogram_Ids (Def : Entity_Id) return Subprogram_Identifiers;
   function Get_Subprogram_Id  (Def : Entity_Id) return String_Id;
   function Get_Subprogram_Id  (Def : Entity_Id) return Int;
   --  Given a subprogram defined in a RCI package, get its distribution
   --  subprogram identifiers (the distribution identifiers are a unique
   --  subprogram number, and the non-qualified subprogram name, in the
   --  casing used for the subprogram declaration; if the name is overloaded,
   --  a double underscore and a serial number are appended.
   --
   --  The integer identifier is used to perform remote calls with GARLIC;
   --  the string identifier is used in the case of PolyORB.
   --
   --  Although the PolyORB DSA receiving stubs will make a caseless comparison
   --  when receiving a call, the calling stubs will create requests with the
   --  exact casing of the defining unit name of the called subprogram, so as
   --  to allow calls to subprograms on distributed nodes that do distinguish
   --  between casings.
   --
   --  NOTE: Another design would be to allow a representation clause on
   --  subprogram specs: for Subp'Distribution_Identifier use "fooBar";

   pragma Warnings (Off, Get_Subprogram_Id);
   --  One homonym only is unreferenced (specific to the GARLIC version)

   procedure Add_RAS_Dereference_TSS (N : Node_Id);
   --  Add a subprogram body for RAS Dereference TSS

   procedure Add_RAS_Proxy_And_Analyze
     (Decls              : List_Id;
      Vis_Decl           : Node_Id;
      All_Calls_Remote_E : Entity_Id;
      Proxy_Object_Addr  : out Entity_Id);
   --  Add the proxy type required, on the receiving (server) side, to handle
   --  calls to the subprogram declared by Vis_Decl through a remote access
   --  to subprogram type. All_Calls_Remote_E must be Standard_True if a pragma
   --  All_Calls_Remote applies, Standard_False otherwise. The new proxy type
   --  is appended to Decls. Proxy_Object_Addr is a constant of type
   --  System.Address that designates an instance of the proxy object.

   function Build_Remote_Subprogram_Proxy_Type
     (Loc            : Source_Ptr;
      ACR_Expression : Node_Id) return Node_Id;
   --  Build and return a tagged record type definition for an RCI subprogram
   --  proxy type. ACR_Expression is used as the initialization value for the
   --  All_Calls_Remote component.

   function Build_Get_Unique_RP_Call
     (Loc       : Source_Ptr;
      Pointer   : Entity_Id;
      Stub_Type : Entity_Id) return List_Id;
   --  Build a call to Get_Unique_Remote_Pointer (Pointer), followed by a
   --  tag fixup (Get_Unique_Remote_Pointer may have changed Pointer'Tag to
   --  RACW_Stub_Type'Tag, while the desired tag is that of Stub_Type).

   function Build_Stub_Tag
     (Loc       : Source_Ptr;
      RACW_Type : Entity_Id) return Node_Id;
   --  Return an expression denoting the tag of the stub type associated with
   --  RACW_Type.

   function Build_Subprogram_Calling_Stubs
     (Vis_Decl                 : Node_Id;
      Subp_Id                  : Node_Id;
      Asynchronous             : Boolean;
      Dynamically_Asynchronous : Boolean   := False;
      Stub_Type                : Entity_Id := Empty;
      RACW_Type                : Entity_Id := Empty;
      Locator                  : Entity_Id := Empty;
      New_Name                 : Name_Id   := No_Name) return Node_Id;
   --  Build the calling stub for a given subprogram with the subprogram ID
   --  being Subp_Id. If Stub_Type is given, then the "addr" field of
   --  parameters of this type will be marshalled instead of the object itself.
   --  It will then be converted into Stub_Type before performing the real
   --  call. If Dynamically_Asynchronous is True, then it will be computed at
   --  run time whether the call is asynchronous or not. Otherwise, the value
   --  of the formal Asynchronous will be used. If Locator is not Empty, it
   --  will be used instead of RCI_Cache. If New_Name is given, then it will
   --  be used instead of the original name.

   function Build_RPC_Receiver_Specification
     (RPC_Receiver      : Entity_Id;
      Request_Parameter : Entity_Id) return Node_Id;
   --  Make a subprogram specification for an RPC receiver, with the given
   --  defining unit name and formal parameter.

   function Build_Ordered_Parameters_List (Spec : Node_Id) return List_Id;
   --  Return an ordered parameter list: unconstrained parameters are put
   --  at the beginning of the list and constrained ones are put after. If
   --  there are no parameters, an empty list is returned. Special case:
   --  the controlling formal of the equivalent RACW operation for a RAS
   --  type is always left in first position.

   function Transmit_As_Unconstrained (Typ : Entity_Id) return Boolean;
   --  True when Typ is an unconstrained type, or a null-excluding access type.
   --  In either case, this means stubs cannot contain a default-initialized
   --  object declaration of such type.

   procedure Add_Calling_Stubs_To_Declarations
     (Pkg_Spec : Node_Id;
      Decls    : List_Id);
   --  Add calling stubs to the declarative part

   function Could_Be_Asynchronous (Spec : Node_Id) return Boolean;
   --  Return True if nothing prevents the program whose specification is
   --  given to be asynchronous (i.e. no [IN] OUT parameters).

   function Pack_Entity_Into_Stream_Access
     (Loc    : Source_Ptr;
      Stream : Node_Id;
      Object : Entity_Id;
      Etyp   : Entity_Id := Empty) return Node_Id;
   --  Pack Object (of type Etyp) into Stream. If Etyp is not given,
   --  then Etype (Object) will be used if present. If the type is
   --  constrained, then 'Write will be used to output the object,
   --  If the type is unconstrained, 'Output will be used.

   function Pack_Node_Into_Stream
     (Loc    : Source_Ptr;
      Stream : Entity_Id;
      Object : Node_Id;
      Etyp   : Entity_Id) return Node_Id;
   --  Similar to above, with an arbitrary node instead of an entity

   function Pack_Node_Into_Stream_Access
     (Loc    : Source_Ptr;
      Stream : Node_Id;
      Object : Node_Id;
      Etyp   : Entity_Id) return Node_Id;
   --  Similar to above, with Stream instead of Stream'Access

   function Make_Selected_Component
     (Loc           : Source_Ptr;
      Prefix        : Entity_Id;
      Selector_Name : Name_Id) return Node_Id;
   --  Return a selected_component whose prefix denotes the given entity, and
   --  with the given Selector_Name.

   function Scope_Of_Spec (Spec : Node_Id) return Entity_Id;
   --  Return the scope represented by a given spec

   procedure Set_Renaming_TSS
     (Typ     : Entity_Id;
      Nam     : Entity_Id;
      TSS_Nam : TSS_Name_Type);
   --  Create a renaming declaration of subprogram Nam, and register it as a
   --  TSS for Typ with name TSS_Nam.

   function Need_Extra_Constrained (Parameter : Node_Id) return Boolean;
   --  Return True if the current parameter needs an extra formal to reflect
   --  its constrained status.

   function Is_RACW_Controlling_Formal
     (Parameter : Node_Id;
      Stub_Type : Entity_Id) return Boolean;
   --  Return True if the current parameter is a controlling formal argument
   --  of type Stub_Type or access to Stub_Type.

   procedure Declare_Create_NVList
     (Loc    : Source_Ptr;
      NVList : Entity_Id;
      Decls  : List_Id;
      Stmts  : List_Id);
   --  Append the declaration of NVList to Decls, and its
   --  initialization to Stmts.

   function Add_Parameter_To_NVList
     (Loc         : Source_Ptr;
      NVList      : Entity_Id;
      Parameter   : Entity_Id;
      Constrained : Boolean;
      RACW_Ctrl   : Boolean := False;
      Any         : Entity_Id) return Node_Id;
   --  Return a call to Add_Item to add the Any corresponding to the designated
   --  formal Parameter (with the indicated Constrained status) to NVList.
   --  RACW_Ctrl must be set to True for controlling formals of distributed
   --  object primitive operations.

   --------------------
   -- Stub_Structure --
   --------------------

   --  This record describes various tree fragments associated with the
   --  generation of RACW calling stubs. One such record exists for every
   --  distributed object type, i.e. each tagged type that is the designated
   --  type of one or more RACW type.

   type Stub_Structure is record
      Stub_Type         : Entity_Id;
      --  Stub type: this type has the same primitive operations as the
      --  designated types, but the provided bodies for these operations
      --  a remote call to an actual target object potentially located on
      --  another partition; each value of the stub type encapsulates a
      --  reference to a remote object.

      Stub_Type_Access  : Entity_Id;
      --  A local access type designating the stub type (this is not an RACW
      --  type).

      RPC_Receiver_Decl : Node_Id;
      --  Declaration for the RPC receiver entity associated with the
      --  designated type. As an exception, for the case of an RACW that
      --  implements a RAS, no object RPC receiver is generated. Instead,
      --  RPC_Receiver_Decl is the declaration after which the RPC receiver
      --  would have been inserted.

      Body_Decls        : List_Id;
      --  List of subprogram bodies to be included in generated code: bodies
      --  for the RACW's stream attributes, and for the primitive operations
      --  of the stub type.

      RACW_Type         : Entity_Id;
      --  One of the RACW types designating this distributed object type
      --  (they are all interchangeable; we use any one of them in order to
      --  avoid having to create various anonymous access types).

   end record;

   Empty_Stub_Structure : constant Stub_Structure :=
     (Empty, Empty, Empty, No_List, Empty);

   package Stubs_Table is
      new Simple_HTable (Header_Num => Hash_Index,
                         Element    => Stub_Structure,
                         No_Element => Empty_Stub_Structure,
                         Key        => Entity_Id,
                         Hash       => Hash,
                         Equal      => "=");
   --  Mapping between a RACW designated type and its stub type

   package Asynchronous_Flags_Table is
      new Simple_HTable (Header_Num => Hash_Index,
                         Element    => Entity_Id,
                         No_Element => Empty,
                         Key        => Entity_Id,
                         Hash       => Hash,
                         Equal      => "=");
   --  Mapping between a RACW type and a constant having the value True
   --  if the RACW is asynchronous and False otherwise.

   package RCI_Locator_Table is
      new Simple_HTable (Header_Num => Hash_Index,
                         Element    => Entity_Id,
                         No_Element => Empty,
                         Key        => Entity_Id,
                         Hash       => Hash,
                         Equal      => "=");
   --  Mapping between a RCI package on which All_Calls_Remote applies and
   --  the generic instantiation of RCI_Locator for this package.

   package RCI_Calling_Stubs_Table is
      new Simple_HTable (Header_Num => Hash_Index,
                         Element    => Entity_Id,
                         No_Element => Empty,
                         Key        => Entity_Id,
                         Hash       => Hash,
                         Equal      => "=");
   --  Mapping between a RCI subprogram and the corresponding calling stubs

   function Get_Stub_Elements (RACW_Type : Entity_Id) return Stub_Structure;
   --  Return the stub information associated with the given RACW type

   procedure Add_Stub_Type
     (Designated_Type   : Entity_Id;
      RACW_Type         : Entity_Id;
      Decls             : List_Id;
      Stub_Type         : out Entity_Id;
      Stub_Type_Access  : out Entity_Id;
      RPC_Receiver_Decl : out Node_Id;
      Body_Decls        : out List_Id;
      Existing          : out Boolean);
   --  Add the declaration of the stub type, the access to stub type and the
   --  object RPC receiver at the end of Decls. If these already exist,
   --  then nothing is added in the tree but the right values are returned
   --  anyhow and Existing is set to True.

   function Get_And_Reset_RACW_Bodies (RACW_Type : Entity_Id) return List_Id;
   --  Retrieve the Body_Decls list associated to RACW_Type in the stub
   --  structure table, reset it to No_List, and return the previous value.

   procedure Add_RACW_Asynchronous_Flag
     (Declarations : List_Id;
      RACW_Type    : Entity_Id);
   --  Declare a boolean constant associated with RACW_Type whose value
   --  indicates at run time whether a pragma Asynchronous applies to it.

   procedure Assign_Subprogram_Identifier
     (Def : Entity_Id;
      Spn : Int;
      Id  : out String_Id);
   --  Determine the distribution subprogram identifier to
   --  be used for remote subprogram Def, return it in Id and
   --  store it in a hash table for later retrieval by
   --  Get_Subprogram_Id. Spn is the subprogram number.

   function RCI_Package_Locator
     (Loc          : Source_Ptr;
      Package_Spec : Node_Id) return Node_Id;
   --  Instantiate the generic package RCI_Locator in order to locate the
   --  RCI package whose spec is given as argument.

   function Make_Tag_Check (Loc : Source_Ptr; N : Node_Id) return Node_Id;
   --  Surround a node N by a tag check, as in:
   --      begin
   --         <N>;
   --      exception
   --         when E : Ada.Tags.Tag_Error =>
   --           Raise_Exception (Program_Error'Identity,
   --                            Exception_Message (E));
   --      end;

   function Input_With_Tag_Check
     (Loc      : Source_Ptr;
      Var_Type : Entity_Id;
      Stream   : Node_Id) return Node_Id;
   --  Return a function with the following form:
   --    function R return Var_Type is
   --    begin
   --       return Var_Type'Input (S);
   --    exception
   --       when E : Ada.Tags.Tag_Error =>
   --           Raise_Exception (Program_Error'Identity,
   --                            Exception_Message (E));
   --    end R;

   procedure Build_Actual_Object_Declaration
     (Object   : Entity_Id;
      Etyp     : Entity_Id;
      Variable : Boolean;
      Expr     : Node_Id;
      Decls    : List_Id);
   --  Build the declaration of an object with the given defining identifier,
   --  initialized with Expr if provided, to serve as actual parameter in a
   --  server stub. If Variable is true, the declared object will be a variable
   --  (case of an out or in out formal), else it will be a constant. Object's
   --  Ekind is set accordingly. The declaration, as well as any other
   --  declarations it requires, are appended to Decls.

   --------------------------------------------
   -- Hooks for PCS-specific code generation --
   --------------------------------------------

   --  Part of the code generation circuitry for distribution needs to be
   --  tailored for each implementation of the PCS. For each routine that
   --  needs to be specialized, a Specific_<routine> wrapper is created,
   --  which calls the corresponding <routine> in package
   --  <pcs_implementation>_Support.

   procedure Specific_Add_RACW_Features
     (RACW_Type           : Entity_Id;
      Desig               : Entity_Id;
      Stub_Type           : Entity_Id;
      Stub_Type_Access    : Entity_Id;
      RPC_Receiver_Decl   : Node_Id;
      Body_Decls          : List_Id);
   --  Add declaration for TSSs for a given RACW type. The declarations are
   --  added just after the declaration of the RACW type itself. If the RACW
   --  appears in the main unit, Body_Decls is a list of declarations to which
   --  the bodies are appended. Else Body_Decls is No_List.
   --  PCS-specific ancillary subprogram for Add_RACW_Features.

   procedure Specific_Add_RAST_Features
     (Vis_Decl : Node_Id;
      RAS_Type : Entity_Id);
   --  Add declaration for TSSs for a given RAS type. PCS-specific ancillary
   --  subprogram for Add_RAST_Features.

   --  An RPC_Target record is used during construction of calling stubs
   --  to pass PCS-specific tree fragments corresponding to the information
   --  necessary to locate the target of a remote subprogram call.

   type RPC_Target (PCS_Kind : PCS_Names) is record
      case PCS_Kind is
         when Name_PolyORB_DSA =>
            Object : Node_Id;
            --  An expression whose value is a PolyORB reference to the target
            --  object.

         when others           =>
            Partition : Entity_Id;
            --  A variable containing the Partition_ID of the target partition

            RPC_Receiver : Node_Id;
            --  An expression whose value is the address of the target RPC
            --  receiver.
      end case;
   end record;

   procedure Specific_Build_General_Calling_Stubs
     (Decls                     : List_Id;
      Statements                : List_Id;
      Target                    : RPC_Target;
      Subprogram_Id             : Node_Id;
      Asynchronous              : Node_Id := Empty;
      Is_Known_Asynchronous     : Boolean := False;
      Is_Known_Non_Asynchronous : Boolean := False;
      Is_Function               : Boolean;
      Spec                      : Node_Id;
      Stub_Type                 : Entity_Id := Empty;
      RACW_Type                 : Entity_Id := Empty;
      Nod                       : Node_Id);
   --  Build calling stubs for general purpose. The parameters are:
   --    Decls             : a place to put declarations
   --    Statements        : a place to put statements
   --    Target            : PCS-specific target information (see details
   --                        in RPC_Target declaration).
   --    Subprogram_Id     : a node containing the subprogram ID
   --    Asynchronous      : True if an APC must be made instead of an RPC.
   --                        The value needs not be supplied if one of the
   --                        Is_Known_... is True.
   --    Is_Known_Async... : True if we know that this is asynchronous
   --    Is_Known_Non_A... : True if we know that this is not asynchronous
   --    Spec              : a node with a Parameter_Specifications and
   --                        a Result_Definition if applicable
   --    Stub_Type         : in case of RACW stubs, parameters of type access
   --                        to Stub_Type will be marshalled using the
   --                        address of the object (the addr field) rather
   --                        than using the 'Write on the stub itself
   --    Nod               : used to provide sloc for generated code

   function Specific_Build_Stub_Target
     (Loc                   : Source_Ptr;
      Decls                 : List_Id;
      RCI_Locator           : Entity_Id;
      Controlling_Parameter : Entity_Id) return RPC_Target;
   --  Build call target information nodes for use within calling stubs. In the
   --  RCI case, RCI_Locator is the entity for the instance of RCI_Locator. If
   --  for an RACW, Controlling_Parameter is the entity for the controlling
   --  formal parameter used to determine the location of the target of the
   --  call. Decls provides a location where variable declarations can be
   --  appended to construct the necessary values.

   procedure Specific_Build_Stub_Type
     (RACW_Type         : Entity_Id;
      Stub_Type_Comps   : out List_Id;
      RPC_Receiver_Decl : out Node_Id);
   --  Build a components list for the stub type associated with an RACW type,
   --  and build the necessary RPC receiver, if applicable. PCS-specific
   --  ancillary subprogram for Add_Stub_Type. If no RPC receiver declaration
   --  is generated, then RPC_Receiver_Decl is set to Empty.

   procedure Specific_Build_RPC_Receiver_Body
     (RPC_Receiver : Entity_Id;
      Request      : out Entity_Id;
      Subp_Id      : out Entity_Id;
      Subp_Index   : out Entity_Id;
      Stmts        : out List_Id;
      Decl         : out Node_Id);
   --  Make a subprogram body for an RPC receiver, with the given
   --  defining unit name. On return:
   --    - Subp_Id is the subprogram identifier from the PCS.
   --    - Subp_Index is the index in the list of subprograms
   --      used for dispatching (a variable of type Subprogram_Id).
   --    - Stmts is the place where the request dispatching
   --      statements can occur,
   --    - Decl is the subprogram body declaration.

   function Specific_Build_Subprogram_Receiving_Stubs
     (Vis_Decl                 : Node_Id;
      Asynchronous             : Boolean;
      Dynamically_Asynchronous : Boolean   := False;
      Stub_Type                : Entity_Id := Empty;
      RACW_Type                : Entity_Id := Empty;
      Parent_Primitive         : Entity_Id := Empty) return Node_Id;
   --  Build the receiving stub for a given subprogram. The subprogram
   --  declaration is also built by this procedure, and the value returned
   --  is a N_Subprogram_Body. If a parameter of type access to Stub_Type is
   --  found in the specification, then its address is read from the stream
   --  instead of the object itself and converted into an access to
   --  class-wide type before doing the real call using any of the RACW type
   --  pointing on the designated type.

   procedure Specific_Add_Obj_RPC_Receiver_Completion
     (Loc           : Source_Ptr;
      Decls         : List_Id;
      RPC_Receiver  : Entity_Id;
      Stub_Elements : Stub_Structure);
   --  Add the necessary code to Decls after the completion of generation
   --  of the RACW RPC receiver described by Stub_Elements.

   procedure Specific_Add_Receiving_Stubs_To_Declarations
     (Pkg_Spec : Node_Id;
      Decls    : List_Id;
      Stmts    : List_Id);
   --  Add receiving stubs to the declarative part of an RCI unit

   --------------------
   -- GARLIC_Support --
   --------------------

   package GARLIC_Support is

      --  Support for generating DSA code that uses the GARLIC PCS

      --  The subprograms below provide the GARLIC versions of the
      --  corresponding Specific_<subprogram> routine declared above.

      procedure Add_RACW_Features
        (RACW_Type         : Entity_Id;
         Stub_Type         : Entity_Id;
         Stub_Type_Access  : Entity_Id;
         RPC_Receiver_Decl : Node_Id;
         Body_Decls        : List_Id);

      procedure Add_RAST_Features
        (Vis_Decl : Node_Id;
         RAS_Type : Entity_Id);

      procedure Build_General_Calling_Stubs
        (Decls                     : List_Id;
         Statements                : List_Id;
         Target_Partition          : Entity_Id; --  From RPC_Target
         Target_RPC_Receiver       : Node_Id;   --  From RPC_Target
         Subprogram_Id             : Node_Id;
         Asynchronous              : Node_Id := Empty;
         Is_Known_Asynchronous     : Boolean := False;
         Is_Known_Non_Asynchronous : Boolean := False;
         Is_Function               : Boolean;
         Spec                      : Node_Id;
         Stub_Type                 : Entity_Id := Empty;
         RACW_Type                 : Entity_Id := Empty;
         Nod                       : Node_Id);

      function Build_Stub_Target
        (Loc                   : Source_Ptr;
         Decls                 : List_Id;
         RCI_Locator           : Entity_Id;
         Controlling_Parameter : Entity_Id) return RPC_Target;

      procedure Build_Stub_Type
        (RACW_Type         : Entity_Id;
         Stub_Type_Comps   : out List_Id;
         RPC_Receiver_Decl : out Node_Id);

      function Build_Subprogram_Receiving_Stubs
        (Vis_Decl                 : Node_Id;
         Asynchronous             : Boolean;
         Dynamically_Asynchronous : Boolean   := False;
         Stub_Type                : Entity_Id := Empty;
         RACW_Type                : Entity_Id := Empty;
         Parent_Primitive         : Entity_Id := Empty) return Node_Id;

      procedure Add_Obj_RPC_Receiver_Completion
        (Loc           : Source_Ptr;
         Decls         : List_Id;
         RPC_Receiver  : Entity_Id;
         Stub_Elements : Stub_Structure);

      procedure Add_Receiving_Stubs_To_Declarations
        (Pkg_Spec : Node_Id;
         Decls    : List_Id;
         Stmts    : List_Id);

      procedure Build_RPC_Receiver_Body
        (RPC_Receiver : Entity_Id;
         Request      : out Entity_Id;
         Subp_Id      : out Entity_Id;
         Subp_Index   : out Entity_Id;
         Stmts        : out List_Id;
         Decl         : out Node_Id);

   end GARLIC_Support;

   ---------------------
   -- PolyORB_Support --
   ---------------------

   package PolyORB_Support is

      --  Support for generating DSA code that uses the PolyORB PCS

      --  The subprograms below provide the PolyORB versions of the
      --  corresponding Specific_<subprogram> routine declared above.

      procedure Add_RACW_Features
        (RACW_Type         : Entity_Id;
         Desig             : Entity_Id;
         Stub_Type         : Entity_Id;
         Stub_Type_Access  : Entity_Id;
         RPC_Receiver_Decl : Node_Id;
         Body_Decls        : List_Id);

      procedure Add_RAST_Features
        (Vis_Decl : Node_Id;
         RAS_Type : Entity_Id);

      procedure Build_General_Calling_Stubs
        (Decls                     : List_Id;
         Statements                : List_Id;
         Target_Object             : Node_Id; --  From RPC_Target
         Subprogram_Id             : Node_Id;
         Asynchronous              : Node_Id := Empty;
         Is_Known_Asynchronous     : Boolean := False;
         Is_Known_Non_Asynchronous : Boolean := False;
         Is_Function               : Boolean;
         Spec                      : Node_Id;
         Stub_Type                 : Entity_Id := Empty;
         RACW_Type                 : Entity_Id := Empty;
         Nod                       : Node_Id);

      function Build_Stub_Target
        (Loc                   : Source_Ptr;
         Decls                 : List_Id;
         RCI_Locator           : Entity_Id;
         Controlling_Parameter : Entity_Id) return RPC_Target;

      procedure Build_Stub_Type
        (RACW_Type         : Entity_Id;
         Stub_Type_Comps   : out List_Id;
         RPC_Receiver_Decl : out Node_Id);

      function Build_Subprogram_Receiving_Stubs
        (Vis_Decl                 : Node_Id;
         Asynchronous             : Boolean;
         Dynamically_Asynchronous : Boolean   := False;
         Stub_Type                : Entity_Id := Empty;
         RACW_Type                : Entity_Id := Empty;
         Parent_Primitive         : Entity_Id := Empty) return Node_Id;

      procedure Add_Obj_RPC_Receiver_Completion
        (Loc           : Source_Ptr;
         Decls         : List_Id;
         RPC_Receiver  : Entity_Id;
         Stub_Elements : Stub_Structure);

      procedure Add_Receiving_Stubs_To_Declarations
        (Pkg_Spec : Node_Id;
         Decls    : List_Id;
         Stmts    : List_Id);

      procedure Build_RPC_Receiver_Body
        (RPC_Receiver : Entity_Id;
         Request      : out Entity_Id;
         Subp_Id      : out Entity_Id;
         Subp_Index   : out Entity_Id;
         Stmts        : out List_Id;
         Decl         : out Node_Id);

      procedure Reserve_NamingContext_Methods;
      --  Mark the method names for interface NamingContext as already used in
      --  the overload table, so no clashes occur with user code (with the
      --  PolyORB PCS, RCIs Implement The NamingContext interface to allow
      --  their methods to be accessed as objects, for the implementation of
      --  remote access-to-subprogram types).

      -------------
      -- Helpers --
      -------------

      package Helpers is

         --  Routines to build distribution helper subprograms for user-defined
         --  types. For implementation of the Distributed systems annex (DSA)
         --  over the PolyORB generic middleware components, it is necessary to
         --  generate several supporting subprograms for each application data
         --  type used in inter-partition communication. These subprograms are:

         --    A Typecode function returning a high-level description of the
         --    type's structure;

         --    Two conversion functions allowing conversion of values of the
         --    type from and to the generic data containers used by PolyORB.
         --    These generic containers are called 'Any' type values after the
         --    CORBA terminology, and hence the conversion subprograms are
         --    named To_Any and From_Any.

         function Build_From_Any_Call
           (Typ   : Entity_Id;
            N     : Node_Id;
            Decls : List_Id) return Node_Id;
         --  Build call to From_Any attribute function of type Typ with
         --  expression N as actual parameter. Decls is the declarations list
         --  for an appropriate enclosing scope of the point where the call
         --  will be inserted; if the From_Any attribute for Typ needs to be
         --  generated at this point, its declaration is appended to Decls.

         procedure Build_From_Any_Function
           (Loc  : Source_Ptr;
            Typ  : Entity_Id;
            Decl : out Node_Id;
            Fnam : out Entity_Id);
         --  Build From_Any attribute function for Typ. Loc is the reference
         --  location for generated nodes, Typ is the type for which the
         --  conversion function is generated. On return, Decl and Fnam contain
         --  the declaration and entity for the newly-created function.

         function Build_To_Any_Call
           (N     : Node_Id;
            Decls : List_Id) return Node_Id;
         --  Build call to To_Any attribute function with expression as actual
         --  parameter. Decls is the declarations list for an appropriate
         --  enclosing scope of the point where the call will be inserted; if
         --  the To_Any attribute for Typ needs to be generated at this point,
         --  its declaration is appended to Decls.

         procedure Build_To_Any_Function
           (Loc  : Source_Ptr;
            Typ  : Entity_Id;
            Decl : out Node_Id;
            Fnam : out Entity_Id);
         --  Build To_Any attribute function for Typ. Loc is the reference
         --  location for generated nodes, Typ is the type for which the
         --  conversion function is generated. On return, Decl and Fnam contain
         --  the declaration and entity for the newly-created function.

         function Build_TypeCode_Call
           (Loc   : Source_Ptr;
            Typ   : Entity_Id;
            Decls : List_Id) return Node_Id;
         --  Build call to TypeCode attribute function for Typ. Decls is the
         --  declarations list for an appropriate enclosing scope of the point
         --  where the call will be inserted; if the To_Any attribute for Typ
         --  needs to be generated at this point, its declaration is appended
         --  to Decls.

         procedure Build_TypeCode_Function
           (Loc  : Source_Ptr;
            Typ  : Entity_Id;
            Decl : out Node_Id;
            Fnam : out Entity_Id);
         --  Build TypeCode attribute function for Typ. Loc is the reference
         --  location for generated nodes, Typ is the type for which the
         --  conversion function is generated. On return, Decl and Fnam contain
         --  the declaration and entity for the newly-created function.

         procedure Build_Name_And_Repository_Id
           (E           : Entity_Id;
            Name_Str    : out String_Id;
            Repo_Id_Str : out String_Id);
         --  In the PolyORB distribution model, each distributed object type
         --  and each distributed operation has a globally unique identifier,
         --  its Repository Id. This subprogram builds and returns two strings
         --  for entity E (a distributed object type or operation): one
         --  containing the name of E, the second containing its repository id.

         procedure Assign_Opaque_From_Any
           (Loc    : Source_Ptr;
            Stms   : List_Id;
            Typ    : Entity_Id;
            N      : Node_Id;
            Target : Entity_Id);
         --  For a Target object of type Typ, which has opaque representation
         --  as a sequence of octets determined by stream attributes (which
         --  includes all limited types), append code to Stmts performing the
         --  equivalent of:
         --    Target := Typ'From_Any (N)
         --
         --  or, if Target is Empty:
         --    return Typ'From_Any (N)

      end Helpers;

   end PolyORB_Support;

   --  The following PolyORB-specific subprograms are made visible to Exp_Attr:

   function Build_From_Any_Call
     (Typ   : Entity_Id;
      N     : Node_Id;
      Decls : List_Id) return Node_Id
     renames PolyORB_Support.Helpers.Build_From_Any_Call;

   function Build_To_Any_Call
     (N     : Node_Id;
      Decls : List_Id) return Node_Id
     renames PolyORB_Support.Helpers.Build_To_Any_Call;

   function Build_TypeCode_Call
     (Loc   : Source_Ptr;
      Typ   : Entity_Id;
      Decls : List_Id) return Node_Id
     renames PolyORB_Support.Helpers.Build_TypeCode_Call;

   ------------------------------------
   -- Local variables and structures --
   ------------------------------------

   RCI_Cache : Node_Id;
   --  Needs comments ???

   Output_From_Constrained : constant array (Boolean) of Name_Id :=
     (False => Name_Output,
      True  => Name_Write);
   --  The attribute to choose depending on the fact that the parameter
   --  is constrained or not. There is no such thing as Input_From_Constrained
   --  since this require separate mechanisms ('Input is a function while
   --  'Read is a procedure).

   ---------------------------------------
   -- Add_Calling_Stubs_To_Declarations --
   ---------------------------------------

   procedure Add_Calling_Stubs_To_Declarations
     (Pkg_Spec : Node_Id;
      Decls    : List_Id)
   is
      Current_Subprogram_Number : Int := First_RCI_Subprogram_Id;
      --  Subprogram id 0 is reserved for calls received from
      --  remote access-to-subprogram dereferences.

      Current_Declaration : Node_Id;
      Loc                 : constant Source_Ptr := Sloc (Pkg_Spec);
      RCI_Instantiation   : Node_Id;
      Subp_Stubs          : Node_Id;
      Subp_Str            : String_Id;

      pragma Warnings (Off, Subp_Str);

   begin
      --  The first thing added is an instantiation of the generic package
      --  System.Partition_Interface.RCI_Locator with the name of this remote
      --  package. This will act as an interface with the name server to
      --  determine the Partition_ID and the RPC_Receiver for the receiver
      --  of this package.

      RCI_Instantiation := RCI_Package_Locator (Loc, Pkg_Spec);
      RCI_Cache         := Defining_Unit_Name (RCI_Instantiation);

      Append_To (Decls, RCI_Instantiation);
      Analyze (RCI_Instantiation);

      --  For each subprogram declaration visible in the spec, we do build a
      --  body. We also increment a counter to assign a different Subprogram_Id
      --  to each subprograms. The receiving stubs processing do use the same
      --  mechanism and will thus assign the same Id and do the correct
      --  dispatching.

      Overload_Counter_Table.Reset;
      PolyORB_Support.Reserve_NamingContext_Methods;

      Current_Declaration := First (Visible_Declarations (Pkg_Spec));
      while Present (Current_Declaration) loop
         if Nkind (Current_Declaration) = N_Subprogram_Declaration
           and then Comes_From_Source (Current_Declaration)
         then
            Assign_Subprogram_Identifier
              (Defining_Unit_Name (Specification (Current_Declaration)),
               Current_Subprogram_Number,
               Subp_Str);

            Subp_Stubs :=
              Build_Subprogram_Calling_Stubs (
                Vis_Decl     => Current_Declaration,
                Subp_Id      =>
                  Build_Subprogram_Id (Loc,
                    Defining_Unit_Name (Specification (Current_Declaration))),
                Asynchronous =>
                  Nkind (Specification (Current_Declaration)) =
                                                 N_Procedure_Specification
                    and then
                      Is_Asynchronous (Defining_Unit_Name (Specification
                        (Current_Declaration))));

            Append_To (Decls, Subp_Stubs);
            Analyze (Subp_Stubs);

            Current_Subprogram_Number := Current_Subprogram_Number + 1;
         end if;

         Next (Current_Declaration);
      end loop;
   end Add_Calling_Stubs_To_Declarations;

   -----------------------------
   -- Add_Parameter_To_NVList --
   -----------------------------

   function Add_Parameter_To_NVList
     (Loc         : Source_Ptr;
      NVList      : Entity_Id;
      Parameter   : Entity_Id;
      Constrained : Boolean;
      RACW_Ctrl   : Boolean := False;
      Any         : Entity_Id) return Node_Id
   is
      Parameter_Name_String : String_Id;
      Parameter_Mode        : Node_Id;

      function Parameter_Passing_Mode
        (Loc         : Source_Ptr;
         Parameter   : Entity_Id;
         Constrained : Boolean) return Node_Id;
      --  Return an expression that denotes the parameter passing mode to be
      --  used for Parameter in distribution stubs, where Constrained is
      --  Parameter's constrained status.

      ----------------------------
      -- Parameter_Passing_Mode --
      ----------------------------

      function Parameter_Passing_Mode
        (Loc         : Source_Ptr;
         Parameter   : Entity_Id;
         Constrained : Boolean) return Node_Id
      is
         Lib_RE : RE_Id;

      begin
         if Out_Present (Parameter) then
            if In_Present (Parameter)
              or else not Constrained
            then
               --  Unconstrained formals must be translated
               --  to 'in' or 'inout', not 'out', because
               --  they need to be constrained by the actual.

               Lib_RE := RE_Mode_Inout;
            else
               Lib_RE := RE_Mode_Out;
            end if;

         else
            Lib_RE := RE_Mode_In;
         end if;

         return New_Occurrence_Of (RTE (Lib_RE), Loc);
      end Parameter_Passing_Mode;

   --  Start of processing for Add_Parameter_To_NVList

   begin
      if Nkind (Parameter) = N_Defining_Identifier then
         Get_Name_String (Chars (Parameter));
      else
         Get_Name_String (Chars (Defining_Identifier (Parameter)));
      end if;

      Parameter_Name_String := String_From_Name_Buffer;

      if RACW_Ctrl or else Nkind (Parameter) = N_Defining_Identifier then

         --  When the parameter passed to Add_Parameter_To_NVList is an
         --  Extra_Constrained parameter, Parameter is an N_Defining_
         --  Identifier, instead of a complete N_Parameter_Specification.
         --  Thus, we explicitly set 'in' mode in this case.

         Parameter_Mode := New_Occurrence_Of (RTE (RE_Mode_In), Loc);

      else
         Parameter_Mode :=
           Parameter_Passing_Mode (Loc, Parameter, Constrained);
      end if;

      return
        Make_Procedure_Call_Statement (Loc,
          Name =>
            New_Occurrence_Of
              (RTE (RE_NVList_Add_Item), Loc),
          Parameter_Associations => New_List (
            New_Occurrence_Of (NVList, Loc),
            Make_Function_Call (Loc,
              Name =>
                New_Occurrence_Of
                  (RTE (RE_To_PolyORB_String), Loc),
              Parameter_Associations => New_List (
                Make_String_Literal (Loc,
                  Strval => Parameter_Name_String))),
            New_Occurrence_Of (Any, Loc),
            Parameter_Mode));
   end Add_Parameter_To_NVList;

   --------------------------------
   -- Add_RACW_Asynchronous_Flag --
   --------------------------------

   procedure Add_RACW_Asynchronous_Flag
     (Declarations : List_Id;
      RACW_Type    : Entity_Id)
   is
      Loc : constant Source_Ptr := Sloc (RACW_Type);

      Asynchronous_Flag : constant Entity_Id :=
                            Make_Defining_Identifier (Loc,
                              New_External_Name (Chars (RACW_Type), 'A'));

   begin
      --  Declare the asynchronous flag. This flag will be changed to True
      --  whenever it is known that the RACW type is asynchronous.

      Append_To (Declarations,
        Make_Object_Declaration (Loc,
          Defining_Identifier => Asynchronous_Flag,
          Constant_Present    => True,
          Object_Definition   => New_Occurrence_Of (Standard_Boolean, Loc),
          Expression          => New_Occurrence_Of (Standard_False, Loc)));

      Asynchronous_Flags_Table.Set (RACW_Type, Asynchronous_Flag);
   end Add_RACW_Asynchronous_Flag;

   -----------------------
   -- Add_RACW_Features --
   -----------------------

   procedure Add_RACW_Features (RACW_Type : Entity_Id) is
      Desig      : constant Entity_Id := Etype (Designated_Type (RACW_Type));
      Same_Scope : constant Boolean   := Scope (Desig) = Scope (RACW_Type);

      Pkg_Spec   : Node_Id;
      Decls      : List_Id;
      Body_Decls : List_Id;

      Stub_Type         : Entity_Id;
      Stub_Type_Access  : Entity_Id;
      RPC_Receiver_Decl : Node_Id;

      Existing : Boolean;
      --  True when appropriate stubs have already been generated (this is the
      --  case when another RACW with the same designated type has already been
      --  encountered), in which case we reuse the previous stubs rather than
      --  generating new ones.

   begin
      if not Expander_Active then
         return;
      end if;

      --  Mark the current package declaration as containing an RACW, so that
      --  the bodies for the calling stubs and the RACW stream subprograms
      --  are attached to the tree when the corresponding body is encountered.

      Set_Has_RACW (Current_Scope);

      --  Look for place to declare the RACW stub type and RACW operations

      Pkg_Spec := Empty;

      if Same_Scope then

         --  Case of declaring the RACW in the same package as its designated
         --  type: we know that the designated type is a private type, so we
         --  use the private declarations list.

         Pkg_Spec := Package_Specification_Of_Scope (Current_Scope);

         if Present (Private_Declarations (Pkg_Spec)) then
            Decls := Private_Declarations (Pkg_Spec);
         else
            Decls := Visible_Declarations (Pkg_Spec);
         end if;

      else
         --  Case of declaring the RACW in another package than its designated
         --  type: use the private declarations list if present; otherwise
         --  use the visible declarations.

         Decls := List_Containing (Declaration_Node (RACW_Type));

      end if;

      --  If we were unable to find the declarations, that means that the
      --  completion of the type was missing. We can safely return and let the
      --  error be caught by the semantic analysis.

      if No (Decls) then
         return;
      end if;

      Add_Stub_Type
        (Designated_Type     => Desig,
         RACW_Type           => RACW_Type,
         Decls               => Decls,
         Stub_Type           => Stub_Type,
         Stub_Type_Access    => Stub_Type_Access,
         RPC_Receiver_Decl   => RPC_Receiver_Decl,
         Body_Decls          => Body_Decls,
         Existing            => Existing);

      --  If this RACW is not in the main unit, do not generate primitive or
      --  TSS bodies.

      if not Entity_Is_In_Main_Unit (RACW_Type) then
         Body_Decls := No_List;
      end if;

      Add_RACW_Asynchronous_Flag
        (Declarations        => Decls,
         RACW_Type           => RACW_Type);

      Specific_Add_RACW_Features
        (RACW_Type           => RACW_Type,
         Desig               => Desig,
         Stub_Type           => Stub_Type,
         Stub_Type_Access    => Stub_Type_Access,
         RPC_Receiver_Decl   => RPC_Receiver_Decl,
         Body_Decls          => Body_Decls);

      --  If we already have stubs for this designated type, nothing to do

      if Existing then
         return;
      end if;

      if Is_Frozen (Desig) then
         Validate_RACW_Primitives (RACW_Type);
         Add_RACW_Primitive_Declarations_And_Bodies
           (Designated_Type  => Desig,
            Insertion_Node   => RPC_Receiver_Decl,
            Body_Decls       => Body_Decls);

      else
         --  Validate_RACW_Primitives requires the list of all primitives of
         --  the designated type, so defer processing until Desig is frozen.
         --  See Exp_Ch3.Freeze_Type.

         Add_Access_Type_To_Process (E => Desig, A => RACW_Type);
      end if;
   end Add_RACW_Features;

   ------------------------------------------------
   -- Add_RACW_Primitive_Declarations_And_Bodies --
   ------------------------------------------------

   procedure Add_RACW_Primitive_Declarations_And_Bodies
     (Designated_Type : Entity_Id;
      Insertion_Node  : Node_Id;
      Body_Decls      : List_Id)
   is
      Loc : constant Source_Ptr := Sloc (Insertion_Node);
      --  Set Sloc of generated declaration copy of insertion node Sloc, so
      --  the declarations are recognized as belonging to the current package.

      Stub_Elements : constant Stub_Structure :=
                        Stubs_Table.Get (Designated_Type);

      pragma Assert (Stub_Elements /= Empty_Stub_Structure);

      Is_RAS : constant Boolean :=
                 not Comes_From_Source (Stub_Elements.RACW_Type);
      --  Case of the RACW generated to implement a remote access-to-
      --  subprogram type.

      Build_Bodies : constant Boolean :=
                       In_Extended_Main_Code_Unit (Stub_Elements.Stub_Type);
      --  True when bodies must be prepared in Body_Decls. Bodies are generated
      --  only when the main unit is the unit that contains the stub type.

      Current_Insertion_Node : Node_Id := Insertion_Node;

      RPC_Receiver                   : Entity_Id;
      RPC_Receiver_Statements        : List_Id;
      RPC_Receiver_Case_Alternatives : constant List_Id := New_List;
      RPC_Receiver_Elsif_Parts       : List_Id;
      RPC_Receiver_Request           : Entity_Id;
      RPC_Receiver_Subp_Id           : Entity_Id;
      RPC_Receiver_Subp_Index        : Entity_Id;

      Subp_Str : String_Id;

      Current_Primitive_Elmt   : Elmt_Id;
      Current_Primitive        : Entity_Id;
      Current_Primitive_Body   : Node_Id;
      Current_Primitive_Spec   : Node_Id;
      Current_Primitive_Decl   : Node_Id;
      Current_Primitive_Number : Int := 0;
      Current_Primitive_Alias  : Node_Id;
      Current_Receiver         : Entity_Id;
      Current_Receiver_Body    : Node_Id;
      RPC_Receiver_Decl        : Node_Id;
      Possibly_Asynchronous    : Boolean;

   begin
      if not Expander_Active then
         return;
      end if;

      if not Is_RAS then
         RPC_Receiver := Make_Temporary (Loc, 'P');

         Specific_Build_RPC_Receiver_Body
           (RPC_Receiver => RPC_Receiver,
            Request      => RPC_Receiver_Request,
            Subp_Id      => RPC_Receiver_Subp_Id,
            Subp_Index   => RPC_Receiver_Subp_Index,
            Stmts        => RPC_Receiver_Statements,
            Decl         => RPC_Receiver_Decl);

         if Get_PCS_Name = Name_PolyORB_DSA then

            --  For the case of PolyORB, we need to map a textual operation
            --  name into a primitive index. Currently we do so using a simple
            --  sequence of string comparisons.

            RPC_Receiver_Elsif_Parts := New_List;
         end if;
      end if;

      --  Build callers, receivers for every primitive operations and a RPC
      --  receiver for this type.

      if Present (Primitive_Operations (Designated_Type)) then
         Overload_Counter_Table.Reset;

         Current_Primitive_Elmt :=
           First_Elmt (Primitive_Operations (Designated_Type));
         while Current_Primitive_Elmt /= No_Elmt loop
            Current_Primitive := Node (Current_Primitive_Elmt);

            --  Copy the primitive of all the parents, except predefined ones
            --  that are not remotely dispatching. Also omit hidden primitives
            --  (occurs in the case of primitives of interface progenitors
            --  other than immediate ancestors of the Designated_Type).

            if Chars (Current_Primitive) /= Name_uSize
              and then Chars (Current_Primitive) /= Name_uAlignment
              and then not
                (Is_TSS (Current_Primitive, TSS_Deep_Finalize) or else
                 Is_TSS (Current_Primitive, TSS_Stream_Input)  or else
                 Is_TSS (Current_Primitive, TSS_Stream_Output) or else
                 Is_TSS (Current_Primitive, TSS_Stream_Read)   or else
                 Is_TSS (Current_Primitive, TSS_Stream_Write)  or else
                 Is_Predefined_Interface_Primitive (Current_Primitive))
              and then not Is_Hidden (Current_Primitive)
            then
               --  The first thing to do is build an up-to-date copy of the
               --  spec with all the formals referencing Controlling_Type
               --  transformed into formals referencing Stub_Type. Since this
               --  primitive may have been inherited, go back the alias chain
               --  until the real primitive has been found.

               Current_Primitive_Alias := Ultimate_Alias (Current_Primitive);

               --  Copy the spec from the original declaration for the purpose
               --  of declaring an overriding subprogram: we need to replace
               --  the type of each controlling formal with Stub_Type. The
               --  primitive may have been declared for Controlling_Type or
               --  inherited from some ancestor type for which we do not have
               --  an easily determined Entity_Id. We have no systematic way
               --  of knowing which type to substitute Stub_Type for. Instead,
               --  Copy_Specification relies on the flag Is_Controlling_Formal
               --  to determine which formals to change.

               Current_Primitive_Spec :=
                 Copy_Specification (Loc,
                   Spec        => Parent (Current_Primitive_Alias),
                   Ctrl_Type   => Stub_Elements.Stub_Type);

               Current_Primitive_Decl :=
                 Make_Subprogram_Declaration (Loc,
                   Specification => Current_Primitive_Spec);

               Insert_After_And_Analyze (Current_Insertion_Node,
                 Current_Primitive_Decl);
               Current_Insertion_Node := Current_Primitive_Decl;

               Possibly_Asynchronous :=
                 Nkind (Current_Primitive_Spec) = N_Procedure_Specification
                 and then Could_Be_Asynchronous (Current_Primitive_Spec);

               Assign_Subprogram_Identifier (
                 Defining_Unit_Name (Current_Primitive_Spec),
                 Current_Primitive_Number,
                 Subp_Str);

               if Build_Bodies then
                  Current_Primitive_Body :=
                    Build_Subprogram_Calling_Stubs
                      (Vis_Decl                 => Current_Primitive_Decl,
                       Subp_Id                  =>
                         Build_Subprogram_Id (Loc,
                           Defining_Unit_Name (Current_Primitive_Spec)),
                       Asynchronous             => Possibly_Asynchronous,
                       Dynamically_Asynchronous => Possibly_Asynchronous,
                       Stub_Type                => Stub_Elements.Stub_Type,
                       RACW_Type                => Stub_Elements.RACW_Type);
                  Append_To (Body_Decls, Current_Primitive_Body);

                  --  Analyzing the body here would cause the Stub type to
                  --  be frozen, thus preventing subsequent primitive
                  --  declarations. For this reason, it will be analyzed
                  --  later in the regular flow (and in the context of the
                  --  appropriate unit body, see Append_RACW_Bodies).

               end if;

               --  Build the receiver stubs

               if Build_Bodies and then not Is_RAS then
                  Current_Receiver_Body :=
                    Specific_Build_Subprogram_Receiving_Stubs
                      (Vis_Decl                 => Current_Primitive_Decl,
                       Asynchronous             => Possibly_Asynchronous,
                       Dynamically_Asynchronous => Possibly_Asynchronous,
                       Stub_Type                => Stub_Elements.Stub_Type,
                       RACW_Type                => Stub_Elements.RACW_Type,
                       Parent_Primitive         => Current_Primitive);

                  Current_Receiver := Defining_Unit_Name (
                    Specification (Current_Receiver_Body));

                  Append_To (Body_Decls, Current_Receiver_Body);

                  --  Add a case alternative to the receiver

                  if Get_PCS_Name = Name_PolyORB_DSA then
                     Append_To (RPC_Receiver_Elsif_Parts,
                       Make_Elsif_Part (Loc,
                         Condition =>
                           Make_Function_Call (Loc,
                             Name =>
                               New_Occurrence_Of (
                                 RTE (RE_Caseless_String_Eq), Loc),
                             Parameter_Associations => New_List (
                               New_Occurrence_Of (RPC_Receiver_Subp_Id, Loc),
                               Make_String_Literal (Loc, Subp_Str))),

                         Then_Statements => New_List (
                           Make_Assignment_Statement (Loc,
                             Name => New_Occurrence_Of (
                                       RPC_Receiver_Subp_Index, Loc),
                             Expression =>
                               Make_Integer_Literal (Loc,
                                  Intval => Current_Primitive_Number)))));
                  end if;

                  Append_To (RPC_Receiver_Case_Alternatives,
                    Make_Case_Statement_Alternative (Loc,
                      Discrete_Choices => New_List (
                        Make_Integer_Literal (Loc, Current_Primitive_Number)),

                      Statements       => New_List (
                        Make_Procedure_Call_Statement (Loc,
                          Name                   =>
                            New_Occurrence_Of (Current_Receiver, Loc),
                          Parameter_Associations => New_List (
                            New_Occurrence_Of (RPC_Receiver_Request, Loc))))));
               end if;

               --  Increment the index of current primitive

               Current_Primitive_Number := Current_Primitive_Number + 1;
            end if;

            Next_Elmt (Current_Primitive_Elmt);
         end loop;
      end if;

      --  Build the case statement and the heart of the subprogram

      if Build_Bodies and then not Is_RAS then
         if Get_PCS_Name = Name_PolyORB_DSA
           and then Present (First (RPC_Receiver_Elsif_Parts))
         then
            Append_To (RPC_Receiver_Statements,
              Make_Implicit_If_Statement (Designated_Type,
                Condition       => New_Occurrence_Of (Standard_False, Loc),
                Then_Statements => New_List,
                Elsif_Parts     => RPC_Receiver_Elsif_Parts));
         end if;

         Append_To (RPC_Receiver_Case_Alternatives,
           Make_Case_Statement_Alternative (Loc,
             Discrete_Choices => New_List (Make_Others_Choice (Loc)),
             Statements       => New_List (Make_Null_Statement (Loc))));

         Append_To (RPC_Receiver_Statements,
           Make_Case_Statement (Loc,
             Expression   =>
               New_Occurrence_Of (RPC_Receiver_Subp_Index, Loc),
             Alternatives => RPC_Receiver_Case_Alternatives));

         Append_To (Body_Decls, RPC_Receiver_Decl);
         Specific_Add_Obj_RPC_Receiver_Completion (Loc,
           Body_Decls, RPC_Receiver, Stub_Elements);

      --  Do not analyze RPC receiver body at this stage since it references
      --  subprograms that have not been analyzed yet. It will be analyzed in
      --  the regular flow (see Append_RACW_Bodies).

      end if;
   end Add_RACW_Primitive_Declarations_And_Bodies;

   -----------------------------
   -- Add_RAS_Dereference_TSS --
   -----------------------------

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

      Type_Def  : constant Node_Id   := Type_Definition (N);
      RAS_Type  : constant Entity_Id := Defining_Identifier (N);
      Fat_Type  : constant Entity_Id := Equivalent_Type (RAS_Type);
      RACW_Type : constant Entity_Id := Underlying_RACW_Type (RAS_Type);

      RACW_Primitive_Name : Node_Id;

      Proc : constant Entity_Id :=
               Make_Defining_Identifier (Loc,
                 Chars => Make_TSS_Name (RAS_Type, TSS_RAS_Dereference));

      Proc_Spec   : Node_Id;
      Param_Specs : List_Id;
      Param_Assoc : constant List_Id := New_List;
      Stmts       : constant List_Id := New_List;

      RAS_Parameter : constant Entity_Id := Make_Temporary (Loc, 'P');

      Is_Function : constant Boolean :=
                      Nkind (Type_Def) = N_Access_Function_Definition;

      Is_Degenerate : Boolean;
      --  Set to True if the subprogram_specification for this RAS has an
      --  anonymous access parameter (see Process_Remote_AST_Declaration).

      Spec : constant Node_Id := Type_Def;

      Current_Parameter : Node_Id;

   --  Start of processing for Add_RAS_Dereference_TSS

   begin
      --  The Dereference TSS for a remote access-to-subprogram type has the
      --  form:

      --    [function|procedure] ras_typeRD (RAS_Value, <RAS_Parameters>)
      --       [return <>]

      --  This is called whenever a value of a RAS type is dereferenced

      --  First construct a list of parameter specifications:

      --  The first formal is the RAS values

      Param_Specs := New_List (
        Make_Parameter_Specification (Loc,
          Defining_Identifier => RAS_Parameter,
          In_Present          => True,
          Parameter_Type      =>
            New_Occurrence_Of (Fat_Type, Loc)));

      --  The following formals are copied from the type declaration

      Is_Degenerate := False;
      Current_Parameter := First (Parameter_Specifications (Type_Def));
      Parameters : while Present (Current_Parameter) loop
         if Nkind (Parameter_Type (Current_Parameter)) =
                                            N_Access_Definition
         then
            Is_Degenerate := True;
         end if;

         Append_To (Param_Specs,
           Make_Parameter_Specification (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc,
                 Chars => Chars (Defining_Identifier (Current_Parameter))),
             In_Present        => In_Present (Current_Parameter),
             Out_Present       => Out_Present (Current_Parameter),
             Parameter_Type    =>
               New_Copy_Tree (Parameter_Type (Current_Parameter)),
             Expression        =>
               New_Copy_Tree (Expression (Current_Parameter))));

         Append_To (Param_Assoc,
           Make_Identifier (Loc,
             Chars => Chars (Defining_Identifier (Current_Parameter))));

         Next (Current_Parameter);
      end loop Parameters;

      if Is_Degenerate then
         Prepend_To (Param_Assoc, New_Occurrence_Of (RAS_Parameter, Loc));

         --  Generate a dummy body. This code will never actually be executed,
         --  because null is the only legal value for a degenerate RAS type.
         --  For legality's sake (in order to avoid generating a function that
         --  does not contain a return statement), we include a dummy recursive
         --  call on the TSS itself.

         Append_To (Stmts,
           Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
         RACW_Primitive_Name := New_Occurrence_Of (Proc, Loc);

      else
         --  For a normal RAS type, we cast the RAS formal to the corresponding
         --  tagged type, and perform a dispatching call to its Call primitive
         --  operation.

         Prepend_To (Param_Assoc,
           Unchecked_Convert_To (RACW_Type,
             New_Occurrence_Of (RAS_Parameter, Loc)));

         RACW_Primitive_Name :=
           Make_Selected_Component (Loc,
             Prefix        => Scope (RACW_Type),
             Selector_Name => Name_uCall);
      end if;

      if Is_Function then
         Append_To (Stmts,
            Make_Simple_Return_Statement (Loc,
              Expression =>
                Make_Function_Call (Loc,
                  Name                   => RACW_Primitive_Name,
                  Parameter_Associations => Param_Assoc)));

      else
         Append_To (Stmts,
           Make_Procedure_Call_Statement (Loc,
             Name                   => RACW_Primitive_Name,
             Parameter_Associations => Param_Assoc));
      end if;

      --  Build the complete subprogram

      if Is_Function then
         Proc_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name       => Proc,
             Parameter_Specifications => Param_Specs,
             Result_Definition        =>
               New_Occurrence_Of (
                 Entity (Result_Definition (Spec)), Loc));

         Set_Ekind (Proc, E_Function);
         Set_Etype (Proc,
           New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));

      else
         Proc_Spec :=
           Make_Procedure_Specification (Loc,
             Defining_Unit_Name       => Proc,
             Parameter_Specifications => Param_Specs);

         Set_Ekind (Proc, E_Procedure);
         Set_Etype (Proc, Standard_Void_Type);
      end if;

      Discard_Node (
        Make_Subprogram_Body (Loc,
          Specification              => Proc_Spec,
          Declarations               => New_List,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc,
              Statements => Stmts)));

      Set_TSS (Fat_Type, Proc);
   end Add_RAS_Dereference_TSS;

   -------------------------------
   -- Add_RAS_Proxy_And_Analyze --
   -------------------------------

   procedure Add_RAS_Proxy_And_Analyze
     (Decls              : List_Id;
      Vis_Decl           : Node_Id;
      All_Calls_Remote_E : Entity_Id;
      Proxy_Object_Addr  : out Entity_Id)
   is
      Loc : constant Source_Ptr := Sloc (Vis_Decl);

      Subp_Name : constant Entity_Id :=
                     Defining_Unit_Name (Specification (Vis_Decl));

      Pkg_Name : constant Entity_Id :=
                   Make_Defining_Identifier (Loc,
                     Chars => New_External_Name (Chars (Subp_Name), 'P', -1));

      Proxy_Type : constant Entity_Id :=
                     Make_Defining_Identifier (Loc,
                       Chars =>
                         New_External_Name
                           (Related_Id => Chars (Subp_Name),
                            Suffix     => 'P'));

      Proxy_Type_Full_View : constant Entity_Id :=
                               Make_Defining_Identifier (Loc,
                                 Chars (Proxy_Type));

      Subp_Decl_Spec : constant Node_Id :=
                         Build_RAS_Primitive_Specification
                           (Subp_Spec          => Specification (Vis_Decl),
                            Remote_Object_Type => Proxy_Type);

      Subp_Body_Spec : constant Node_Id :=
                         Build_RAS_Primitive_Specification
                           (Subp_Spec          => Specification (Vis_Decl),
                            Remote_Object_Type => Proxy_Type);

      Vis_Decls    : constant List_Id := New_List;
      Pvt_Decls    : constant List_Id := New_List;
      Actuals      : constant List_Id := New_List;
      Formal       : Node_Id;
      Perform_Call : Node_Id;

   begin
      --  type subpP is tagged limited private;

      Append_To (Vis_Decls,
        Make_Private_Type_Declaration (Loc,
          Defining_Identifier => Proxy_Type,
          Tagged_Present      => True,
          Limited_Present     => True));

      --  [subprogram] Call
      --    (Self : access subpP;
      --     ...other-formals...)
      --     [return T];

      Append_To (Vis_Decls,
        Make_Subprogram_Declaration (Loc,
          Specification => Subp_Decl_Spec));

      --  A : constant System.Address;

      Proxy_Object_Addr := Make_Defining_Identifier (Loc, Name_uA);

      Append_To (Vis_Decls,
        Make_Object_Declaration (Loc,
          Defining_Identifier => Proxy_Object_Addr,
          Constant_Present    => True,
          Object_Definition   => New_Occurrence_Of (RTE (RE_Address), Loc)));

      --  private

      --  type subpP is tagged limited record
      --     All_Calls_Remote : Boolean := [All_Calls_Remote?];
      --     ...
      --  end record;

      Append_To (Pvt_Decls,
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => Proxy_Type_Full_View,
          Type_Definition     =>
            Build_Remote_Subprogram_Proxy_Type (Loc,
              New_Occurrence_Of (All_Calls_Remote_E, Loc))));

      --  Trick semantic analysis into swapping the public and full view when
      --  freezing the public view.

      Set_Comes_From_Source (Proxy_Type_Full_View, True);

      --  procedure Call
      --    (Self : access O;
      --     ...other-formals...) is
      --  begin
      --    P (...other-formals...);
      --  end Call;

      --  function Call
      --    (Self : access O;
      --     ...other-formals...)
      --     return T is
      --  begin
      --    return F (...other-formals...);
      --  end Call;

      if Nkind (Subp_Decl_Spec) = N_Procedure_Specification then
         Perform_Call :=
           Make_Procedure_Call_Statement (Loc,
             Name                   => New_Occurrence_Of (Subp_Name, Loc),
             Parameter_Associations => Actuals);
      else
         Perform_Call :=
           Make_Simple_Return_Statement (Loc,
             Expression =>
               Make_Function_Call (Loc,
                 Name                   => New_Occurrence_Of (Subp_Name, Loc),
                 Parameter_Associations => Actuals));
      end if;

      Formal := First (Parameter_Specifications (Subp_Decl_Spec));
      pragma Assert (Present (Formal));
      loop
         Next (Formal);
         exit when No (Formal);
         Append_To (Actuals,
           New_Occurrence_Of (Defining_Identifier (Formal), Loc));
      end loop;

      --  O : aliased subpP;

      Append_To (Pvt_Decls,
        Make_Object_Declaration (Loc,
          Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO),
          Aliased_Present     => True,
          Object_Definition   => New_Occurrence_Of (Proxy_Type, Loc)));

      --  A : constant System.Address := O'Address;

      Append_To (Pvt_Decls,
        Make_Object_Declaration (Loc,
          Defining_Identifier =>
            Make_Defining_Identifier (Loc, Chars (Proxy_Object_Addr)),
          Constant_Present    => True,
          Object_Definition   => New_Occurrence_Of (RTE (RE_Address), Loc),
          Expression =>
            Make_Attribute_Reference (Loc,
              Prefix => New_Occurrence_Of (
                Defining_Identifier (Last (Pvt_Decls)), Loc),
              Attribute_Name => Name_Address)));

      Append_To (Decls,
        Make_Package_Declaration (Loc,
          Specification => Make_Package_Specification (Loc,
            Defining_Unit_Name   => Pkg_Name,
            Visible_Declarations => Vis_Decls,
            Private_Declarations => Pvt_Decls,
            End_Label            => Empty)));
      Analyze (Last (Decls));

      Append_To (Decls,
        Make_Package_Body (Loc,
          Defining_Unit_Name =>
            Make_Defining_Identifier (Loc, Chars (Pkg_Name)),
          Declarations => New_List (
            Make_Subprogram_Body (Loc,
              Specification  => Subp_Body_Spec,
              Declarations   => New_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => New_List (Perform_Call))))));
      Analyze (Last (Decls));
   end Add_RAS_Proxy_And_Analyze;

   -----------------------
   -- Add_RAST_Features --
   -----------------------

   procedure Add_RAST_Features (Vis_Decl : Node_Id) is
      RAS_Type : constant Entity_Id :=
                   Equivalent_Type (Defining_Identifier (Vis_Decl));
   begin
      pragma Assert (No (TSS (RAS_Type, TSS_RAS_Access)));
      Add_RAS_Dereference_TSS (Vis_Decl);
      Specific_Add_RAST_Features (Vis_Decl, RAS_Type);
   end Add_RAST_Features;

   -------------------
   -- Add_Stub_Type --
   -------------------

   procedure Add_Stub_Type
     (Designated_Type   : Entity_Id;
      RACW_Type         : Entity_Id;
      Decls             : List_Id;
      Stub_Type         : out Entity_Id;
      Stub_Type_Access  : out Entity_Id;
      RPC_Receiver_Decl : out Node_Id;
      Body_Decls        : out List_Id;
      Existing          : out Boolean)
   is
      Loc : constant Source_Ptr := Sloc (RACW_Type);

      Stub_Elements         : constant Stub_Structure :=
                                Stubs_Table.Get (Designated_Type);
      Stub_Type_Comps       : List_Id;
      Stub_Type_Decl        : Node_Id;
      Stub_Type_Access_Decl : Node_Id;

   begin
      if Stub_Elements /= Empty_Stub_Structure then
         Stub_Type           := Stub_Elements.Stub_Type;
         Stub_Type_Access    := Stub_Elements.Stub_Type_Access;
         RPC_Receiver_Decl   := Stub_Elements.RPC_Receiver_Decl;
         Body_Decls          := Stub_Elements.Body_Decls;
         Existing            := True;
         return;
      end if;

      Existing := False;
      Stub_Type := Make_Temporary (Loc, 'S');
      Set_Ekind (Stub_Type, E_Record_Type);
      Set_Is_RACW_Stub_Type (Stub_Type);
      Stub_Type_Access :=
        Make_Defining_Identifier (Loc,
          Chars => New_External_Name
                     (Related_Id => Chars (Stub_Type), Suffix => 'A'));

      Specific_Build_Stub_Type (RACW_Type, Stub_Type_Comps, RPC_Receiver_Decl);

      Stub_Type_Decl :=
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => Stub_Type,
          Type_Definition     =>
            Make_Record_Definition (Loc,
              Tagged_Present  => True,
              Limited_Present => True,
              Component_List  =>
                Make_Component_List (Loc,
                  Component_Items => Stub_Type_Comps)));

      --  Does the stub type need to explicitly implement interfaces from the
      --  designated type???

      --  In particular are there issues in the case where the designated type
      --  is a synchronized interface???

      Stub_Type_Access_Decl :=
        Make_Full_Type_Declaration (Loc,
          Defining_Identifier => Stub_Type_Access,
          Type_Definition     =>
            Make_Access_To_Object_Definition (Loc,
              All_Present        => True,
              Subtype_Indication => New_Occurrence_Of (Stub_Type, Loc)));

      Append_To (Decls, Stub_Type_Decl);
      Analyze (Last (Decls));
      Append_To (Decls, Stub_Type_Access_Decl);
      Analyze (Last (Decls));

      --  We can't directly derive the stub type from the designated type,
      --  because we don't want any components or discriminants from the real
      --  type, so instead we manually fake a derivation to get an appropriate
      --  dispatch table.

      Derive_Subprograms (Parent_Type  => Designated_Type,
                          Derived_Type => Stub_Type);

      if Present (RPC_Receiver_Decl) then
         Append_To (Decls, RPC_Receiver_Decl);
      else
         RPC_Receiver_Decl := Last (Decls);
      end if;

      Body_Decls := New_List;

      Stubs_Table.Set (Designated_Type,
        (Stub_Type           => Stub_Type,
         Stub_Type_Access    => Stub_Type_Access,
         RPC_Receiver_Decl   => RPC_Receiver_Decl,
         Body_Decls          => Body_Decls,
         RACW_Type           => RACW_Type));
   end Add_Stub_Type;

   ------------------------
   -- Append_RACW_Bodies --
   ------------------------

   procedure Append_RACW_Bodies (Decls : List_Id; Spec_Id : Entity_Id) is
      E : Entity_Id;

   begin
      E := First_Entity (Spec_Id);
      while Present (E) loop
         if Is_Remote_Access_To_Class_Wide_Type (E) then
            Append_List_To (Decls, Get_And_Reset_RACW_Bodies (E));
         end if;

         Next_Entity (E);
      end loop;
   end Append_RACW_Bodies;

   ----------------------------------
   -- Assign_Subprogram_Identifier --
   ----------------------------------

   procedure Assign_Subprogram_Identifier
     (Def : Entity_Id;
      Spn : Int;
      Id  : out String_Id)
   is
      N : constant Name_Id := Chars (Def);

      Overload_Order : constant Int :=
                         Overload_Counter_Table.Get (N) + 1;

   begin
      Overload_Counter_Table.Set (N, Overload_Order);

      Get_Name_String (N);

      --  Homonym handling: as in Exp_Dbug, but much simpler, because the only
      --  entities for which we have to generate names here need only to be
      --  disambiguated within their own scope.

      if Overload_Order > 1 then
         Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "__";
         Name_Len := Name_Len + 2;
         Add_Nat_To_Name_Buffer (Overload_Order);
      end if;

      Id := String_From_Name_Buffer;
      Subprogram_Identifier_Table.Set
        (Def,
         Subprogram_Identifiers'(Str_Identifier => Id, Int_Identifier => Spn));
   end Assign_Subprogram_Identifier;

   -------------------------------------
   -- Build_Actual_Object_Declaration --
   -------------------------------------

   procedure Build_Actual_Object_Declaration
     (Object   : Entity_Id;
      Etyp     : Entity_Id;
      Variable : Boolean;
      Expr     : Node_Id;
      Decls    : List_Id)
   is
      Loc : constant Source_Ptr := Sloc (Object);

   begin
      --  Declare a temporary object for the actual, possibly initialized with
      --  a 'Input/From_Any call.

      --  Complication arises in the case of limited types, for which such a
      --  declaration is illegal in Ada 95. In that case, we first generate a
      --  renaming declaration of the 'Input call, and then if needed we
      --  generate an overlaid non-constant view.

      if Ada_Version <= Ada_95
        and then Is_Limited_Type (Etyp)
        and then Present (Expr)
      then

         --  Object : Etyp renames <func-call>

         Append_To (Decls,
           Make_Object_Renaming_Declaration (Loc,
             Defining_Identifier => Object,
             Subtype_Mark        => New_Occurrence_Of (Etyp, Loc),
             Name                => Expr));

         if Variable then

            --  The name defined by the renaming declaration denotes a
            --  constant view; create a non-constant object at the same address
            --  to be used as the actual.

            declare
               Constant_Object : constant Entity_Id :=
                                   Make_Temporary (Loc, 'P');

            begin
               Set_Defining_Identifier
                 (Last (Decls), Constant_Object);

               --  We have an unconstrained Etyp: build the actual constrained
               --  subtype for the value we just read from the stream.

               --  subtype S is <actual subtype of Constant_Object>;

               Append_To (Decls,
                 Build_Actual_Subtype (Etyp,
                   New_Occurrence_Of (Constant_Object, Loc)));

               --  Object : S;

               Append_To (Decls,
                 Make_Object_Declaration (Loc,
                   Defining_Identifier => Object,
                   Object_Definition   =>
                     New_Occurrence_Of
                       (Defining_Identifier (Last (Decls)), Loc)));
               Set_Ekind (Object, E_Variable);

               --  Suppress default initialization:
               --  pragma Import (Ada, Object);

               Append_To (Decls,
                 Make_Pragma (Loc,
                   Chars => Name_Import,
                   Pragma_Argument_Associations => New_List (
                     Make_Pragma_Argument_Association (Loc,
                       Chars      => Name_Convention,
                       Expression => Make_Identifier (Loc, Name_Ada)),
                     Make_Pragma_Argument_Association (Loc,
                       Chars      => Name_Entity,
                       Expression => New_Occurrence_Of (Object, Loc)))));

               --  for Object'Address use Constant_Object'Address;

               Append_To (Decls,
                 Make_Attribute_Definition_Clause (Loc,
                   Name       => New_Occurrence_Of (Object, Loc),
                   Chars      => Name_Address,
                   Expression =>
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Occurrence_Of (Constant_Object, Loc),
                       Attribute_Name => Name_Address)));
            end;
         end if;

      else
         --  General case of a regular object declaration. Object is flagged
         --  constant unless it has mode out or in out, to allow the backend
         --  to optimize where possible.

         --  Object : [constant] Etyp [:= <expr>];

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Object,
             Constant_Present    => Present (Expr) and then not Variable,
             Object_Definition   => New_Occurrence_Of (Etyp, Loc),
             Expression          => Expr));

         if Constant_Present (Last (Decls)) then
            Set_Ekind (Object, E_Constant);
         else
            Set_Ekind (Object, E_Variable);
         end if;
      end if;
   end Build_Actual_Object_Declaration;

   ------------------------------
   -- Build_Get_Unique_RP_Call --
   ------------------------------

   function Build_Get_Unique_RP_Call
     (Loc       : Source_Ptr;
      Pointer   : Entity_Id;
      Stub_Type : Entity_Id) return List_Id
   is
   begin
      return New_List (
        Make_Procedure_Call_Statement (Loc,
          Name                   =>
            New_Occurrence_Of (RTE (RE_Get_Unique_Remote_Pointer), Loc),
          Parameter_Associations => New_List (
            Unchecked_Convert_To (RTE (RE_RACW_Stub_Type_Access),
              New_Occurrence_Of (Pointer, Loc)))),

        Make_Assignment_Statement (Loc,
          Name =>
            Make_Selected_Component (Loc,
              Prefix => New_Occurrence_Of (Pointer, Loc),
              Selector_Name =>
                New_Occurrence_Of (First_Tag_Component
                  (Designated_Type (Etype (Pointer))), Loc)),
          Expression =>
            Make_Attribute_Reference (Loc,
              Prefix         => New_Occurrence_Of (Stub_Type, Loc),
              Attribute_Name => Name_Tag)));

      --  Note: The assignment to Pointer._Tag is safe here because
      --  we carefully ensured that Stub_Type has exactly the same layout
      --  as System.Partition_Interface.RACW_Stub_Type.

   end Build_Get_Unique_RP_Call;

   -----------------------------------
   -- Build_Ordered_Parameters_List --
   -----------------------------------

   function Build_Ordered_Parameters_List (Spec : Node_Id) return List_Id is
      Constrained_List   : List_Id;
      Unconstrained_List : List_Id;
      Current_Parameter  : Node_Id;
      Ptyp               : Node_Id;

      First_Parameter : Node_Id;
      For_RAS         : Boolean := False;

   begin
      if No (Parameter_Specifications (Spec)) then
         return New_List;
      end if;

      Constrained_List   := New_List;
      Unconstrained_List := New_List;
      First_Parameter    := First (Parameter_Specifications (Spec));

      if Nkind (Parameter_Type (First_Parameter)) = N_Access_Definition
        and then Chars (Defining_Identifier (First_Parameter)) = Name_uS
      then
         For_RAS := True;
      end if;

      --  Loop through the parameters and add them to the right list. Note that
      --  we treat a parameter of a null-excluding access type as unconstrained
      --  because we can't declare an object of such a type with default
      --  initialization.

      Current_Parameter := First_Parameter;
      while Present (Current_Parameter) loop
         Ptyp := Parameter_Type (Current_Parameter);

         if (Nkind (Ptyp) = N_Access_Definition
               or else not Transmit_As_Unconstrained (Etype (Ptyp)))
           and then not (For_RAS and then Current_Parameter = First_Parameter)
         then
            Append_To (Constrained_List, New_Copy (Current_Parameter));
         else
            Append_To (Unconstrained_List, New_Copy (Current_Parameter));
         end if;

         Next (Current_Parameter);
      end loop;

      --  Unconstrained parameters are returned first

      Append_List_To (Unconstrained_List, Constrained_List);

      return Unconstrained_List;
   end Build_Ordered_Parameters_List;

   ----------------------------------
   -- Build_Passive_Partition_Stub --
   ----------------------------------

   procedure Build_Passive_Partition_Stub (U : Node_Id) is
      Pkg_Spec : Node_Id;
      Pkg_Name : String_Id;
      L        : List_Id;
      Reg      : Node_Id;
      Loc      : constant Source_Ptr := Sloc (U);

   begin
      --  Verify that the implementation supports distribution, by accessing
      --  a type defined in the proper version of system.rpc

      declare
         Dist_OK : Entity_Id;
         pragma Warnings (Off, Dist_OK);
      begin
         Dist_OK := RTE (RE_Params_Stream_Type);
      end;

      --  Use body if present, spec otherwise

      if Nkind (U) = N_Package_Declaration then
         Pkg_Spec := Specification (U);
         L := Visible_Declarations (Pkg_Spec);
      else
         Pkg_Spec := Parent (Corresponding_Spec (U));
         L := Declarations (U);
      end if;

      Get_Library_Unit_Name_String (Pkg_Spec);
      Pkg_Name := String_From_Name_Buffer;
      Reg :=
        Make_Procedure_Call_Statement (Loc,
          Name                   =>
            New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc),
          Parameter_Associations => New_List (
            Make_String_Literal (Loc, Pkg_Name),
            Make_Attribute_Reference (Loc,
              Prefix         =>
                New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
              Attribute_Name => Name_Version)));
      Append_To (L, Reg);
      Analyze (Reg);
   end Build_Passive_Partition_Stub;

   --------------------------------------
   -- Build_RPC_Receiver_Specification --
   --------------------------------------

   function Build_RPC_Receiver_Specification
     (RPC_Receiver      : Entity_Id;
      Request_Parameter : Entity_Id) return Node_Id
   is
      Loc : constant Source_Ptr := Sloc (RPC_Receiver);
   begin
      return
        Make_Procedure_Specification (Loc,
          Defining_Unit_Name       => RPC_Receiver,
          Parameter_Specifications => New_List (
            Make_Parameter_Specification (Loc,
              Defining_Identifier => Request_Parameter,
              Parameter_Type      =>
                New_Occurrence_Of (RTE (RE_Request_Access), Loc))));
   end Build_RPC_Receiver_Specification;

   ----------------------------------------
   -- Build_Remote_Subprogram_Proxy_Type --
   ----------------------------------------

   function Build_Remote_Subprogram_Proxy_Type
     (Loc            : Source_Ptr;
      ACR_Expression : Node_Id) return Node_Id
   is
   begin
      return
        Make_Record_Definition (Loc,
          Tagged_Present  => True,
          Limited_Present => True,
          Component_List  =>
            Make_Component_List (Loc,

              Component_Items => New_List (
                Make_Component_Declaration (Loc,
                  Defining_Identifier =>
                    Make_Defining_Identifier (Loc,
                      Name_All_Calls_Remote),
                  Component_Definition =>
                    Make_Component_Definition (Loc,
                      Subtype_Indication =>
                        New_Occurrence_Of (Standard_Boolean, Loc)),
                  Expression =>
                    ACR_Expression),

                Make_Component_Declaration (Loc,
                  Defining_Identifier =>
                    Make_Defining_Identifier (Loc,
                      Name_Receiver),
                  Component_Definition =>
                    Make_Component_Definition (Loc,
                      Subtype_Indication =>
                        New_Occurrence_Of (RTE (RE_Address), Loc)),
                  Expression =>
                    New_Occurrence_Of (RTE (RE_Null_Address), Loc)),

                Make_Component_Declaration (Loc,
                  Defining_Identifier =>
                    Make_Defining_Identifier (Loc,
                      Name_Subp_Id),
                  Component_Definition =>
                    Make_Component_Definition (Loc,
                      Subtype_Indication =>
                        New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))))));
   end Build_Remote_Subprogram_Proxy_Type;

   --------------------
   -- Build_Stub_Tag --
   --------------------

   function Build_Stub_Tag
     (Loc       : Source_Ptr;
      RACW_Type : Entity_Id) return Node_Id
   is
      Stub_Type : constant Entity_Id := Corresponding_Stub_Type (RACW_Type);
   begin
      return
        Make_Attribute_Reference (Loc,
          Prefix         => New_Occurrence_Of (Stub_Type, Loc),
          Attribute_Name => Name_Tag);
   end Build_Stub_Tag;

   ------------------------------------
   -- Build_Subprogram_Calling_Stubs --
   ------------------------------------

   function Build_Subprogram_Calling_Stubs
     (Vis_Decl                 : Node_Id;
      Subp_Id                  : Node_Id;
      Asynchronous             : Boolean;
      Dynamically_Asynchronous : Boolean   := False;
      Stub_Type                : Entity_Id := Empty;
      RACW_Type                : Entity_Id := Empty;
      Locator                  : Entity_Id := Empty;
      New_Name                 : Name_Id   := No_Name) return Node_Id
   is
      Loc : constant Source_Ptr := Sloc (Vis_Decl);

      Decls      : constant List_Id := New_List;
      Statements : constant List_Id := New_List;

      Subp_Spec : Node_Id;
      --  The specification of the body

      Controlling_Parameter : Entity_Id := Empty;

      Asynchronous_Expr : Node_Id := Empty;

      RCI_Locator : Entity_Id;

      Spec_To_Use : Node_Id;

      procedure Insert_Partition_Check (Parameter : Node_Id);
      --  Check that the parameter has been elaborated on the same partition
      --  than the controlling parameter (E.4(19)).

      ----------------------------
      -- Insert_Partition_Check --
      ----------------------------

      procedure Insert_Partition_Check (Parameter : Node_Id) is
         Parameter_Entity : constant Entity_Id :=
                              Defining_Identifier (Parameter);
      begin
         --  The expression that will be built is of the form:

         --    if not Same_Partition (Parameter, Controlling_Parameter) then
         --      raise Constraint_Error;
         --    end if;

         --  We do not check that Parameter is in Stub_Type since such a check
         --  has been inserted at the point of call already (a tag check since
         --  we have multiple controlling operands).

         Append_To (Decls,
           Make_Raise_Constraint_Error (Loc,
             Condition       =>
               Make_Op_Not (Loc,
                 Right_Opnd =>
                   Make_Function_Call (Loc,
                     Name =>
                       New_Occurrence_Of (RTE (RE_Same_Partition), Loc),
                     Parameter_Associations =>
                       New_List (
                         Unchecked_Convert_To (RTE (RE_RACW_Stub_Type_Access),
                           New_Occurrence_Of (Parameter_Entity, Loc)),
                         Unchecked_Convert_To (RTE (RE_RACW_Stub_Type_Access),
                           New_Occurrence_Of (Controlling_Parameter, Loc))))),
             Reason => CE_Partition_Check_Failed));
      end Insert_Partition_Check;

   --  Start of processing for Build_Subprogram_Calling_Stubs

   begin
      Subp_Spec :=
        Copy_Specification (Loc,
          Spec     => Specification (Vis_Decl),
          New_Name => New_Name);

      if Locator = Empty then
         RCI_Locator := RCI_Cache;
         Spec_To_Use := Specification (Vis_Decl);
      else
         RCI_Locator := Locator;
         Spec_To_Use := Subp_Spec;
      end if;

      --  Find a controlling argument if we have a stub type. Also check
      --  if this subprogram can be made asynchronous.

      if Present (Stub_Type)
         and then Present (Parameter_Specifications (Spec_To_Use))
      then
         declare
            Current_Parameter : Node_Id :=
                                  First (Parameter_Specifications
                                           (Spec_To_Use));
         begin
            while Present (Current_Parameter) loop
               if
                 Is_RACW_Controlling_Formal (Current_Parameter, Stub_Type)
               then
                  if Controlling_Parameter = Empty then
                     Controlling_Parameter :=
                       Defining_Identifier (Current_Parameter);
                  else
                     Insert_Partition_Check (Current_Parameter);
                  end if;
               end if;

               Next (Current_Parameter);
            end loop;
         end;
      end if;

      pragma Assert (No (Stub_Type) or else Present (Controlling_Parameter));

      if Dynamically_Asynchronous then
         Asynchronous_Expr := Make_Selected_Component (Loc,
                                Prefix        => Controlling_Parameter,
                                Selector_Name => Name_Asynchronous);
      end if;

      Specific_Build_General_Calling_Stubs
        (Decls                 => Decls,
         Statements            => Statements,
         Target                => Specific_Build_Stub_Target (Loc,
                                    Decls, RCI_Locator, Controlling_Parameter),
         Subprogram_Id         => Subp_Id,
         Asynchronous          => Asynchronous_Expr,
         Is_Known_Asynchronous => Asynchronous
                                    and then not Dynamically_Asynchronous,
         Is_Known_Non_Asynchronous
                               => not Asynchronous
                                    and then not Dynamically_Asynchronous,
         Is_Function           => Nkind (Spec_To_Use) =
                                    N_Function_Specification,
         Spec                  => Spec_To_Use,
         Stub_Type             => Stub_Type,
         RACW_Type             => RACW_Type,
         Nod                   => Vis_Decl);

      RCI_Calling_Stubs_Table.Set
        (Defining_Unit_Name (Specification (Vis_Decl)),
         Defining_Unit_Name (Spec_To_Use));

      return
        Make_Subprogram_Body (Loc,
          Specification              => Subp_Spec,
          Declarations               => Decls,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc, Statements));
   end Build_Subprogram_Calling_Stubs;

   -------------------------
   -- Build_Subprogram_Id --
   -------------------------

   function Build_Subprogram_Id
     (Loc : Source_Ptr;
      E   : Entity_Id) return Node_Id
   is
   begin
      if Get_Subprogram_Ids (E).Str_Identifier = No_String then
         declare
            Current_Declaration : Node_Id;
            Current_Subp        : Entity_Id;
            Current_Subp_Str    : String_Id;
            Current_Subp_Number : Int := First_RCI_Subprogram_Id;

            pragma Warnings (Off, Current_Subp_Str);

         begin
            --  Build_Subprogram_Id is called outside of the context of
            --  generating calling or receiving stubs. Hence we are processing
            --  an 'Access attribute_reference for an RCI subprogram, for the
            --  purpose of obtaining a RAS value.

            pragma Assert
              (Is_Remote_Call_Interface (Scope (E))
                 and then
                  (Nkind (Parent (E)) = N_Procedure_Specification
                     or else
                   Nkind (Parent (E)) = N_Function_Specification));

            Current_Declaration :=
              First (Visible_Declarations
                (Package_Specification_Of_Scope (Scope (E))));
            while Present (Current_Declaration) loop
               if Nkind (Current_Declaration) = N_Subprogram_Declaration
                 and then Comes_From_Source (Current_Declaration)
               then
                  Current_Subp := Defining_Unit_Name (Specification (
                    Current_Declaration));

                  Assign_Subprogram_Identifier
                    (Current_Subp, Current_Subp_Number, Current_Subp_Str);

                  Current_Subp_Number := Current_Subp_Number + 1;
               end if;

               Next (Current_Declaration);
            end loop;
         end;
      end if;

      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            return Make_String_Literal (Loc, Get_Subprogram_Id (E));
         when others =>
            return Make_Integer_Literal (Loc, Get_Subprogram_Id (E));
      end case;
   end Build_Subprogram_Id;

   ------------------------
   -- Copy_Specification --
   ------------------------

   function Copy_Specification
     (Loc         : Source_Ptr;
      Spec        : Node_Id;
      Ctrl_Type   : Entity_Id := Empty;
      New_Name    : Name_Id   := No_Name) return Node_Id
   is
      Parameters : List_Id := No_List;

      Current_Parameter  : Node_Id;
      Current_Identifier : Entity_Id;
      Current_Type       : Node_Id;

      Name_For_New_Spec : Name_Id;

      New_Identifier : Entity_Id;

   --  Comments needed in body below ???

   begin
      if New_Name = No_Name then
         pragma Assert (Nkind (Spec) = N_Function_Specification
                or else Nkind (Spec) = N_Procedure_Specification);

         Name_For_New_Spec := Chars (Defining_Unit_Name (Spec));
      else
         Name_For_New_Spec := New_Name;
      end if;

      if Present (Parameter_Specifications (Spec)) then
         Parameters        := New_List;
         Current_Parameter := First (Parameter_Specifications (Spec));
         while Present (Current_Parameter) loop
            Current_Identifier := Defining_Identifier (Current_Parameter);
            Current_Type       := Parameter_Type (Current_Parameter);

            if Nkind (Current_Type) = N_Access_Definition then
               if Present (Ctrl_Type) then
                  pragma Assert (Is_Controlling_Formal (Current_Identifier));
                  Current_Type :=
                    Make_Access_Definition (Loc,
                      Subtype_Mark => New_Occurrence_Of (Ctrl_Type, Loc),
                      Null_Exclusion_Present =>
                        Null_Exclusion_Present (Current_Type));

               else
                  Current_Type :=
                    Make_Access_Definition (Loc,
                      Subtype_Mark =>
                        New_Copy_Tree (Subtype_Mark (Current_Type)),
                      Null_Exclusion_Present =>
                        Null_Exclusion_Present (Current_Type));
               end if;

            else
               if Present (Ctrl_Type)
                 and then Is_Controlling_Formal (Current_Identifier)
               then
                  Current_Type := New_Occurrence_Of (Ctrl_Type, Loc);
               else
                  Current_Type := New_Copy_Tree (Current_Type);
               end if;
            end if;

            New_Identifier := Make_Defining_Identifier (Loc,
              Chars (Current_Identifier));

            Append_To (Parameters,
              Make_Parameter_Specification (Loc,
                Defining_Identifier => New_Identifier,
                Parameter_Type      => Current_Type,
                In_Present          => In_Present (Current_Parameter),
                Out_Present         => Out_Present (Current_Parameter),
                Expression          =>
                  New_Copy_Tree (Expression (Current_Parameter))));

            --  For a regular formal parameter (that needs to be marshalled
            --  in the context of remote calls), set the Etype now, because
            --  marshalling processing might need it.

            if Is_Entity_Name (Current_Type) then
               Set_Etype (New_Identifier, Entity (Current_Type));

            --  Current_Type is an access definition, special processing
            --  (not requiring etype) will occur for marshalling.

            else
               null;
            end if;

            Next (Current_Parameter);
         end loop;
      end if;

      case Nkind (Spec) is

         when N_Function_Specification | N_Access_Function_Definition =>
            return
              Make_Function_Specification (Loc,
                Defining_Unit_Name       =>
                  Make_Defining_Identifier (Loc,
                    Chars => Name_For_New_Spec),
                Parameter_Specifications => Parameters,
                Result_Definition        =>
                  New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));

         when N_Procedure_Specification | N_Access_Procedure_Definition =>
            return
              Make_Procedure_Specification (Loc,
                Defining_Unit_Name       =>
                  Make_Defining_Identifier (Loc,
                    Chars => Name_For_New_Spec),
                Parameter_Specifications => Parameters);

         when others =>
            raise Program_Error;
      end case;
   end Copy_Specification;

   -----------------------------
   -- Corresponding_Stub_Type --
   -----------------------------

   function Corresponding_Stub_Type (RACW_Type : Entity_Id) return Entity_Id is
      Desig         : constant Entity_Id      :=
                        Etype (Designated_Type (RACW_Type));
      Stub_Elements : constant Stub_Structure := Stubs_Table.Get (Desig);
   begin
      return Stub_Elements.Stub_Type;
   end Corresponding_Stub_Type;

   ---------------------------
   -- Could_Be_Asynchronous --
   ---------------------------

   function Could_Be_Asynchronous (Spec : Node_Id) return Boolean is
      Current_Parameter : Node_Id;

   begin
      if Present (Parameter_Specifications (Spec)) then
         Current_Parameter := First (Parameter_Specifications (Spec));
         while Present (Current_Parameter) loop
            if Out_Present (Current_Parameter) then
               return False;
            end if;

            Next (Current_Parameter);
         end loop;
      end if;

      return True;
   end Could_Be_Asynchronous;

   ---------------------------
   -- Declare_Create_NVList --
   ---------------------------

   procedure Declare_Create_NVList
     (Loc    : Source_Ptr;
      NVList : Entity_Id;
      Decls  : List_Id;
      Stmts  : List_Id)
   is
   begin
      Append_To (Decls,
        Make_Object_Declaration (Loc,
          Defining_Identifier => NVList,
          Aliased_Present     => False,
          Object_Definition   =>
              New_Occurrence_Of (RTE (RE_NVList_Ref), Loc)));

      Append_To (Stmts,
        Make_Procedure_Call_Statement (Loc,
          Name => New_Occurrence_Of (RTE (RE_NVList_Create), Loc),
          Parameter_Associations => New_List (
            New_Occurrence_Of (NVList, Loc))));
   end Declare_Create_NVList;

   ---------------------------------------------
   -- Expand_All_Calls_Remote_Subprogram_Call --
   ---------------------------------------------

   procedure Expand_All_Calls_Remote_Subprogram_Call (N : Node_Id) is
      Loc               : constant Source_Ptr := Sloc (N);
      Called_Subprogram : constant Entity_Id  := Entity (Name (N));
      RCI_Package       : constant Entity_Id  := Scope (Called_Subprogram);
      RCI_Locator_Decl  : Node_Id;
      RCI_Locator       : Entity_Id;
      Calling_Stubs     : Node_Id;
      E_Calling_Stubs   : Entity_Id;

   begin
      E_Calling_Stubs := RCI_Calling_Stubs_Table.Get (Called_Subprogram);

      if E_Calling_Stubs = Empty then
         RCI_Locator := RCI_Locator_Table.Get (RCI_Package);

         --  The RCI_Locator package and calling stub are is inserted at the
         --  top level in the current unit, and must appear in the proper scope
         --  so that it is not prematurely removed by the GCC back end.

         declare
            Scop : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
         begin
            if Ekind (Scop) = E_Package_Body then
               Push_Scope (Spec_Entity (Scop));
            elsif Ekind (Scop) = E_Subprogram_Body then
               Push_Scope
                 (Corresponding_Spec (Unit_Declaration_Node (Scop)));
            else
               Push_Scope (Scop);
            end if;
         end;

         if RCI_Locator = Empty then
            RCI_Locator_Decl :=
              RCI_Package_Locator
                (Loc, Specification (Unit_Declaration_Node (RCI_Package)));
            Prepend_To (Current_Sem_Unit_Declarations, RCI_Locator_Decl);
            Analyze (RCI_Locator_Decl);
            RCI_Locator := Defining_Unit_Name (RCI_Locator_Decl);

         else
            RCI_Locator_Decl := Parent (RCI_Locator);
         end if;

         Calling_Stubs := Build_Subprogram_Calling_Stubs
           (Vis_Decl               => Parent (Parent (Called_Subprogram)),
            Subp_Id                =>
              Build_Subprogram_Id (Loc, Called_Subprogram),
            Asynchronous           => Nkind (N) = N_Procedure_Call_Statement
                                        and then
                                      Is_Asynchronous (Called_Subprogram),
            Locator                => RCI_Locator,
            New_Name               => New_Internal_Name ('S'));
         Insert_After (RCI_Locator_Decl, Calling_Stubs);
         Analyze (Calling_Stubs);
         Pop_Scope;

         E_Calling_Stubs := Defining_Unit_Name (Specification (Calling_Stubs));
      end if;

      Rewrite (Name (N), New_Occurrence_Of (E_Calling_Stubs, Loc));
   end Expand_All_Calls_Remote_Subprogram_Call;

   ---------------------------------
   -- Expand_Calling_Stubs_Bodies --
   ---------------------------------

   procedure Expand_Calling_Stubs_Bodies (Unit_Node : Node_Id) is
      Spec  : constant Node_Id := Specification (Unit_Node);
      Decls : constant List_Id := Visible_Declarations (Spec);
   begin
      Push_Scope (Scope_Of_Spec (Spec));
      Add_Calling_Stubs_To_Declarations
        (Specification (Unit_Node), Decls);
      Pop_Scope;
   end Expand_Calling_Stubs_Bodies;

   -----------------------------------
   -- Expand_Receiving_Stubs_Bodies --
   -----------------------------------

   procedure Expand_Receiving_Stubs_Bodies (Unit_Node : Node_Id) is
      Spec        : Node_Id;
      Decls       : List_Id;
      Stubs_Decls : List_Id;
      Stubs_Stmts : List_Id;

   begin
      if Nkind (Unit_Node) = N_Package_Declaration then
         Spec  := Specification (Unit_Node);
         Decls := Private_Declarations (Spec);

         if No (Decls) then
            Decls := Visible_Declarations (Spec);
         end if;

         Push_Scope (Scope_Of_Spec (Spec));
         Specific_Add_Receiving_Stubs_To_Declarations (Spec, Decls, Decls);

      else
         Spec :=
           Package_Specification_Of_Scope (Corresponding_Spec (Unit_Node));
         Decls := Declarations (Unit_Node);

         Push_Scope (Scope_Of_Spec (Unit_Node));
         Stubs_Decls := New_List;
         Stubs_Stmts := New_List;
         Specific_Add_Receiving_Stubs_To_Declarations
           (Spec, Stubs_Decls, Stubs_Stmts);

         Insert_List_Before (First (Decls), Stubs_Decls);

         declare
            HSS_Stmts : constant List_Id :=
                          Statements (Handled_Statement_Sequence (Unit_Node));

            First_HSS_Stmt : constant Node_Id := First (HSS_Stmts);

         begin
            if No (First_HSS_Stmt) then
               Append_List_To (HSS_Stmts, Stubs_Stmts);
            else
               Insert_List_Before (First_HSS_Stmt, Stubs_Stmts);
            end if;
         end;
      end if;

      Pop_Scope;
   end Expand_Receiving_Stubs_Bodies;

   --------------------
   -- GARLIC_Support --
   --------------------

   package body GARLIC_Support is

      --  Local subprograms

      procedure Add_RACW_Read_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         Body_Decls       : List_Id);
      --  Add Read attribute for the RACW type. The declaration and attribute
      --  definition clauses are inserted right after the declaration of
      --  RACW_Type. If Body_Decls is not No_List, the subprogram body is
      --  appended to it (case where the RACW declaration is in the main unit).

      procedure Add_RACW_Write_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         RPC_Receiver     : Node_Id;
         Body_Decls       : List_Id);
      --  Same as above for the Write attribute

      function Stream_Parameter return Node_Id;
      function Result return Node_Id;
      function Object return Node_Id renames Result;
      --  Functions to create occurrences of the formal parameter names of the
      --  'Read and 'Write attributes.

      Loc : Source_Ptr;
      --  Shared source location used by Add_{Read,Write}_Read_Attribute and
      --  their ancillary subroutines (set on entry by Add_RACW_Features).

      procedure Add_RAS_Access_TSS (N : Node_Id);
      --  Add a subprogram body for RAS Access TSS

      -------------------------------------
      -- Add_Obj_RPC_Receiver_Completion --
      -------------------------------------

      procedure Add_Obj_RPC_Receiver_Completion
        (Loc           : Source_Ptr;
         Decls         : List_Id;
         RPC_Receiver  : Entity_Id;
         Stub_Elements : Stub_Structure)
      is
      begin
         --  The RPC receiver body should not be the completion of the
         --  declaration recorded in the stub structure, because then the
         --  occurrences of the formal parameters within the body should refer
         --  to the entities from the declaration, not from the completion, to
         --  which we do not have easy access. Instead, the RPC receiver body
         --  acts as its own declaration, and the RPC receiver declaration is
         --  completed by a renaming-as-body.

         Append_To (Decls,
           Make_Subprogram_Renaming_Declaration (Loc,
             Specification =>
               Copy_Specification (Loc,
                 Specification (Stub_Elements.RPC_Receiver_Decl)),
             Name          => New_Occurrence_Of (RPC_Receiver, Loc)));
      end Add_Obj_RPC_Receiver_Completion;

      -----------------------
      -- Add_RACW_Features --
      -----------------------

      procedure Add_RACW_Features
        (RACW_Type         : Entity_Id;
         Stub_Type         : Entity_Id;
         Stub_Type_Access  : Entity_Id;
         RPC_Receiver_Decl : Node_Id;
         Body_Decls        : List_Id)
      is
         RPC_Receiver : Node_Id;
         Is_RAS       : constant Boolean := not Comes_From_Source (RACW_Type);

      begin
         Loc := Sloc (RACW_Type);

         if Is_RAS then

            --  For a RAS, the RPC receiver is that of the RCI unit, not that
            --  of the corresponding distributed object type. We retrieve its
            --  address from the local proxy object.

            RPC_Receiver := Make_Selected_Component (Loc,
              Prefix         =>
                Unchecked_Convert_To (RTE (RE_RAS_Proxy_Type_Access), Object),
              Selector_Name  => Make_Identifier (Loc, Name_Receiver));

         else
            RPC_Receiver := Make_Attribute_Reference (Loc,
              Prefix         => New_Occurrence_Of (
                Defining_Unit_Name (Specification (RPC_Receiver_Decl)), Loc),
              Attribute_Name => Name_Address);
         end if;

         Add_RACW_Write_Attribute
           (RACW_Type,
            Stub_Type,
            Stub_Type_Access,
            RPC_Receiver,
            Body_Decls);

         Add_RACW_Read_Attribute
           (RACW_Type,
            Stub_Type,
            Stub_Type_Access,
            Body_Decls);
      end Add_RACW_Features;

      -----------------------------
      -- Add_RACW_Read_Attribute --
      -----------------------------

      procedure Add_RACW_Read_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         Body_Decls       : List_Id)
      is
         Proc_Decl : Node_Id;
         Attr_Decl : Node_Id;

         Body_Node : Node_Id;

         Statements        : constant List_Id := New_List;
         Decls             : List_Id;
         Local_Statements  : List_Id;
         Remote_Statements : List_Id;
         --  Various parts of the procedure

         Pnam              : constant Entity_Id := Make_Temporary (Loc, 'R');
         Asynchronous_Flag : constant Entity_Id :=
                               Asynchronous_Flags_Table.Get (RACW_Type);
         pragma Assert (Present (Asynchronous_Flag));

         --  Prepare local identifiers

         Source_Partition : Entity_Id;
         Source_Receiver  : Entity_Id;
         Source_Address   : Entity_Id;
         Local_Stub       : Entity_Id;
         Stubbed_Result   : Entity_Id;

      --  Start of processing for Add_RACW_Read_Attribute

      begin
         Build_Stream_Procedure (Loc,
           RACW_Type, Body_Node, Pnam, Statements, Outp => True);
         Proc_Decl := Make_Subprogram_Declaration (Loc,
           Copy_Specification (Loc, Specification (Body_Node)));

         Attr_Decl :=
           Make_Attribute_Definition_Clause (Loc,
             Name       => New_Occurrence_Of (RACW_Type, Loc),
             Chars      => Name_Read,
             Expression =>
               New_Occurrence_Of (
                 Defining_Unit_Name (Specification (Proc_Decl)), Loc));

         Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
         Insert_After (Proc_Decl, Attr_Decl);

         if No (Body_Decls) then

            --  Case of processing an RACW type from another unit than the
            --  main one: do not generate a body.

            return;
         end if;

         --  Prepare local identifiers

         Source_Partition := Make_Temporary (Loc, 'P');
         Source_Receiver  := Make_Temporary (Loc, 'S');
         Source_Address   := Make_Temporary (Loc, 'P');
         Local_Stub       := Make_Temporary (Loc, 'L');
         Stubbed_Result   := Make_Temporary (Loc, 'S');

         --  Generate object declarations

         Decls := New_List (
           Make_Object_Declaration (Loc,
             Defining_Identifier => Source_Partition,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Partition_ID), Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Source_Receiver,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Source_Address,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Local_Stub,
             Aliased_Present     => True,
             Object_Definition   => New_Occurrence_Of (Stub_Type, Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Stubbed_Result,
             Object_Definition   =>
               New_Occurrence_Of (Stub_Type_Access, Loc),
             Expression          =>
               Make_Attribute_Reference (Loc,
                 Prefix =>
                   New_Occurrence_Of (Local_Stub, Loc),
                 Attribute_Name =>
                   Name_Unchecked_Access)));

         --  Read the source Partition_ID and RPC_Receiver from incoming stream

         Append_List_To (Statements, New_List (
           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (RTE (RE_Partition_ID), Loc),
             Attribute_Name => Name_Read,
             Expressions    => New_List (
               Stream_Parameter,
               New_Occurrence_Of (Source_Partition, Loc))),

           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc),
             Attribute_Name =>
               Name_Read,
             Expressions    => New_List (
               Stream_Parameter,
               New_Occurrence_Of (Source_Receiver, Loc))),

           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc),
             Attribute_Name =>
               Name_Read,
             Expressions    => New_List (
               Stream_Parameter,
               New_Occurrence_Of (Source_Address, Loc)))));

         --  Build_Get_Unique_RP_Call needs the type of Stubbed_Result

         Set_Etype (Stubbed_Result, Stub_Type_Access);

         --  If the Address is Null_Address, then return a null object, unless
         --  RACW_Type is null-excluding, in which case unconditionally raise
         --  CONSTRAINT_ERROR instead.

         declare
            Zero_Statements : List_Id;
            --  Statements executed when a zero value is received

         begin
            if Can_Never_Be_Null (RACW_Type) then
               Zero_Statements := New_List (
                 Make_Raise_Constraint_Error (Loc,
                   Reason => CE_Null_Not_Allowed));
            else
               Zero_Statements := New_List (
                 Make_Assignment_Statement (Loc,
                   Name       => Result,
                   Expression => Make_Null (Loc)),
                 Make_Simple_Return_Statement (Loc));
            end if;

            Append_To (Statements,
              Make_Implicit_If_Statement (RACW_Type,
                Condition       =>
                  Make_Op_Eq (Loc,
                    Left_Opnd  => New_Occurrence_Of (Source_Address, Loc),
                    Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
                Then_Statements => Zero_Statements));
         end;

         --  If the RACW denotes an object created on the current partition,
         --  Local_Statements will be executed. The real object will be used.

         Local_Statements := New_List (
           Make_Assignment_Statement (Loc,
             Name       => Result,
             Expression =>
               Unchecked_Convert_To (RACW_Type,
                 OK_Convert_To (RTE (RE_Address),
                   New_Occurrence_Of (Source_Address, Loc)))));

         --  If the object is located on another partition, then a stub object
         --  will be created with all the information needed to rebuild the
         --  real object at the other end.

         Remote_Statements := New_List (

           Make_Assignment_Statement (Loc,
             Name       => Make_Selected_Component (Loc,
               Prefix        => Stubbed_Result,
               Selector_Name => Name_Origin),
             Expression =>
               New_Occurrence_Of (Source_Partition, Loc)),

           Make_Assignment_Statement (Loc,
             Name       => Make_Selected_Component (Loc,
               Prefix        => Stubbed_Result,
               Selector_Name => Name_Receiver),
             Expression =>
               New_Occurrence_Of (Source_Receiver, Loc)),

           Make_Assignment_Statement (Loc,
             Name       => Make_Selected_Component (Loc,
               Prefix        => Stubbed_Result,
               Selector_Name => Name_Addr),
             Expression =>
               New_Occurrence_Of (Source_Address, Loc)));

         Append_To (Remote_Statements,
           Make_Assignment_Statement (Loc,
             Name       => Make_Selected_Component (Loc,
               Prefix        => Stubbed_Result,
               Selector_Name => Name_Asynchronous),
             Expression =>
               New_Occurrence_Of (Asynchronous_Flag, Loc)));

         Append_List_To (Remote_Statements,
           Build_Get_Unique_RP_Call (Loc, Stubbed_Result, Stub_Type));
         --  ??? Issue with asynchronous calls here: the Asynchronous flag is
         --  set on the stub type if, and only if, the RACW type has a pragma
         --  Asynchronous. This is incorrect for RACWs that implement RAS
         --  types, because in that case the /designated subprogram/ (not the
         --  type) might be asynchronous, and that causes the stub to need to
         --  be asynchronous too. A solution is to transport a RAS as a struct
         --  containing a RACW and an asynchronous flag, and to properly alter
         --  the Asynchronous component in the stub type in the RAS's Input
         --  TSS.

         Append_To (Remote_Statements,
           Make_Assignment_Statement (Loc,
             Name       => Result,
             Expression => Unchecked_Convert_To (RACW_Type,
               New_Occurrence_Of (Stubbed_Result, Loc))));

         --  Distinguish between the local and remote cases, and execute the
         --  appropriate piece of code.

         Append_To (Statements,
           Make_Implicit_If_Statement (RACW_Type,
             Condition       =>
               Make_Op_Eq (Loc,
                 Left_Opnd  =>
                   Make_Function_Call (Loc,
                     Name => New_Occurrence_Of (
                       RTE (RE_Get_Local_Partition_Id), Loc)),
                 Right_Opnd => New_Occurrence_Of (Source_Partition, Loc)),
             Then_Statements => Local_Statements,
             Else_Statements => Remote_Statements));

         Set_Declarations (Body_Node, Decls);
         Append_To (Body_Decls, Body_Node);
      end Add_RACW_Read_Attribute;

      ------------------------------
      -- Add_RACW_Write_Attribute --
      ------------------------------

      procedure Add_RACW_Write_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         RPC_Receiver     : Node_Id;
         Body_Decls       : List_Id)
      is
         Body_Node : Node_Id;
         Proc_Decl : Node_Id;
         Attr_Decl : Node_Id;

         Statements        : constant List_Id := New_List;
         Local_Statements  : List_Id;
         Remote_Statements : List_Id;
         Null_Statements   : List_Id;

         Pnam : constant Entity_Id := Make_Temporary (Loc, 'R');

      begin
         Build_Stream_Procedure
           (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => False);

         Proc_Decl := Make_Subprogram_Declaration (Loc,
           Copy_Specification (Loc, Specification (Body_Node)));

         Attr_Decl :=
           Make_Attribute_Definition_Clause (Loc,
             Name       => New_Occurrence_Of (RACW_Type, Loc),
             Chars      => Name_Write,
             Expression =>
               New_Occurrence_Of (
                 Defining_Unit_Name (Specification (Proc_Decl)), Loc));

         Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
         Insert_After (Proc_Decl, Attr_Decl);

         if No (Body_Decls) then
            return;
         end if;

         --  Build the code fragment corresponding to the marshalling of a
         --  local object.

         Local_Statements := New_List (

           Pack_Entity_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object => RTE (RE_Get_Local_Partition_Id)),

           Pack_Node_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object => OK_Convert_To (RTE (RE_Unsigned_64), RPC_Receiver),
             Etyp   => RTE (RE_Unsigned_64)),

          Pack_Node_Into_Stream_Access (Loc,
            Stream => Stream_Parameter,
            Object => OK_Convert_To (RTE (RE_Unsigned_64),
              Make_Attribute_Reference (Loc,
                Prefix         =>
                  Make_Explicit_Dereference (Loc,
                    Prefix => Object),
                Attribute_Name => Name_Address)),
            Etyp   => RTE (RE_Unsigned_64)));

         --  Build the code fragment corresponding to the marshalling of
         --  a remote object.

         Remote_Statements := New_List (
           Pack_Node_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object =>
               Make_Selected_Component (Loc,
                 Prefix        =>
                   Unchecked_Convert_To (Stub_Type_Access, Object),
                 Selector_Name => Make_Identifier (Loc, Name_Origin)),
            Etyp    => RTE (RE_Partition_ID)),

           Pack_Node_Into_Stream_Access (Loc,
            Stream => Stream_Parameter,
            Object =>
               Make_Selected_Component (Loc,
                 Prefix        =>
                   Unchecked_Convert_To (Stub_Type_Access, Object),
                 Selector_Name => Make_Identifier (Loc, Name_Receiver)),
            Etyp   => RTE (RE_Unsigned_64)),

           Pack_Node_Into_Stream_Access (Loc,
            Stream => Stream_Parameter,
            Object =>
               Make_Selected_Component (Loc,
                 Prefix        =>
                   Unchecked_Convert_To (Stub_Type_Access, Object),
                 Selector_Name => Make_Identifier (Loc, Name_Addr)),
            Etyp   => RTE (RE_Unsigned_64)));

         --  Build code fragment corresponding to marshalling of a null object

         Null_Statements := New_List (

           Pack_Entity_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object => RTE (RE_Get_Local_Partition_Id)),

           Pack_Node_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object => OK_Convert_To (RTE (RE_Unsigned_64), RPC_Receiver),
             Etyp   => RTE (RE_Unsigned_64)),

           Pack_Node_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object => Make_Integer_Literal (Loc, Uint_0),
             Etyp   => RTE (RE_Unsigned_64)));

         Append_To (Statements,
           Make_Implicit_If_Statement (RACW_Type,
             Condition       =>
               Make_Op_Eq (Loc,
                 Left_Opnd  => Object,
                 Right_Opnd => Make_Null (Loc)),

             Then_Statements => Null_Statements,

             Elsif_Parts     => New_List (
               Make_Elsif_Part (Loc,
                 Condition       =>
                   Make_Op_Eq (Loc,
                     Left_Opnd  =>
                       Make_Attribute_Reference (Loc,
                         Prefix         => Object,
                         Attribute_Name => Name_Tag),

                     Right_Opnd =>
                       Make_Attribute_Reference (Loc,
                         Prefix         => New_Occurrence_Of (Stub_Type, Loc),
                         Attribute_Name => Name_Tag)),
                 Then_Statements => Remote_Statements)),
             Else_Statements => Local_Statements));

         Append_To (Body_Decls, Body_Node);
      end Add_RACW_Write_Attribute;

      ------------------------
      -- Add_RAS_Access_TSS --
      ------------------------

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

         Ras_Type : constant Entity_Id := Defining_Identifier (N);
         Fat_Type : constant Entity_Id := Equivalent_Type (Ras_Type);
         --  Ras_Type is the access to subprogram type while Fat_Type is the
         --  corresponding record type.

         RACW_Type : constant Entity_Id :=
                       Underlying_RACW_Type (Ras_Type);
         Desig     : constant Entity_Id :=
                       Etype (Designated_Type (RACW_Type));

         Stub_Elements : constant Stub_Structure :=
                           Stubs_Table.Get (Desig);
         pragma Assert (Stub_Elements /= Empty_Stub_Structure);

         Proc : constant Entity_Id :=
                  Make_Defining_Identifier (Loc,
                    Chars => Make_TSS_Name (Ras_Type, TSS_RAS_Access));

         Proc_Spec : Node_Id;

         --  Formal parameters

         Package_Name : constant Entity_Id :=
                          Make_Defining_Identifier (Loc,
                            Chars => Name_P);
         --  Target package

         Subp_Id : constant Entity_Id :=
                     Make_Defining_Identifier (Loc,
                       Chars => Name_S);
         --  Target subprogram

         Asynch_P : constant Entity_Id :=
                      Make_Defining_Identifier (Loc,
                        Chars => Name_Asynchronous);
         --  Is the procedure to which the 'Access applies asynchronous?

         All_Calls_Remote : constant Entity_Id :=
                              Make_Defining_Identifier (Loc,
                                Chars => Name_All_Calls_Remote);
         --  True if an All_Calls_Remote pragma applies to the RCI unit
         --  that contains the subprogram.

         --  Common local variables

         Proc_Decls      : List_Id;
         Proc_Statements : List_Id;

         Origin : constant Entity_Id := Make_Temporary (Loc, 'P');

         --  Additional local variables for the local case

         Proxy_Addr : constant Entity_Id := Make_Temporary (Loc, 'P');

         --  Additional local variables for the remote case

         Local_Stub : constant Entity_Id := Make_Temporary (Loc, 'L');
         Stub_Ptr   : constant Entity_Id := Make_Temporary (Loc, 'S');

         function Set_Field
           (Field_Name : Name_Id;
            Value      : Node_Id) return Node_Id;
         --  Construct an assignment that sets the named component in the
         --  returned record

         ---------------
         -- Set_Field --
         ---------------

         function Set_Field
           (Field_Name : Name_Id;
            Value      : Node_Id) return Node_Id
         is
         begin
            return
              Make_Assignment_Statement (Loc,
                Name       =>
                  Make_Selected_Component (Loc,
                    Prefix        => Stub_Ptr,
                    Selector_Name => Field_Name),
                Expression => Value);
         end Set_Field;

      --  Start of processing for Add_RAS_Access_TSS

      begin
         Proc_Decls := New_List (

            --  Common declarations

           Make_Object_Declaration (Loc,
             Defining_Identifier => Origin,
             Constant_Present    => True,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Partition_ID), Loc),
             Expression          =>
               Make_Function_Call (Loc,
                 Name                   =>
                   New_Occurrence_Of (RTE (RE_Get_Active_Partition_Id), Loc),
                 Parameter_Associations => New_List (
                   New_Occurrence_Of (Package_Name, Loc)))),

            --  Declaration use only in the local case: proxy address

           Make_Object_Declaration (Loc,
             Defining_Identifier => Proxy_Addr,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)),

            --  Declarations used only in the remote case: stub object and
            --  stub pointer.

           Make_Object_Declaration (Loc,
             Defining_Identifier => Local_Stub,
             Aliased_Present     => True,
             Object_Definition   =>
               New_Occurrence_Of (Stub_Elements.Stub_Type, Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier =>
               Stub_Ptr,
             Object_Definition   =>
               New_Occurrence_Of (Stub_Elements.Stub_Type_Access, Loc),
             Expression          =>
               Make_Attribute_Reference (Loc,
                 Prefix => New_Occurrence_Of (Local_Stub, Loc),
                 Attribute_Name => Name_Unchecked_Access)));

         Set_Etype (Stub_Ptr, Stub_Elements.Stub_Type_Access);

         --  Build_Get_Unique_RP_Call needs above information

         --  Note: Here we assume that the Fat_Type is a record
         --  containing just a pointer to a proxy or stub object.

         Proc_Statements := New_List (

         --  Generate:

         --    Get_RAS_Info (Pkg, Subp, PA);
         --    if Origin = Local_Partition_Id
         --      and then not All_Calls_Remote
         --    then
         --       return Fat_Type!(PA);
         --    end if;

            Make_Procedure_Call_Statement (Loc,
              Name => New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc),
              Parameter_Associations => New_List (
                New_Occurrence_Of (Package_Name, Loc),
                New_Occurrence_Of (Subp_Id, Loc),
                New_Occurrence_Of (Proxy_Addr, Loc))),

           Make_Implicit_If_Statement (N,
             Condition =>
               Make_And_Then (Loc,
                 Left_Opnd  =>
                   Make_Op_Eq (Loc,
                     Left_Opnd =>
                       New_Occurrence_Of (Origin, Loc),
                     Right_Opnd =>
                       Make_Function_Call (Loc,
                         New_Occurrence_Of (
                           RTE (RE_Get_Local_Partition_Id), Loc))),

                 Right_Opnd =>
                   Make_Op_Not (Loc,
                     New_Occurrence_Of (All_Calls_Remote, Loc))),

             Then_Statements => New_List (
               Make_Simple_Return_Statement (Loc,
                 Unchecked_Convert_To (Fat_Type,
                   OK_Convert_To (RTE (RE_Address),
                     New_Occurrence_Of (Proxy_Addr, Loc)))))),

           Set_Field (Name_Origin,
               New_Occurrence_Of (Origin, Loc)),

           Set_Field (Name_Receiver,
             Make_Function_Call (Loc,
               Name                   =>
                 New_Occurrence_Of (RTE (RE_Get_RCI_Package_Receiver), Loc),
               Parameter_Associations => New_List (
                 New_Occurrence_Of (Package_Name, Loc)))),

           Set_Field (Name_Addr, New_Occurrence_Of (Proxy_Addr, Loc)),

            --  E.4.1(9) A remote call is asynchronous if it is a call to
            --  a procedure or a call through a value of an access-to-procedure
            --  type to which a pragma Asynchronous applies.

            --  Asynch_P is true when the procedure is asynchronous;
            --  Asynch_T is true when the type is asynchronous.

           Set_Field (Name_Asynchronous,
             Make_Or_Else (Loc,
               New_Occurrence_Of (Asynch_P, Loc),
               New_Occurrence_Of (Boolean_Literals (
                 Is_Asynchronous (Ras_Type)), Loc))));

         Append_List_To (Proc_Statements,
           Build_Get_Unique_RP_Call
             (Loc, Stub_Ptr, Stub_Elements.Stub_Type));

         --  Return the newly created value

         Append_To (Proc_Statements,
           Make_Simple_Return_Statement (Loc,
             Expression =>
               Unchecked_Convert_To (Fat_Type,
                 New_Occurrence_Of (Stub_Ptr, Loc))));

         Proc_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name       => Proc,
             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Package_Name,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_String, Loc)),

               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Subp_Id,
                 Parameter_Type      =>
                   New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc)),

               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Asynch_P,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_Boolean, Loc)),

               Make_Parameter_Specification (Loc,
                 Defining_Identifier => All_Calls_Remote,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_Boolean, Loc))),

            Result_Definition =>
              New_Occurrence_Of (Fat_Type, Loc));

         --  Set the kind and return type of the function to prevent
         --  ambiguities between Ras_Type and Fat_Type in subsequent analysis.

         Set_Ekind (Proc, E_Function);
         Set_Etype (Proc, Fat_Type);

         Discard_Node (
           Make_Subprogram_Body (Loc,
             Specification              => Proc_Spec,
             Declarations               => Proc_Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Proc_Statements)));

         Set_TSS (Fat_Type, Proc);
      end Add_RAS_Access_TSS;

      -----------------------
      -- Add_RAST_Features --
      -----------------------

      procedure Add_RAST_Features
        (Vis_Decl : Node_Id;
         RAS_Type : Entity_Id)
      is
         pragma Unreferenced (RAS_Type);
      begin
         Add_RAS_Access_TSS (Vis_Decl);
      end Add_RAST_Features;

      -----------------------------------------
      -- Add_Receiving_Stubs_To_Declarations --
      -----------------------------------------

      procedure Add_Receiving_Stubs_To_Declarations
        (Pkg_Spec : Node_Id;
         Decls    : List_Id;
         Stmts    : List_Id)
      is
         Loc : constant Source_Ptr := Sloc (Pkg_Spec);

         Request_Parameter : Node_Id;

         Pkg_RPC_Receiver            : constant Entity_Id :=
                                         Make_Temporary (Loc, 'H');
         Pkg_RPC_Receiver_Statements : List_Id;
         Pkg_RPC_Receiver_Cases      : constant List_Id := New_List;
         Pkg_RPC_Receiver_Body       : Node_Id;
         --  A Pkg_RPC_Receiver is built to decode the request

         Lookup_RAS_Info : constant Entity_Id := Make_Temporary (Loc, 'R');
         --  A remote subprogram is created to allow peers to look up RAS
         --  information using subprogram ids.

         Subp_Id    : Entity_Id;
         Subp_Index : Entity_Id;
         --  Subprogram_Id as read from the incoming stream

         Current_Declaration       : Node_Id;
         Current_Subprogram_Number : Int := First_RCI_Subprogram_Id;
         Current_Stubs             : Node_Id;

         Subp_Info_Array : constant Entity_Id := Make_Temporary (Loc, 'I');
         Subp_Info_List  : constant List_Id := New_List;

         Register_Pkg_Actuals : constant List_Id := New_List;

         All_Calls_Remote_E  : Entity_Id;
         Proxy_Object_Addr   : Entity_Id;

         procedure Append_Stubs_To
           (RPC_Receiver_Cases : List_Id;
            Stubs              : Node_Id;
            Subprogram_Number  : Int);
         --  Add one case to the specified RPC receiver case list
         --  associating Subprogram_Number with the subprogram declared
         --  by Declaration, for which we have receiving stubs in Stubs.

         ---------------------
         -- Append_Stubs_To --
         ---------------------

         procedure Append_Stubs_To
           (RPC_Receiver_Cases : List_Id;
            Stubs              : Node_Id;
            Subprogram_Number  : Int)
         is
         begin
            Append_To (RPC_Receiver_Cases,
              Make_Case_Statement_Alternative (Loc,
                Discrete_Choices =>
                   New_List (Make_Integer_Literal (Loc, Subprogram_Number)),
                Statements       =>
                  New_List (
                    Make_Procedure_Call_Statement (Loc,
                      Name                   =>
                        New_Occurrence_Of (Defining_Entity (Stubs), Loc),
                      Parameter_Associations => New_List (
                        New_Occurrence_Of (Request_Parameter, Loc))))));
         end Append_Stubs_To;

      --  Start of processing for Add_Receiving_Stubs_To_Declarations

      begin
         --  Building receiving stubs consist in several operations:

         --    - a package RPC receiver must be built. This subprogram
         --      will get a Subprogram_Id from the incoming stream
         --      and will dispatch the call to the right subprogram;

         --    - a receiving stub for each subprogram visible in the package
         --      spec. This stub will read all the parameters from the stream,
         --      and put the result as well as the exception occurrence in the
         --      output stream;

         --    - a dummy package with an empty spec and a body made of an
         --      elaboration part, whose job is to register the receiving
         --      part of this RCI package on the name server. This is done
         --      by calling System.Partition_Interface.Register_Receiving_Stub.

         Build_RPC_Receiver_Body (
           RPC_Receiver => Pkg_RPC_Receiver,
           Request      => Request_Parameter,
           Subp_Id      => Subp_Id,
           Subp_Index   => Subp_Index,
           Stmts        => Pkg_RPC_Receiver_Statements,
           Decl         => Pkg_RPC_Receiver_Body);
         pragma Assert (Subp_Id = Subp_Index);

         --  A null subp_id denotes a call through a RAS, in which case the
         --  next Uint_64 element in the stream is the address of the local
         --  proxy object, from which we can retrieve the actual subprogram id.

         Append_To (Pkg_RPC_Receiver_Statements,
           Make_Implicit_If_Statement (Pkg_Spec,
             Condition =>
               Make_Op_Eq (Loc,
                 New_Occurrence_Of (Subp_Id, Loc),
                 Make_Integer_Literal (Loc, 0)),

             Then_Statements => New_List (
               Make_Assignment_Statement (Loc,
                 Name =>
                   New_Occurrence_Of (Subp_Id, Loc),

                 Expression =>
                   Make_Selected_Component (Loc,
                     Prefix =>
                       Unchecked_Convert_To (RTE (RE_RAS_Proxy_Type_Access),
                         OK_Convert_To (RTE (RE_Address),
                           Make_Attribute_Reference (Loc,
                             Prefix =>
                               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc),
                             Attribute_Name =>
                               Name_Input,
                             Expressions => New_List (
                               Make_Selected_Component (Loc,
                                 Prefix        => Request_Parameter,
                                 Selector_Name => Name_Params))))),

                     Selector_Name =>
                       Make_Identifier (Loc, Name_Subp_Id))))));

         --  Build a subprogram for RAS information lookups

         Current_Declaration :=
           Make_Subprogram_Declaration (Loc,
             Specification =>
               Make_Function_Specification (Loc,
                 Defining_Unit_Name =>
                   Lookup_RAS_Info,
                 Parameter_Specifications => New_List (
                   Make_Parameter_Specification (Loc,
                     Defining_Identifier =>
                       Make_Defining_Identifier (Loc, Name_Subp_Id),
                     In_Present =>
                       True,
                     Parameter_Type =>
                       New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))),
                 Result_Definition =>
                   New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)));

         Append_To (Decls, Current_Declaration);
         Analyze (Current_Declaration);

         Current_Stubs := Build_Subprogram_Receiving_Stubs
           (Vis_Decl     => Current_Declaration,
            Asynchronous => False);
         Append_To (Decls, Current_Stubs);
         Analyze (Current_Stubs);

         Append_Stubs_To (Pkg_RPC_Receiver_Cases,
           Stubs       =>
             Current_Stubs,
           Subprogram_Number => 1);

         --  For each subprogram, the receiving stub will be built and a
         --  case statement will be made on the Subprogram_Id to dispatch
         --  to the right subprogram.

         All_Calls_Remote_E :=
           Boolean_Literals
             (Has_All_Calls_Remote (Defining_Entity (Pkg_Spec)));

         Overload_Counter_Table.Reset;

         Current_Declaration := First (Visible_Declarations (Pkg_Spec));
         while Present (Current_Declaration) loop
            if Nkind (Current_Declaration) = N_Subprogram_Declaration
              and then Comes_From_Source (Current_Declaration)
            then
               declare
                  Loc : constant Source_Ptr := Sloc (Current_Declaration);
                  --  While specifically processing Current_Declaration, use
                  --  its Sloc as the location of all generated nodes.

                  Subp_Def : constant Entity_Id :=
                               Defining_Unit_Name
                                 (Specification (Current_Declaration));

                  Subp_Val : String_Id;
                  pragma Warnings (Off, Subp_Val);

               begin
                  --  Build receiving stub

                  Current_Stubs :=
                    Build_Subprogram_Receiving_Stubs
                      (Vis_Decl     => Current_Declaration,
                       Asynchronous =>
                         Nkind (Specification (Current_Declaration)) =
                             N_Procedure_Specification
                           and then Is_Asynchronous (Subp_Def));

                  Append_To (Decls, Current_Stubs);
                  Analyze (Current_Stubs);

                  --  Build RAS proxy

                  Add_RAS_Proxy_And_Analyze (Decls,
                    Vis_Decl           => Current_Declaration,
                    All_Calls_Remote_E => All_Calls_Remote_E,
                    Proxy_Object_Addr  => Proxy_Object_Addr);

                  --  Compute distribution identifier

                  Assign_Subprogram_Identifier
                    (Subp_Def,
                     Current_Subprogram_Number,
                     Subp_Val);

                  pragma Assert
                    (Current_Subprogram_Number = Get_Subprogram_Id (Subp_Def));

                  --  Add subprogram descriptor (RCI_Subp_Info) to the
                  --  subprograms table for this receiver. The aggregate
                  --  below must be kept consistent with the declaration
                  --  of type RCI_Subp_Info in System.Partition_Interface.

                  Append_To (Subp_Info_List,
                    Make_Component_Association (Loc,
                      Choices => New_List (
                        Make_Integer_Literal (Loc,
                          Current_Subprogram_Number)),

                      Expression =>
                        Make_Aggregate (Loc,
                          Component_Associations => New_List (
                            Make_Component_Association (Loc,
                              Choices => New_List (
                                Make_Identifier (Loc, Name_Addr)),
                              Expression =>
                                New_Occurrence_Of (
                                  Proxy_Object_Addr, Loc))))));

                  Append_Stubs_To (Pkg_RPC_Receiver_Cases,
                    Stubs             => Current_Stubs,
                    Subprogram_Number => Current_Subprogram_Number);
               end;

               Current_Subprogram_Number := Current_Subprogram_Number + 1;
            end if;

            Next (Current_Declaration);
         end loop;

         --  If we receive an invalid Subprogram_Id, it is best to do nothing
         --  rather than raising an exception since we do not want someone
         --  to crash a remote partition by sending invalid subprogram ids.
         --  This is consistent with the other parts of the case statement
         --  since even in presence of incorrect parameters in the stream,
         --  every exception will be caught and (if the subprogram is not an
         --  APC) put into the result stream and sent away.

         Append_To (Pkg_RPC_Receiver_Cases,
           Make_Case_Statement_Alternative (Loc,
             Discrete_Choices => New_List (Make_Others_Choice (Loc)),
             Statements       => New_List (Make_Null_Statement (Loc))));

         Append_To (Pkg_RPC_Receiver_Statements,
           Make_Case_Statement (Loc,
             Expression   => New_Occurrence_Of (Subp_Id, Loc),
             Alternatives => Pkg_RPC_Receiver_Cases));

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Subp_Info_Array,
             Constant_Present    => True,
             Aliased_Present     => True,
             Object_Definition   =>
               Make_Subtype_Indication (Loc,
                 Subtype_Mark =>
                   New_Occurrence_Of (RTE (RE_RCI_Subp_Info_Array), Loc),
                 Constraint =>
                   Make_Index_Or_Discriminant_Constraint (Loc,
                     New_List (
                       Make_Range (Loc,
                         Low_Bound  => Make_Integer_Literal (Loc,
                           First_RCI_Subprogram_Id),
                         High_Bound =>
                           Make_Integer_Literal (Loc,
                             Intval =>
                               First_RCI_Subprogram_Id
                               + List_Length (Subp_Info_List) - 1)))))));

         --  For a degenerate RCI with no visible subprograms, Subp_Info_List
         --  has zero length, and the declaration is for an empty array, in
         --  which case no initialization aggregate must be generated.

         if Present (First (Subp_Info_List)) then
            Set_Expression (Last (Decls),
              Make_Aggregate (Loc,
                Component_Associations => Subp_Info_List));

         --  No initialization provided: remove CONSTANT so that the
         --  declaration is not an incomplete deferred constant.

         else
            Set_Constant_Present (Last (Decls), False);
         end if;

         Analyze (Last (Decls));

         declare
            Subp_Info_Addr : Node_Id;
            --  Return statement for Lookup_RAS_Info: address of the subprogram
            --  information record for the requested subprogram id.

         begin
            if Present (First (Subp_Info_List)) then
               Subp_Info_Addr :=
                 Make_Selected_Component (Loc,
                   Prefix =>
                     Make_Indexed_Component (Loc,
                       Prefix => New_Occurrence_Of (Subp_Info_Array, Loc),
                       Expressions => New_List (
                         Convert_To (Standard_Integer,
                           Make_Identifier (Loc, Name_Subp_Id)))),
                   Selector_Name => Make_Identifier (Loc, Name_Addr));

            --  Case of no visible subprogram: just raise Constraint_Error, we
            --  know for sure we got junk from a remote partition.

            else
               Subp_Info_Addr :=
                 Make_Raise_Constraint_Error (Loc,
                    Reason => CE_Range_Check_Failed);
               Set_Etype (Subp_Info_Addr, RTE (RE_Unsigned_64));
            end if;

            Append_To (Decls,
              Make_Subprogram_Body (Loc,
                Specification =>
                  Copy_Specification (Loc, Parent (Lookup_RAS_Info)),
                Declarations  => No_List,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc,
                    Statements => New_List (
                      Make_Simple_Return_Statement (Loc,
                        Expression =>
                          OK_Convert_To
                            (RTE (RE_Unsigned_64), Subp_Info_Addr))))));
         end;

         Analyze (Last (Decls));

         Append_To (Decls, Pkg_RPC_Receiver_Body);
         Analyze (Last (Decls));

         Get_Library_Unit_Name_String (Pkg_Spec);

         --  Name

         Append_To (Register_Pkg_Actuals,
           Make_String_Literal (Loc,
             Strval => String_From_Name_Buffer));

         --  Receiver

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         => New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
             Attribute_Name => Name_Unrestricted_Access));

         --  Version

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
             Attribute_Name => Name_Version));

         --  Subp_Info

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         => New_Occurrence_Of (Subp_Info_Array, Loc),
             Attribute_Name => Name_Address));

         --  Subp_Info_Len

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         => New_Occurrence_Of (Subp_Info_Array, Loc),
             Attribute_Name => Name_Length));

         --  Generate the call

         Append_To (Stmts,
           Make_Procedure_Call_Statement (Loc,
             Name                   =>
               New_Occurrence_Of (RTE (RE_Register_Receiving_Stub), Loc),
             Parameter_Associations => Register_Pkg_Actuals));
         Analyze (Last (Stmts));
      end Add_Receiving_Stubs_To_Declarations;

      ---------------------------------
      -- Build_General_Calling_Stubs --
      ---------------------------------

      procedure Build_General_Calling_Stubs
        (Decls                     : List_Id;
         Statements                : List_Id;
         Target_Partition          : Entity_Id;
         Target_RPC_Receiver       : Node_Id;
         Subprogram_Id             : Node_Id;
         Asynchronous              : Node_Id   := Empty;
         Is_Known_Asynchronous     : Boolean   := False;
         Is_Known_Non_Asynchronous : Boolean   := False;
         Is_Function               : Boolean;
         Spec                      : Node_Id;
         Stub_Type                 : Entity_Id := Empty;
         RACW_Type                 : Entity_Id := Empty;
         Nod                       : Node_Id)
      is
         Loc : constant Source_Ptr := Sloc (Nod);

         Stream_Parameter : Node_Id;
         --  Name of the stream used to transmit parameters to the remote
         --  package.

         Result_Parameter : Node_Id;
         --  Name of the result parameter (in non-APC cases) which get the
         --  result of the remote subprogram.

         Exception_Return_Parameter : Node_Id;
         --  Name of the parameter which will hold the exception sent by the
         --  remote subprogram.

         Current_Parameter : Node_Id;
         --  Current parameter being handled

         Ordered_Parameters_List : constant List_Id :=
                                     Build_Ordered_Parameters_List (Spec);

         Asynchronous_Statements     : List_Id := No_List;
         Non_Asynchronous_Statements : List_Id := No_List;
         --  Statements specifics to the Asynchronous/Non-Asynchronous cases

         Extra_Formal_Statements : constant List_Id := New_List;
         --  List of statements for extra formal parameters. It will appear
         --  after the regular statements for writing out parameters.

         pragma Unreferenced (RACW_Type);
         --  Used only for the PolyORB case

      begin
         --  The general form of a calling stub for a given subprogram is:

         --    procedure X (...) is P : constant Partition_ID :=
         --      RCI_Cache.Get_Active_Partition_ID; Stream, Result : aliased
         --      System.RPC.Params_Stream_Type (0); begin
         --       Put_Package_RPC_Receiver_In_Stream; (the package RPC receiver
         --                  comes from RCI_Cache.Get_RCI_Package_Receiver)
         --       Put_Subprogram_Id_In_Stream; Put_Parameters_In_Stream; Do_RPC
         --       (Stream, Result); Read_Exception_Occurrence_From_Result;
         --       Raise_It;
         --       Read_Out_Parameters_And_Function_Return_From_Stream; end X;

         --  There are some variations: Do_APC is called for an asynchronous
         --  procedure and the part after the call is completely ommitted as
         --  well as the declaration of Result. For a function call, 'Input is
         --  always used to read the result even if it is constrained.

         Stream_Parameter := Make_Temporary (Loc, 'S');

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Stream_Parameter,
             Aliased_Present     => True,
             Object_Definition   =>
               Make_Subtype_Indication (Loc,
                 Subtype_Mark =>
                   New_Occurrence_Of (RTE (RE_Params_Stream_Type), Loc),
                 Constraint   =>
                   Make_Index_Or_Discriminant_Constraint (Loc,
                     Constraints =>
                       New_List (Make_Integer_Literal (Loc, 0))))));

         if not Is_Known_Asynchronous then
            Result_Parameter := Make_Temporary (Loc, 'R');

            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Result_Parameter,
                Aliased_Present     => True,
                Object_Definition   =>
                  Make_Subtype_Indication (Loc,
                    Subtype_Mark =>
                      New_Occurrence_Of (RTE (RE_Params_Stream_Type), Loc),
                    Constraint   =>
                      Make_Index_Or_Discriminant_Constraint (Loc,
                        Constraints =>
                          New_List (Make_Integer_Literal (Loc, 0))))));

            Exception_Return_Parameter := Make_Temporary (Loc, 'E');

            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Exception_Return_Parameter,
                Object_Definition   =>
                  New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc)));

         else
            Result_Parameter := Empty;
            Exception_Return_Parameter := Empty;
         end if;

         --  Put first the RPC receiver corresponding to the remote package

         Append_To (Statements,
           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (RTE (RE_Unsigned_64), Loc),
             Attribute_Name => Name_Write,
             Expressions    => New_List (
               Make_Attribute_Reference (Loc,
                 Prefix         => New_Occurrence_Of (Stream_Parameter, Loc),
                 Attribute_Name => Name_Access),
               Target_RPC_Receiver)));

         --  Then put the Subprogram_Id of the subprogram we want to call in
         --  the stream.

         Append_To (Statements,
           Make_Attribute_Reference (Loc,
             Prefix         => New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
             Attribute_Name => Name_Write,
             Expressions      => New_List (
               Make_Attribute_Reference (Loc,
                 Prefix         => New_Occurrence_Of (Stream_Parameter, Loc),
                 Attribute_Name => Name_Access),
               Subprogram_Id)));

         Current_Parameter := First (Ordered_Parameters_List);
         while Present (Current_Parameter) loop
            declare
               Typ             : constant Node_Id :=
                                   Parameter_Type (Current_Parameter);
               Etyp            : Entity_Id;
               Constrained     : Boolean;
               Value           : Node_Id;
               Extra_Parameter : Entity_Id;

            begin
               if Is_RACW_Controlling_Formal
                    (Current_Parameter, Stub_Type)
               then
                  --  In the case of a controlling formal argument, we marshall
                  --  its addr field rather than the local stub.

                  Append_To (Statements,
                     Pack_Node_Into_Stream (Loc,
                       Stream => Stream_Parameter,
                       Object =>
                         Make_Selected_Component (Loc,
                           Prefix        =>
                             Defining_Identifier (Current_Parameter),
                           Selector_Name => Name_Addr),
                       Etyp   => RTE (RE_Unsigned_64)));

               else
                  Value :=
                    New_Occurrence_Of
                      (Defining_Identifier (Current_Parameter), Loc);

                  --  Access type parameters are transmitted as in out
                  --  parameters. However, a dereference is needed so that
                  --  we marshall the designated object.

                  if Nkind (Typ) = N_Access_Definition then
                     Value := Make_Explicit_Dereference (Loc, Value);
                     Etyp  := Etype (Subtype_Mark (Typ));
                  else
                     Etyp := Etype (Typ);
                  end if;

                  Constrained := not Transmit_As_Unconstrained (Etyp);

                  --  Any parameter but unconstrained out parameters are
                  --  transmitted to the peer.

                  if In_Present (Current_Parameter)
                    or else not Out_Present (Current_Parameter)
                    or else not Constrained
                  then
                     Append_To (Statements,
                       Make_Attribute_Reference (Loc,
                         Prefix         => New_Occurrence_Of (Etyp, Loc),
                         Attribute_Name =>
                           Output_From_Constrained (Constrained),
                         Expressions    => New_List (
                           Make_Attribute_Reference (Loc,
                             Prefix         =>
                               New_Occurrence_Of (Stream_Parameter, Loc),
                             Attribute_Name => Name_Access),
                           Value)));
                  end if;
               end if;

               --  If the current parameter has a dynamic constrained status,
               --  then this status is transmitted as well.
               --  This should be done for accessibility as well ???

               if Nkind (Typ) /= N_Access_Definition
                 and then Need_Extra_Constrained (Current_Parameter)
               then
                  --  In this block, we do not use the extra formal that has
                  --  been created because it does not exist at the time of
                  --  expansion when building calling stubs for remote access
                  --  to subprogram types. We create an extra variable of this
                  --  type and push it in the stream after the regular
                  --  parameters.

                  Extra_Parameter := Make_Temporary (Loc, 'P');

                  Append_To (Decls,
                     Make_Object_Declaration (Loc,
                       Defining_Identifier => Extra_Parameter,
                       Constant_Present    => True,
                       Object_Definition   =>
                          New_Occurrence_Of (Standard_Boolean, Loc),
                       Expression          =>
                          Make_Attribute_Reference (Loc,
                            Prefix         =>
                              New_Occurrence_Of (
                                Defining_Identifier (Current_Parameter), Loc),
                            Attribute_Name => Name_Constrained)));

                  Append_To (Extra_Formal_Statements,
                     Make_Attribute_Reference (Loc,
                       Prefix         =>
                         New_Occurrence_Of (Standard_Boolean, Loc),
                       Attribute_Name => Name_Write,
                       Expressions    => New_List (
                         Make_Attribute_Reference (Loc,
                           Prefix         =>
                             New_Occurrence_Of
                              (Stream_Parameter, Loc), Attribute_Name =>
                             Name_Access),
                         New_Occurrence_Of (Extra_Parameter, Loc))));
               end if;

               Next (Current_Parameter);
            end;
         end loop;

         --  Append the formal statements list to the statements

         Append_List_To (Statements, Extra_Formal_Statements);

         if not Is_Known_Non_Asynchronous then

            --  Build the call to System.RPC.Do_APC

            Asynchronous_Statements := New_List (
              Make_Procedure_Call_Statement (Loc,
                Name                   =>
                  New_Occurrence_Of (RTE (RE_Do_Apc), Loc),
                Parameter_Associations => New_List (
                  New_Occurrence_Of (Target_Partition, Loc),
                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                      New_Occurrence_Of (Stream_Parameter, Loc),
                    Attribute_Name => Name_Access))));
         else
            Asynchronous_Statements := No_List;
         end if;

         if not Is_Known_Asynchronous then

            --  Build the call to System.RPC.Do_RPC

            Non_Asynchronous_Statements := New_List (
              Make_Procedure_Call_Statement (Loc,
                Name                   =>
                  New_Occurrence_Of (RTE (RE_Do_Rpc), Loc),
                Parameter_Associations => New_List (
                  New_Occurrence_Of (Target_Partition, Loc),

                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                      New_Occurrence_Of (Stream_Parameter, Loc),
                    Attribute_Name => Name_Access),

                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                      New_Occurrence_Of (Result_Parameter, Loc),
                    Attribute_Name => Name_Access))));

            --  Read the exception occurrence from the result stream and
            --  reraise it. It does no harm if this is a Null_Occurrence since
            --  this does nothing.

            Append_To (Non_Asynchronous_Statements,
              Make_Attribute_Reference (Loc,
                Prefix         =>
                  New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc),

                Attribute_Name => Name_Read,

                Expressions    => New_List (
                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                      New_Occurrence_Of (Result_Parameter, Loc),
                    Attribute_Name => Name_Access),
                  New_Occurrence_Of (Exception_Return_Parameter, Loc))));

            Append_To (Non_Asynchronous_Statements,
              Make_Procedure_Call_Statement (Loc,
                Name                   =>
                  New_Occurrence_Of (RTE (RE_Reraise_Occurrence), Loc),
                Parameter_Associations => New_List (
                  New_Occurrence_Of (Exception_Return_Parameter, Loc))));

            if Is_Function then

               --  If this is a function call, then read the value and return
               --  it. The return value is written/read using 'Output/'Input.

               Append_To (Non_Asynchronous_Statements,
                 Make_Tag_Check (Loc,
                   Make_Simple_Return_Statement (Loc,
                     Expression =>
                       Make_Attribute_Reference (Loc,
                         Prefix         =>
                           New_Occurrence_Of (
                             Etype (Result_Definition (Spec)), Loc),

                         Attribute_Name => Name_Input,

                         Expressions    => New_List (
                           Make_Attribute_Reference (Loc,
                             Prefix         =>
                               New_Occurrence_Of (Result_Parameter, Loc),
                             Attribute_Name => Name_Access))))));

            else
               --  Loop around parameters and assign out (or in out)
               --  parameters. In the case of RACW, controlling arguments
               --  cannot possibly have changed since they are remote, so
               --  we do not read them from the stream.

               Current_Parameter := First (Ordered_Parameters_List);
               while Present (Current_Parameter) loop
                  declare
                     Typ   : constant Node_Id :=
                               Parameter_Type (Current_Parameter);
                     Etyp  : Entity_Id;
                     Value : Node_Id;

                  begin
                     Value :=
                       New_Occurrence_Of
                         (Defining_Identifier (Current_Parameter), Loc);

                     if Nkind (Typ) = N_Access_Definition then
                        Value := Make_Explicit_Dereference (Loc, Value);
                        Etyp  := Etype (Subtype_Mark (Typ));
                     else
                        Etyp := Etype (Typ);
                     end if;

                     if (Out_Present (Current_Parameter)
                          or else Nkind (Typ) = N_Access_Definition)
                       and then Etyp /= Stub_Type
                     then
                        Append_To (Non_Asynchronous_Statements,
                           Make_Attribute_Reference (Loc,
                             Prefix         =>
                               New_Occurrence_Of (Etyp, Loc),

                             Attribute_Name => Name_Read,

                             Expressions    => New_List (
                               Make_Attribute_Reference (Loc,
                                 Prefix         =>
                                   New_Occurrence_Of (Result_Parameter, Loc),
                                 Attribute_Name => Name_Access),
                               Value)));
                     end if;
                  end;

                  Next (Current_Parameter);
               end loop;
            end if;
         end if;

         if Is_Known_Asynchronous then
            Append_List_To (Statements, Asynchronous_Statements);

         elsif Is_Known_Non_Asynchronous then
            Append_List_To (Statements, Non_Asynchronous_Statements);

         else
            pragma Assert (Present (Asynchronous));
            Prepend_To (Asynchronous_Statements,
              Make_Attribute_Reference (Loc,
                Prefix         => New_Occurrence_Of (Standard_Boolean, Loc),
                Attribute_Name => Name_Write,
                Expressions    => New_List (
                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                      New_Occurrence_Of (Stream_Parameter, Loc),
                    Attribute_Name => Name_Access),
                  New_Occurrence_Of (Standard_True, Loc))));

            Prepend_To (Non_Asynchronous_Statements,
              Make_Attribute_Reference (Loc,
                Prefix         => New_Occurrence_Of (Standard_Boolean, Loc),
                Attribute_Name => Name_Write,
                Expressions    => New_List (
                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                      New_Occurrence_Of (Stream_Parameter, Loc),
                    Attribute_Name => Name_Access),
                  New_Occurrence_Of (Standard_False, Loc))));

            Append_To (Statements,
              Make_Implicit_If_Statement (Nod,
                Condition       => Asynchronous,
                Then_Statements => Asynchronous_Statements,
                Else_Statements => Non_Asynchronous_Statements));
         end if;
      end Build_General_Calling_Stubs;

      -----------------------------
      -- Build_RPC_Receiver_Body --
      -----------------------------

      procedure Build_RPC_Receiver_Body
        (RPC_Receiver : Entity_Id;
         Request      : out Entity_Id;
         Subp_Id      : out Entity_Id;
         Subp_Index   : out Entity_Id;
         Stmts        : out List_Id;
         Decl         : out Node_Id)
      is
         Loc : constant Source_Ptr := Sloc (RPC_Receiver);

         RPC_Receiver_Spec  : Node_Id;
         RPC_Receiver_Decls : List_Id;

      begin
         Request := Make_Defining_Identifier (Loc, Name_R);

         RPC_Receiver_Spec :=
           Build_RPC_Receiver_Specification
             (RPC_Receiver      => RPC_Receiver,
              Request_Parameter => Request);

         Subp_Id    := Make_Temporary (Loc, 'P');
         Subp_Index := Subp_Id;

         --  Subp_Id may not be a constant, because in the case of the RPC
         --  receiver for an RCI package, when a call is received from a RAS
         --  dereference, it will be assigned during subsequent processing.

         RPC_Receiver_Decls := New_List (
           Make_Object_Declaration (Loc,
             Defining_Identifier => Subp_Id,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
             Expression          =>
               Make_Attribute_Reference (Loc,
                 Prefix          =>
                   New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
                 Attribute_Name  => Name_Input,
                 Expressions     => New_List (
                   Make_Selected_Component (Loc,
                     Prefix        => Request,
                     Selector_Name => Name_Params)))));

         Stmts := New_List;

         Decl :=
           Make_Subprogram_Body (Loc,
             Specification              => RPC_Receiver_Spec,
             Declarations               => RPC_Receiver_Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Stmts));
      end Build_RPC_Receiver_Body;

      -----------------------
      -- Build_Stub_Target --
      -----------------------

      function Build_Stub_Target
        (Loc                   : Source_Ptr;
         Decls                 : List_Id;
         RCI_Locator           : Entity_Id;
         Controlling_Parameter : Entity_Id) return RPC_Target
      is
         Target_Info : RPC_Target (PCS_Kind => Name_GARLIC_DSA);

      begin
         Target_Info.Partition := Make_Temporary (Loc, 'P');

         if Present (Controlling_Parameter) then
            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Target_Info.Partition,
                Constant_Present    => True,
                Object_Definition   =>
                  New_Occurrence_Of (RTE (RE_Partition_ID), Loc),

                Expression          =>
                  Make_Selected_Component (Loc,
                    Prefix        => Controlling_Parameter,
                    Selector_Name => Name_Origin)));

            Target_Info.RPC_Receiver :=
              Make_Selected_Component (Loc,
                Prefix        => Controlling_Parameter,
                Selector_Name => Name_Receiver);

         else
            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Target_Info.Partition,
                Constant_Present    => True,
                Object_Definition   =>
                  New_Occurrence_Of (RTE (RE_Partition_ID), Loc),

                Expression          =>
                  Make_Function_Call (Loc,
                    Name => Make_Selected_Component (Loc,
                      Prefix        =>
                        Make_Identifier (Loc, Chars (RCI_Locator)),
                      Selector_Name =>
                        Make_Identifier (Loc,
                          Name_Get_Active_Partition_ID)))));

            Target_Info.RPC_Receiver :=
              Make_Selected_Component (Loc,
                Prefix        =>
                  Make_Identifier (Loc, Chars (RCI_Locator)),
                Selector_Name =>
                  Make_Identifier (Loc, Name_Get_RCI_Package_Receiver));
         end if;
         return Target_Info;
      end Build_Stub_Target;

      ---------------------
      -- Build_Stub_Type --
      ---------------------

      procedure Build_Stub_Type
        (RACW_Type         : Entity_Id;
         Stub_Type_Comps   : out List_Id;
         RPC_Receiver_Decl : out Node_Id)
      is
         Loc    : constant Source_Ptr := Sloc (RACW_Type);
         Is_RAS : constant Boolean    := not Comes_From_Source (RACW_Type);

      begin
         Stub_Type_Comps := New_List (
           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_Origin),
             Component_Definition =>
               Make_Component_Definition (Loc,
                 Aliased_Present    => False,
                 Subtype_Indication =>
                   New_Occurrence_Of (RTE (RE_Partition_ID), Loc))),

           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_Receiver),
             Component_Definition =>
               Make_Component_Definition (Loc,
                 Aliased_Present    => False,
                 Subtype_Indication =>
                   New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))),

           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_Addr),
             Component_Definition =>
               Make_Component_Definition (Loc,
                 Aliased_Present    => False,
                 Subtype_Indication =>
                   New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))),

           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_Asynchronous),
             Component_Definition =>
               Make_Component_Definition (Loc,
                 Aliased_Present    => False,
                 Subtype_Indication =>
                   New_Occurrence_Of (Standard_Boolean, Loc))));

         if Is_RAS then
            RPC_Receiver_Decl := Empty;
         else
            declare
               RPC_Receiver_Request : constant Entity_Id :=
                                        Make_Defining_Identifier (Loc, Name_R);
            begin
               RPC_Receiver_Decl :=
                 Make_Subprogram_Declaration (Loc,
                   Build_RPC_Receiver_Specification
                     (RPC_Receiver      => Make_Temporary (Loc, 'R'),
                      Request_Parameter => RPC_Receiver_Request));
            end;
         end if;
      end Build_Stub_Type;

      --------------------------------------
      -- Build_Subprogram_Receiving_Stubs --
      --------------------------------------

      function Build_Subprogram_Receiving_Stubs
        (Vis_Decl                 : Node_Id;
         Asynchronous             : Boolean;
         Dynamically_Asynchronous : Boolean   := False;
         Stub_Type                : Entity_Id := Empty;
         RACW_Type                : Entity_Id := Empty;
         Parent_Primitive         : Entity_Id := Empty) return Node_Id
      is
         Loc : constant Source_Ptr := Sloc (Vis_Decl);

         Request_Parameter : constant Entity_Id := Make_Temporary (Loc, 'R');
         --  Formal parameter for receiving stubs: a descriptor for an incoming
         --  request.

         Decls : constant List_Id := New_List;
         --  All the parameters will get declared before calling the real
         --  subprograms. Also the out parameters will be declared.

         Statements : constant List_Id := New_List;

         Extra_Formal_Statements : constant List_Id := New_List;
         --  Statements concerning extra formal parameters

         After_Statements : constant List_Id := New_List;
         --  Statements to be executed after the subprogram call

         Inner_Decls : List_Id := No_List;
         --  In case of a function, the inner declarations are needed since
         --  the result may be unconstrained.

         Excep_Handlers : List_Id := No_List;
         Excep_Choice   : Entity_Id;
         Excep_Code     : List_Id;

         Parameter_List : constant List_Id := New_List;
         --  List of parameters to be passed to the subprogram

         Current_Parameter : Node_Id;

         Ordered_Parameters_List : constant List_Id :=
                                     Build_Ordered_Parameters_List
                                       (Specification (Vis_Decl));

         Subp_Spec : Node_Id;
         --  Subprogram specification

         Called_Subprogram : Node_Id;
         --  The subprogram to call

         Null_Raise_Statement : Node_Id;

         Dynamic_Async : Entity_Id;

      begin
         if Present (RACW_Type) then
            Called_Subprogram := New_Occurrence_Of (Parent_Primitive, Loc);
         else
            Called_Subprogram :=
              New_Occurrence_Of
                (Defining_Unit_Name (Specification (Vis_Decl)), Loc);
         end if;

         if Dynamically_Asynchronous then
            Dynamic_Async := Make_Temporary (Loc, 'S');
         else
            Dynamic_Async := Empty;
         end if;

         if not Asynchronous or Dynamically_Asynchronous then

            --  The first statement after the subprogram call is a statement to
            --  write a Null_Occurrence into the result stream.

            Null_Raise_Statement :=
              Make_Attribute_Reference (Loc,
                Prefix         =>
                  New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc),
                Attribute_Name => Name_Write,
                Expressions    => New_List (
                  Make_Selected_Component (Loc,
                    Prefix        => Request_Parameter,
                    Selector_Name => Name_Result),
                  New_Occurrence_Of (RTE (RE_Null_Occurrence), Loc)));

            if Dynamically_Asynchronous then
               Null_Raise_Statement :=
                 Make_Implicit_If_Statement (Vis_Decl,
                   Condition       =>
                     Make_Op_Not (Loc, New_Occurrence_Of (Dynamic_Async, Loc)),
                   Then_Statements => New_List (Null_Raise_Statement));
            end if;

            Append_To (After_Statements, Null_Raise_Statement);
         end if;

         --  Loop through every parameter and get its value from the stream. If
         --  the parameter is unconstrained, then the parameter is read using
         --  'Input at the point of declaration.

         Current_Parameter := First (Ordered_Parameters_List);
         while Present (Current_Parameter) loop
            declare
               Etyp        : Entity_Id;
               Constrained : Boolean;

               Need_Extra_Constrained : Boolean;
               --  True when an Extra_Constrained actual is required

               Object : constant Entity_Id := Make_Temporary (Loc, 'P');

               Expr : Node_Id := Empty;

               Is_Controlling_Formal : constant Boolean :=
                                         Is_RACW_Controlling_Formal
                                           (Current_Parameter, Stub_Type);

            begin
               if Is_Controlling_Formal then

                  --  We have a controlling formal parameter. Read its address
                  --  rather than a real object. The address is in Unsigned_64
                  --  form.

                  Etyp := RTE (RE_Unsigned_64);
               else
                  Etyp := Etype (Parameter_Type (Current_Parameter));
               end if;

               Constrained := not Transmit_As_Unconstrained (Etyp);

               if In_Present (Current_Parameter)
                 or else not Out_Present (Current_Parameter)
                 or else not Constrained
                 or else Is_Controlling_Formal
               then
                  --  If an input parameter is constrained, then the read of
                  --  the parameter is deferred until the beginning of the
                  --  subprogram body. If it is unconstrained, then an
                  --  expression is built for the object declaration and the
                  --  variable is set using 'Input instead of 'Read. Note that
                  --  this deferral does not change the order in which the
                  --  actuals are read because Build_Ordered_Parameter_List
                  --  puts them unconstrained first.

                  if Constrained then
                     Append_To (Statements,
                       Make_Attribute_Reference (Loc,
                         Prefix         => New_Occurrence_Of (Etyp, Loc),
                         Attribute_Name => Name_Read,
                         Expressions    => New_List (
                           Make_Selected_Component (Loc,
                             Prefix        => Request_Parameter,
                             Selector_Name => Name_Params),
                           New_Occurrence_Of (Object, Loc))));

                  else

                     --  Build and append Input_With_Tag_Check function

                     Append_To (Decls,
                       Input_With_Tag_Check (Loc,
                         Var_Type => Etyp,
                         Stream   =>
                           Make_Selected_Component (Loc,
                             Prefix        => Request_Parameter,
                             Selector_Name => Name_Params)));

                     --  Prepare function call expression

                     Expr :=
                       Make_Function_Call (Loc,
                         Name =>
                           New_Occurrence_Of
                             (Defining_Unit_Name
                               (Specification (Last (Decls))), Loc));
                  end if;
               end if;

               Need_Extra_Constrained :=
                 Nkind (Parameter_Type (Current_Parameter)) /=
                                                        N_Access_Definition
                   and then
                     Ekind (Defining_Identifier (Current_Parameter)) /= E_Void
                   and then
                      Present (Extra_Constrained
                                (Defining_Identifier (Current_Parameter)));

               --  We may not associate an extra constrained actual to a
               --  constant object, so if one is needed, declare the actual
               --  as a variable even if it won't be modified.

               Build_Actual_Object_Declaration
                 (Object   => Object,
                  Etyp     => Etyp,
                  Variable => Need_Extra_Constrained
                                or else Out_Present (Current_Parameter),
                  Expr     => Expr,
                  Decls    => Decls);

               --  An out parameter may be written back using a 'Write
               --  attribute instead of a 'Output because it has been
               --  constrained by the parameter given to the caller. Note that
               --  out controlling arguments in the case of a RACW are not put
               --  back in the stream because the pointer on them has not
               --  changed.

               if Out_Present (Current_Parameter)
                 and then
                   Etype (Parameter_Type (Current_Parameter)) /= Stub_Type
               then
                  Append_To (After_Statements,
                    Make_Attribute_Reference (Loc,
                      Prefix         => New_Occurrence_Of (Etyp, Loc),
                      Attribute_Name => Name_Write,
                      Expressions    => New_List (
                        Make_Selected_Component (Loc,
                          Prefix        => Request_Parameter,
                          Selector_Name => Name_Result),
                        New_Occurrence_Of (Object, Loc))));
               end if;

               --  For RACW controlling formals, the Etyp of Object is always
               --  an RACW, even if the parameter is not of an anonymous access
               --  type. In such case, we need to dereference it at call time.

               if Is_Controlling_Formal then
                  if Nkind (Parameter_Type (Current_Parameter)) /=
                    N_Access_Definition
                  then
                     Append_To (Parameter_List,
                       Make_Parameter_Association (Loc,
                         Selector_Name             =>
                           New_Occurrence_Of (
                             Defining_Identifier (Current_Parameter), Loc),
                         Explicit_Actual_Parameter =>
                           Make_Explicit_Dereference (Loc,
                             Unchecked_Convert_To (RACW_Type,
                               OK_Convert_To (RTE (RE_Address),
                                 New_Occurrence_Of (Object, Loc))))));

                  else
                     Append_To (Parameter_List,
                       Make_Parameter_Association (Loc,
                         Selector_Name             =>
                           New_Occurrence_Of (
                             Defining_Identifier (Current_Parameter), Loc),
                         Explicit_Actual_Parameter =>
                           Unchecked_Convert_To (RACW_Type,
                             OK_Convert_To (RTE (RE_Address),
                               New_Occurrence_Of (Object, Loc)))));
                  end if;

               else
                  Append_To (Parameter_List,
                    Make_Parameter_Association (Loc,
                      Selector_Name             =>
                        New_Occurrence_Of (
                          Defining_Identifier (Current_Parameter), Loc),
                      Explicit_Actual_Parameter =>
                        New_Occurrence_Of (Object, Loc)));
               end if;

               --  If the current parameter needs an extra formal, then read it
               --  from the stream and set the corresponding semantic field in
               --  the variable. If the kind of the parameter identifier is
               --  E_Void, then this is a compiler generated parameter that
               --  doesn't need an extra constrained status.

               --  The case of Extra_Accessibility should also be handled ???

               if Need_Extra_Constrained then
                  declare
                     Extra_Parameter : constant Entity_Id :=
                                         Extra_Constrained
                                           (Defining_Identifier
                                             (Current_Parameter));

                     Formal_Entity : constant Entity_Id :=
                                       Make_Defining_Identifier
                                           (Loc, Chars (Extra_Parameter));

                     Formal_Type : constant Entity_Id :=
                                     Etype (Extra_Parameter);

                  begin
                     Append_To (Decls,
                       Make_Object_Declaration (Loc,
                         Defining_Identifier => Formal_Entity,
                         Object_Definition   =>
                           New_Occurrence_Of (Formal_Type, Loc)));

                     Append_To (Extra_Formal_Statements,
                       Make_Attribute_Reference (Loc,
                         Prefix         => New_Occurrence_Of (
                                             Formal_Type, Loc),
                         Attribute_Name => Name_Read,
                         Expressions    => New_List (
                           Make_Selected_Component (Loc,
                             Prefix        => Request_Parameter,
                             Selector_Name => Name_Params),
                           New_Occurrence_Of (Formal_Entity, Loc))));

                     --  Note: the call to Set_Extra_Constrained below relies
                     --  on the fact that Object's Ekind has been set by
                     --  Build_Actual_Object_Declaration.

                     Set_Extra_Constrained (Object, Formal_Entity);
                  end;
               end if;
            end;

            Next (Current_Parameter);
         end loop;

         --  Append the formal statements list at the end of regular statements

         Append_List_To (Statements, Extra_Formal_Statements);

         if Nkind (Specification (Vis_Decl)) = N_Function_Specification then

            --  The remote subprogram is a function. We build an inner block to
            --  be able to hold a potentially unconstrained result in a
            --  variable.

            declare
               Etyp   : constant Entity_Id :=
                          Etype (Result_Definition (Specification (Vis_Decl)));
               Result : constant Node_Id   := Make_Temporary (Loc, 'R');

            begin
               Inner_Decls := New_List (
                 Make_Object_Declaration (Loc,
                   Defining_Identifier => Result,
                   Constant_Present    => True,
                   Object_Definition   => New_Occurrence_Of (Etyp, Loc),
                   Expression          =>
                     Make_Function_Call (Loc,
                       Name                   => Called_Subprogram,
                       Parameter_Associations => Parameter_List)));

               if Is_Class_Wide_Type (Etyp) then

                  --  For a remote call to a function with a class-wide type,
                  --  check that the returned value satisfies the requirements
                  --  of E.4(18).

                  Append_To (Inner_Decls,
                    Make_Transportable_Check (Loc,
                      New_Occurrence_Of (Result, Loc)));

               end if;

               Append_To (After_Statements,
                 Make_Attribute_Reference (Loc,
                   Prefix         => New_Occurrence_Of (Etyp, Loc),
                   Attribute_Name => Name_Output,
                   Expressions    => New_List (
                     Make_Selected_Component (Loc,
                       Prefix        => Request_Parameter,
                       Selector_Name => Name_Result),
                     New_Occurrence_Of (Result, Loc))));
            end;

            Append_To (Statements,
              Make_Block_Statement (Loc,
                Declarations               => Inner_Decls,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc,
                    Statements => After_Statements)));

         else
            --  The remote subprogram is a procedure. We do not need any inner
            --  block in this case.

            if Dynamically_Asynchronous then
               Append_To (Decls,
                 Make_Object_Declaration (Loc,
                   Defining_Identifier => Dynamic_Async,
                   Object_Definition   =>
                     New_Occurrence_Of (Standard_Boolean, Loc)));

               Append_To (Statements,
                 Make_Attribute_Reference (Loc,
                   Prefix         => New_Occurrence_Of (Standard_Boolean, Loc),
                   Attribute_Name => Name_Read,
                   Expressions    => New_List (
                     Make_Selected_Component (Loc,
                       Prefix        => Request_Parameter,
                       Selector_Name => Name_Params),
                     New_Occurrence_Of (Dynamic_Async, Loc))));
            end if;

            Append_To (Statements,
              Make_Procedure_Call_Statement (Loc,
                Name                   => Called_Subprogram,
                Parameter_Associations => Parameter_List));

            Append_List_To (Statements, After_Statements);
         end if;

         if Asynchronous and then not Dynamically_Asynchronous then

            --  For an asynchronous procedure, add a null exception handler

            Excep_Handlers := New_List (
              Make_Implicit_Exception_Handler (Loc,
                Exception_Choices => New_List (Make_Others_Choice (Loc)),
                Statements        => New_List (Make_Null_Statement (Loc))));

         else
            --  In the other cases, if an exception is raised, then the
            --  exception occurrence is copied into the output stream and
            --  no other output parameter is written.

            Excep_Choice := Make_Temporary (Loc, 'E');

            Excep_Code := New_List (
              Make_Attribute_Reference (Loc,
                Prefix         =>
                  New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc),
                Attribute_Name => Name_Write,
                Expressions    => New_List (
                                    Make_Selected_Component (Loc,
                                      Prefix        => Request_Parameter,
                                      Selector_Name => Name_Result),
                                    New_Occurrence_Of (Excep_Choice, Loc))));

            if Dynamically_Asynchronous then
               Excep_Code := New_List (
                 Make_Implicit_If_Statement (Vis_Decl,
                   Condition       => Make_Op_Not (Loc,
                     New_Occurrence_Of (Dynamic_Async, Loc)),
                   Then_Statements => Excep_Code));
            end if;

            Excep_Handlers := New_List (
              Make_Implicit_Exception_Handler (Loc,
                Choice_Parameter   => Excep_Choice,
                Exception_Choices  => New_List (Make_Others_Choice (Loc)),
                Statements         => Excep_Code));

         end if;

         Subp_Spec :=
           Make_Procedure_Specification (Loc,
             Defining_Unit_Name       => Make_Temporary (Loc, 'F'),

             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Request_Parameter,
                 Parameter_Type      =>
                   New_Occurrence_Of (RTE (RE_Request_Access), Loc))));

         return
           Make_Subprogram_Body (Loc,
             Specification              => Subp_Spec,
             Declarations               => Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements         => Statements,
                 Exception_Handlers => Excep_Handlers));
      end Build_Subprogram_Receiving_Stubs;

      ------------
      -- Result --
      ------------

      function Result return Node_Id is
      begin
         return Make_Identifier (Loc, Name_V);
      end Result;

      ----------------------
      -- Stream_Parameter --
      ----------------------

      function Stream_Parameter return Node_Id is
      begin
         return Make_Identifier (Loc, Name_S);
      end Stream_Parameter;

   end GARLIC_Support;

   -------------------------------
   -- Get_And_Reset_RACW_Bodies --
   -------------------------------

   function Get_And_Reset_RACW_Bodies (RACW_Type : Entity_Id) return List_Id is
      Desig         : constant Entity_Id :=
                        Etype (Designated_Type (RACW_Type));

      Stub_Elements : Stub_Structure := Stubs_Table.Get (Desig);

      Body_Decls : List_Id;
      --  Returned list of declarations

   begin
      if Stub_Elements = Empty_Stub_Structure then

         --  Stub elements may be missing as a consequence of a previously
         --  detected error.

         return No_List;
      end if;

      Body_Decls := Stub_Elements.Body_Decls;
      Stub_Elements.Body_Decls := No_List;
      Stubs_Table.Set (Desig, Stub_Elements);
      return Body_Decls;
   end Get_And_Reset_RACW_Bodies;

   -----------------------
   -- Get_Stub_Elements --
   -----------------------

   function Get_Stub_Elements (RACW_Type : Entity_Id) return Stub_Structure is
      Desig         : constant Entity_Id :=
                        Etype (Designated_Type (RACW_Type));
      Stub_Elements : constant Stub_Structure := Stubs_Table.Get (Desig);
   begin
      pragma Assert (Stub_Elements /= Empty_Stub_Structure);
      return Stub_Elements;
   end Get_Stub_Elements;

   -----------------------
   -- Get_Subprogram_Id --
   -----------------------

   function Get_Subprogram_Id (Def : Entity_Id) return String_Id is
      Result : constant String_Id := Get_Subprogram_Ids (Def).Str_Identifier;
   begin
      pragma Assert (Result /= No_String);
      return Result;
   end Get_Subprogram_Id;

   -----------------------
   -- Get_Subprogram_Id --
   -----------------------

   function Get_Subprogram_Id (Def : Entity_Id) return Int is
   begin
      return Get_Subprogram_Ids (Def).Int_Identifier;
   end Get_Subprogram_Id;

   ------------------------
   -- Get_Subprogram_Ids --
   ------------------------

   function Get_Subprogram_Ids
     (Def : Entity_Id) return Subprogram_Identifiers
   is
   begin
      return Subprogram_Identifier_Table.Get (Def);
   end Get_Subprogram_Ids;

   ----------
   -- Hash --
   ----------

   function Hash (F : Entity_Id) return Hash_Index is
   begin
      return Hash_Index (Natural (F) mod Positive (Hash_Index'Last + 1));
   end Hash;

   function Hash (F : Name_Id) return Hash_Index is
   begin
      return Hash_Index (Natural (F) mod Positive (Hash_Index'Last + 1));
   end Hash;

   --------------------------
   -- Input_With_Tag_Check --
   --------------------------

   function Input_With_Tag_Check
     (Loc      : Source_Ptr;
      Var_Type : Entity_Id;
      Stream   : Node_Id) return Node_Id
   is
   begin
      return
        Make_Subprogram_Body (Loc,
          Specification              =>
            Make_Function_Specification (Loc,
              Defining_Unit_Name => Make_Temporary (Loc, 'S'),
              Result_Definition  => New_Occurrence_Of (Var_Type, Loc)),
          Declarations               => No_List,
          Handled_Statement_Sequence =>
            Make_Handled_Sequence_Of_Statements (Loc, New_List (
              Make_Tag_Check (Loc,
                Make_Simple_Return_Statement (Loc,
                  Make_Attribute_Reference (Loc,
                    Prefix         => New_Occurrence_Of (Var_Type, Loc),
                    Attribute_Name => Name_Input,
                    Expressions    =>
                      New_List (Stream)))))));
   end Input_With_Tag_Check;

   --------------------------------
   -- Is_RACW_Controlling_Formal --
   --------------------------------

   function Is_RACW_Controlling_Formal
     (Parameter : Node_Id;
      Stub_Type : Entity_Id) return Boolean
   is
      Typ : Entity_Id;

   begin
      --  If the kind of the parameter is E_Void, then it is not a controlling
      --  formal (this can happen in the context of RAS).

      if Ekind (Defining_Identifier (Parameter)) = E_Void then
         return False;
      end if;

      --  If the parameter is not a controlling formal, then it cannot be
      --  possibly a RACW_Controlling_Formal.

      if not Is_Controlling_Formal (Defining_Identifier (Parameter)) then
         return False;
      end if;

      Typ := Parameter_Type (Parameter);
      return (Nkind (Typ) = N_Access_Definition
               and then Etype (Subtype_Mark (Typ)) = Stub_Type)
        or else Etype (Typ) = Stub_Type;
   end Is_RACW_Controlling_Formal;

   ------------------------------
   -- Make_Transportable_Check --
   ------------------------------

   function Make_Transportable_Check
     (Loc  : Source_Ptr;
      Expr : Node_Id) return Node_Id is
   begin
      return
        Make_Raise_Program_Error (Loc,
          Condition       =>
            Make_Op_Not (Loc,
              Build_Get_Transportable (Loc,
                Make_Selected_Component (Loc,
                  Prefix        => Expr,
                  Selector_Name => Make_Identifier (Loc, Name_uTag)))),
          Reason => PE_Non_Transportable_Actual);
   end Make_Transportable_Check;

   -----------------------------
   -- Make_Selected_Component --
   -----------------------------

   function Make_Selected_Component
     (Loc           : Source_Ptr;
      Prefix        : Entity_Id;
      Selector_Name : Name_Id) return Node_Id
   is
   begin
      return Make_Selected_Component (Loc,
               Prefix        => New_Occurrence_Of (Prefix, Loc),
               Selector_Name => Make_Identifier (Loc, Selector_Name));
   end Make_Selected_Component;

   --------------------
   -- Make_Tag_Check --
   --------------------

   function Make_Tag_Check (Loc : Source_Ptr; N : Node_Id) return Node_Id is
      Occ : constant Entity_Id := Make_Temporary (Loc, 'E');

   begin
      return Make_Block_Statement (Loc,
        Handled_Statement_Sequence =>
          Make_Handled_Sequence_Of_Statements (Loc,
            Statements         => New_List (N),

            Exception_Handlers => New_List (
              Make_Implicit_Exception_Handler (Loc,
                Choice_Parameter => Occ,

                Exception_Choices =>
                  New_List (New_Occurrence_Of (RTE (RE_Tag_Error), Loc)),

                Statements =>
                  New_List (Make_Procedure_Call_Statement (Loc,
                    New_Occurrence_Of
                      (RTE (RE_Raise_Program_Error_Unknown_Tag), Loc),
                    New_List (New_Occurrence_Of (Occ, Loc))))))));
   end Make_Tag_Check;

   ----------------------------
   -- Need_Extra_Constrained --
   ----------------------------

   function Need_Extra_Constrained (Parameter : Node_Id) return Boolean is
      Etyp : constant Entity_Id := Etype (Parameter_Type (Parameter));
   begin
      return Out_Present (Parameter)
        and then Has_Discriminants (Etyp)
        and then not Is_Constrained (Etyp)
        and then not Is_Indefinite_Subtype (Etyp);
   end Need_Extra_Constrained;

   ------------------------------------
   -- Pack_Entity_Into_Stream_Access --
   ------------------------------------

   function Pack_Entity_Into_Stream_Access
     (Loc    : Source_Ptr;
      Stream : Node_Id;
      Object : Entity_Id;
      Etyp   : Entity_Id := Empty) return Node_Id
   is
      Typ : Entity_Id;

   begin
      if Present (Etyp) then
         Typ := Etyp;
      else
         Typ := Etype (Object);
      end if;

      return
        Pack_Node_Into_Stream_Access (Loc,
          Stream => Stream,
          Object => New_Occurrence_Of (Object, Loc),
          Etyp   => Typ);
   end Pack_Entity_Into_Stream_Access;

   ---------------------------
   -- Pack_Node_Into_Stream --
   ---------------------------

   function Pack_Node_Into_Stream
     (Loc    : Source_Ptr;
      Stream : Entity_Id;
      Object : Node_Id;
      Etyp   : Entity_Id) return Node_Id
   is
      Write_Attribute : Name_Id := Name_Write;

   begin
      if not Is_Constrained (Etyp) then
         Write_Attribute := Name_Output;
      end if;

      return
        Make_Attribute_Reference (Loc,
          Prefix         => New_Occurrence_Of (Etyp, Loc),
          Attribute_Name => Write_Attribute,
          Expressions    => New_List (
            Make_Attribute_Reference (Loc,
              Prefix         => New_Occurrence_Of (Stream, Loc),
              Attribute_Name => Name_Access),
            Object));
   end Pack_Node_Into_Stream;

   ----------------------------------
   -- Pack_Node_Into_Stream_Access --
   ----------------------------------

   function Pack_Node_Into_Stream_Access
     (Loc    : Source_Ptr;
      Stream : Node_Id;
      Object : Node_Id;
      Etyp   : Entity_Id) return Node_Id
   is
      Write_Attribute : Name_Id := Name_Write;

   begin
      if not Is_Constrained (Etyp) then
         Write_Attribute := Name_Output;
      end if;

      return
        Make_Attribute_Reference (Loc,
          Prefix         => New_Occurrence_Of (Etyp, Loc),
          Attribute_Name => Write_Attribute,
          Expressions    => New_List (
            Stream,
            Object));
   end Pack_Node_Into_Stream_Access;

   ---------------------
   -- PolyORB_Support --
   ---------------------

   package body PolyORB_Support is

      --  Local subprograms

      procedure Add_RACW_Read_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         Body_Decls       : List_Id);
      --  Add Read attribute for the RACW type. The declaration and attribute
      --  definition clauses are inserted right after the declaration of
      --  RACW_Type. If Body_Decls is not No_List, the subprogram body is
      --  appended to it (case where the RACW declaration is in the main unit).

      procedure Add_RACW_Write_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         Body_Decls       : List_Id);
      --  Same as above for the Write attribute

      procedure Add_RACW_From_Any
        (RACW_Type        : Entity_Id;
         Body_Decls       : List_Id);
      --  Add the From_Any TSS for this RACW type

      procedure Add_RACW_To_Any
        (RACW_Type        : Entity_Id;
         Body_Decls       : List_Id);
      --  Add the To_Any TSS for this RACW type

      procedure Add_RACW_TypeCode
        (Designated_Type : Entity_Id;
         RACW_Type       : Entity_Id;
         Body_Decls      : List_Id);
      --  Add the TypeCode TSS for this RACW type

      procedure Add_RAS_From_Any (RAS_Type : Entity_Id);
      --  Add the From_Any TSS for this RAS type

      procedure Add_RAS_To_Any   (RAS_Type : Entity_Id);
      --  Add the To_Any TSS for this RAS type

      procedure Add_RAS_TypeCode (RAS_Type : Entity_Id);
      --  Add the TypeCode TSS for this RAS type

      procedure Add_RAS_Access_TSS (N : Node_Id);
      --  Add a subprogram body for RAS Access TSS

      -------------------------------------
      -- Add_Obj_RPC_Receiver_Completion --
      -------------------------------------

      procedure Add_Obj_RPC_Receiver_Completion
        (Loc           : Source_Ptr;
         Decls         : List_Id;
         RPC_Receiver  : Entity_Id;
         Stub_Elements : Stub_Structure)
      is
         Desig : constant Entity_Id :=
           Etype (Designated_Type (Stub_Elements.RACW_Type));
      begin
         Append_To (Decls,
           Make_Procedure_Call_Statement (Loc,
              Name =>
                New_Occurrence_Of (
                  RTE (RE_Register_Obj_Receiving_Stub), Loc),

                Parameter_Associations => New_List (

               --  Name

                Make_String_Literal (Loc,
                  Full_Qualified_Name (Desig)),

               --  Handler

                Make_Attribute_Reference (Loc,
                  Prefix =>
                    New_Occurrence_Of (
                      Defining_Unit_Name (Parent (RPC_Receiver)), Loc),
                  Attribute_Name =>
                    Name_Access),

               --  Receiver

                Make_Attribute_Reference (Loc,
                  Prefix =>
                    New_Occurrence_Of (
                      Defining_Identifier (
                        Stub_Elements.RPC_Receiver_Decl), Loc),
                  Attribute_Name =>
                    Name_Access))));
      end Add_Obj_RPC_Receiver_Completion;

      -----------------------
      -- Add_RACW_Features --
      -----------------------

      procedure Add_RACW_Features
        (RACW_Type         : Entity_Id;
         Desig             : Entity_Id;
         Stub_Type         : Entity_Id;
         Stub_Type_Access  : Entity_Id;
         RPC_Receiver_Decl : Node_Id;
         Body_Decls        : List_Id)
      is
         pragma Unreferenced (RPC_Receiver_Decl);

      begin
         Add_RACW_From_Any
           (RACW_Type           => RACW_Type,
            Body_Decls          => Body_Decls);

         Add_RACW_To_Any
           (RACW_Type           => RACW_Type,
            Body_Decls          => Body_Decls);

         Add_RACW_Write_Attribute
           (RACW_Type           => RACW_Type,
            Stub_Type           => Stub_Type,
            Stub_Type_Access    => Stub_Type_Access,
            Body_Decls          => Body_Decls);

         Add_RACW_Read_Attribute
           (RACW_Type           => RACW_Type,
            Stub_Type           => Stub_Type,
            Stub_Type_Access    => Stub_Type_Access,
            Body_Decls          => Body_Decls);

         Add_RACW_TypeCode
           (Designated_Type     => Desig,
            RACW_Type           => RACW_Type,
            Body_Decls          => Body_Decls);
      end Add_RACW_Features;

      -----------------------
      -- Add_RACW_From_Any --
      -----------------------

      procedure Add_RACW_From_Any
        (RACW_Type        : Entity_Id;
         Body_Decls       : List_Id)
      is
         Loc    : constant Source_Ptr := Sloc (RACW_Type);
         Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
         Fnam   : constant Entity_Id :=
                    Make_Defining_Identifier (Loc,
                      Chars => New_External_Name (Chars (RACW_Type), 'F'));

         Func_Spec : Node_Id;
         Func_Decl : Node_Id;
         Func_Body : Node_Id;

         Statements       : List_Id;
         --  Various parts of the subprogram

         Any_Parameter : constant Entity_Id :=
                           Make_Defining_Identifier (Loc, Name_A);

         Asynchronous_Flag : constant Entity_Id :=
                               Asynchronous_Flags_Table.Get (RACW_Type);
         --  The flag object declared in Add_RACW_Asynchronous_Flag

      begin
         Func_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name =>
               Fnam,
             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier =>
                   Any_Parameter,
                 Parameter_Type =>
                   New_Occurrence_Of (RTE (RE_Any), Loc))),
             Result_Definition => New_Occurrence_Of (RACW_Type, Loc));

         --  NOTE: The usage occurrences of RACW_Parameter must refer to the
         --  entity in the declaration spec, not those of the body spec.

         Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
         Insert_After (Declaration_Node (RACW_Type), Func_Decl);
         Set_Renaming_TSS (RACW_Type, Fnam, TSS_From_Any);

         if No (Body_Decls) then
            return;
         end if;

         --  ??? Issue with asynchronous calls here: the Asynchronous flag is
         --  set on the stub type if, and only if, the RACW type has a pragma
         --  Asynchronous. This is incorrect for RACWs that implement RAS
         --  types, because in that case the /designated subprogram/ (not the
         --  type) might be asynchronous, and that causes the stub to need to
         --  be asynchronous too. A solution is to transport a RAS as a struct
         --  containing a RACW and an asynchronous flag, and to properly alter
         --  the Asynchronous component in the stub type in the RAS's _From_Any
         --  TSS.

         Statements := New_List (
           Make_Simple_Return_Statement (Loc,
             Expression => Unchecked_Convert_To (RACW_Type,
               Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (RTE (RE_Get_RACW), Loc),
                 Parameter_Associations => New_List (
                   Make_Function_Call (Loc,
                     Name => New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc),
                     Parameter_Associations => New_List (
                       New_Occurrence_Of (Any_Parameter, Loc))),
                   Build_Stub_Tag (Loc, RACW_Type),
                   New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
                   New_Occurrence_Of (Asynchronous_Flag, Loc))))));

         Func_Body :=
           Make_Subprogram_Body (Loc,
             Specification => Copy_Specification (Loc, Func_Spec),
             Declarations  => No_List,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Statements));

         Append_To (Body_Decls, Func_Body);
      end Add_RACW_From_Any;

      -----------------------------
      -- Add_RACW_Read_Attribute --
      -----------------------------

      procedure Add_RACW_Read_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         Body_Decls       : List_Id)
      is
         pragma Unreferenced (Stub_Type, Stub_Type_Access);

         Loc : constant Source_Ptr := Sloc (RACW_Type);

         Proc_Decl : Node_Id;
         Attr_Decl : Node_Id;

         Body_Node : Node_Id;

         Decls      : constant List_Id   := New_List;
         Statements : constant List_Id   := New_List;
         Reference  : constant Entity_Id :=
                        Make_Defining_Identifier (Loc, Name_R);
         --  Various parts of the procedure

         Pnam : constant Entity_Id := Make_Temporary (Loc, 'R');

         Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);

         Asynchronous_Flag : constant Entity_Id :=
                               Asynchronous_Flags_Table.Get (RACW_Type);
         pragma Assert (Present (Asynchronous_Flag));

         function Stream_Parameter return Node_Id;
         function Result return Node_Id;

         --  Functions to create occurrences of the formal parameter names

         ------------
         -- Result --
         ------------

         function Result return Node_Id is
         begin
            return Make_Identifier (Loc, Name_V);
         end Result;

         ----------------------
         -- Stream_Parameter --
         ----------------------

         function Stream_Parameter return Node_Id is
         begin
            return Make_Identifier (Loc, Name_S);
         end Stream_Parameter;

      --  Start of processing for Add_RACW_Read_Attribute

      begin
         Build_Stream_Procedure
           (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => True);

         Proc_Decl := Make_Subprogram_Declaration (Loc,
           Copy_Specification (Loc, Specification (Body_Node)));

         Attr_Decl :=
           Make_Attribute_Definition_Clause (Loc,
             Name       => New_Occurrence_Of (RACW_Type, Loc),
             Chars      => Name_Read,
             Expression =>
               New_Occurrence_Of (
                 Defining_Unit_Name (Specification (Proc_Decl)), Loc));

         Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
         Insert_After (Proc_Decl, Attr_Decl);

         if No (Body_Decls) then
            return;
         end if;

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier =>
               Reference,
             Object_Definition =>
               New_Occurrence_Of (RTE (RE_Object_Ref), Loc)));

         Append_List_To (Statements, New_List (
           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (RTE (RE_Object_Ref), Loc),
             Attribute_Name => Name_Read,
             Expressions    => New_List (
               Stream_Parameter,
               New_Occurrence_Of (Reference, Loc))),

           Make_Assignment_Statement (Loc,
             Name       =>
               Result,
             Expression =>
               Unchecked_Convert_To (RACW_Type,
                 Make_Function_Call (Loc,
                   Name                   =>
                     New_Occurrence_Of (RTE (RE_Get_RACW), Loc),
                   Parameter_Associations => New_List (
                     New_Occurrence_Of (Reference, Loc),
                     Build_Stub_Tag (Loc, RACW_Type),
                     New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
                     New_Occurrence_Of (Asynchronous_Flag, Loc)))))));

         Set_Declarations (Body_Node, Decls);
         Append_To (Body_Decls, Body_Node);
      end Add_RACW_Read_Attribute;

      ---------------------
      -- Add_RACW_To_Any --
      ---------------------

      procedure Add_RACW_To_Any
        (RACW_Type        : Entity_Id;
         Body_Decls       : List_Id)
      is
         Loc : constant Source_Ptr := Sloc (RACW_Type);

         Fnam : constant Entity_Id :=
                  Make_Defining_Identifier (Loc,
                    Chars => New_External_Name (Chars (RACW_Type), 'T'));

         Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);

         Stub_Elements : constant Stub_Structure :=
                           Get_Stub_Elements (RACW_Type);

         Func_Spec : Node_Id;
         Func_Decl : Node_Id;
         Func_Body : Node_Id;

         Decls      : List_Id;
         Statements : List_Id;
         --  Various parts of the subprogram

         RACW_Parameter : constant Entity_Id :=
                            Make_Defining_Identifier (Loc, Name_R);

         Reference : constant Entity_Id := Make_Temporary (Loc, 'R');
         Any       : constant Entity_Id := Make_Temporary (Loc, 'A');

      begin
         Func_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name =>
               Fnam,
             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier =>
                   RACW_Parameter,
                 Parameter_Type =>
                   New_Occurrence_Of (RACW_Type, Loc))),
             Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));

         --  NOTE: The usage occurrences of RACW_Parameter must refer to the
         --  entity in the declaration spec, not in the body spec.

         Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);

         Insert_After (Declaration_Node (RACW_Type), Func_Decl);
         Set_Renaming_TSS (RACW_Type, Fnam, TSS_To_Any);

         if No (Body_Decls) then
            return;
         end if;

         --  Generate:

         --    R : constant Object_Ref :=
         --          Get_Reference
         --            (Address!(RACW),
         --             "typ",
         --             Stub_Type'Tag,
         --             Is_RAS,
         --             RPC_Receiver'Access);
         --    A : Any;

         Decls := New_List (
           Make_Object_Declaration (Loc,
             Defining_Identifier => Reference,
             Constant_Present    => True,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Object_Ref), Loc),
             Expression          =>
               Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (RTE (RE_Get_Reference), Loc),
                 Parameter_Associations => New_List (
                   Unchecked_Convert_To (RTE (RE_Address),
                     New_Occurrence_Of (RACW_Parameter, Loc)),
                   Make_String_Literal (Loc,
                     Strval => Full_Qualified_Name
                                 (Etype (Designated_Type (RACW_Type)))),
                   Build_Stub_Tag (Loc, RACW_Type),
                   New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
                   Make_Attribute_Reference (Loc,
                     Prefix         =>
                       New_Occurrence_Of
                         (Defining_Identifier
                           (Stub_Elements.RPC_Receiver_Decl), Loc),
                     Attribute_Name => Name_Access)))),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Any,
             Object_Definition   => New_Occurrence_Of (RTE (RE_Any), Loc)));

         --  Generate:

         --    Any := TA_ObjRef (Reference);
         --    Set_TC (Any, RPC_Receiver.Obj_TypeCode);
         --    return Any;

         Statements := New_List (
           Make_Assignment_Statement (Loc,
             Name => New_Occurrence_Of (Any, Loc),
             Expression =>
               Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (RTE (RE_TA_ObjRef), Loc),
                 Parameter_Associations => New_List (
                   New_Occurrence_Of (Reference, Loc)))),

           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc),
             Parameter_Associations => New_List (
               New_Occurrence_Of (Any, Loc),
               Make_Selected_Component (Loc,
                 Prefix =>
                     Defining_Identifier (
                       Stub_Elements.RPC_Receiver_Decl),
                 Selector_Name => Name_Obj_TypeCode))),

           Make_Simple_Return_Statement (Loc,
             Expression => New_Occurrence_Of (Any, Loc)));

         Func_Body :=
           Make_Subprogram_Body (Loc,
             Specification              => Copy_Specification (Loc, Func_Spec),
             Declarations               => Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Statements));
         Append_To (Body_Decls, Func_Body);
      end Add_RACW_To_Any;

      -----------------------
      -- Add_RACW_TypeCode --
      -----------------------

      procedure Add_RACW_TypeCode
        (Designated_Type  : Entity_Id;
         RACW_Type        : Entity_Id;
         Body_Decls       : List_Id)
      is
         Loc : constant Source_Ptr := Sloc (RACW_Type);

         Fnam : constant Entity_Id :=
                  Make_Defining_Identifier (Loc,
                    Chars => New_External_Name (Chars (RACW_Type), 'Y'));

         Stub_Elements : constant Stub_Structure :=
                           Stubs_Table.Get (Designated_Type);
         pragma Assert (Stub_Elements /= Empty_Stub_Structure);

         Func_Spec : Node_Id;
         Func_Decl : Node_Id;
         Func_Body : Node_Id;

      begin
         --  The spec for this subprogram has a dummy 'access RACW' argument,
         --  which serves only for overloading purposes.

         Func_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name => Fnam,
             Result_Definition  => New_Occurrence_Of (RTE (RE_TypeCode), Loc));

         --  NOTE: The usage occurrences of RACW_Parameter must refer to the
         --  entity in the declaration spec, not those of the body spec.

         Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
         Insert_After (Declaration_Node (RACW_Type), Func_Decl);
         Set_Renaming_TSS (RACW_Type, Fnam, TSS_TypeCode);

         if No (Body_Decls) then
            return;
         end if;

         Func_Body :=
           Make_Subprogram_Body (Loc,
             Specification              => Copy_Specification (Loc, Func_Spec),
             Declarations               => Empty_List,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => New_List (
                   Make_Simple_Return_Statement (Loc,
                     Expression =>
                       Make_Selected_Component (Loc,
                         Prefix =>
                           Defining_Identifier
                             (Stub_Elements.RPC_Receiver_Decl),
                         Selector_Name => Name_Obj_TypeCode)))));

         Append_To (Body_Decls, Func_Body);
      end Add_RACW_TypeCode;

      ------------------------------
      -- Add_RACW_Write_Attribute --
      ------------------------------

      procedure Add_RACW_Write_Attribute
        (RACW_Type        : Entity_Id;
         Stub_Type        : Entity_Id;
         Stub_Type_Access : Entity_Id;
         Body_Decls       : List_Id)
      is
         pragma Unreferenced (Stub_Type, Stub_Type_Access);

         Loc : constant Source_Ptr := Sloc (RACW_Type);

         Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);

         Stub_Elements : constant Stub_Structure :=
                            Get_Stub_Elements (RACW_Type);

         Body_Node : Node_Id;
         Proc_Decl : Node_Id;
         Attr_Decl : Node_Id;

         Statements : constant List_Id := New_List;
         Pnam : constant Entity_Id := Make_Temporary (Loc, 'R');

         function Stream_Parameter return Node_Id;
         function Object return Node_Id;
         --  Functions to create occurrences of the formal parameter names

         ------------
         -- Object --
         ------------

         function Object return Node_Id is
         begin
            return Make_Identifier (Loc, Name_V);
         end Object;

         ----------------------
         -- Stream_Parameter --
         ----------------------

         function Stream_Parameter return Node_Id is
         begin
            return Make_Identifier (Loc, Name_S);
         end Stream_Parameter;

      --  Start of processing for Add_RACW_Write_Attribute

      begin
         Build_Stream_Procedure
           (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => False);

         Proc_Decl :=
           Make_Subprogram_Declaration (Loc,
             Copy_Specification (Loc, Specification (Body_Node)));

         Attr_Decl :=
           Make_Attribute_Definition_Clause (Loc,
             Name       => New_Occurrence_Of (RACW_Type, Loc),
             Chars      => Name_Write,
             Expression =>
               New_Occurrence_Of (
                 Defining_Unit_Name (Specification (Proc_Decl)), Loc));

         Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
         Insert_After (Proc_Decl, Attr_Decl);

         if No (Body_Decls) then
            return;
         end if;

         Append_To (Statements,
           Pack_Node_Into_Stream_Access (Loc,
             Stream => Stream_Parameter,
             Object =>
               Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (RTE (RE_Get_Reference), Loc),
                 Parameter_Associations => New_List (
                   Unchecked_Convert_To (RTE (RE_Address), Object),
                  Make_String_Literal (Loc,
                    Strval => Full_Qualified_Name
                                (Etype (Designated_Type (RACW_Type)))),
                  Build_Stub_Tag (Loc, RACW_Type),
                  New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
                  Make_Attribute_Reference (Loc,
                    Prefix         =>
                       New_Occurrence_Of
                         (Defining_Identifier
                           (Stub_Elements.RPC_Receiver_Decl), Loc),
                    Attribute_Name => Name_Access))),

             Etyp => RTE (RE_Object_Ref)));

         Append_To (Body_Decls, Body_Node);
      end Add_RACW_Write_Attribute;

      -----------------------
      -- Add_RAST_Features --
      -----------------------

      procedure Add_RAST_Features
        (Vis_Decl : Node_Id;
         RAS_Type : Entity_Id)
      is
      begin
         Add_RAS_Access_TSS (Vis_Decl);

         Add_RAS_From_Any (RAS_Type);
         Add_RAS_TypeCode (RAS_Type);

         --  To_Any uses TypeCode, and therefore needs to be generated last

         Add_RAS_To_Any   (RAS_Type);
      end Add_RAST_Features;

      ------------------------
      -- Add_RAS_Access_TSS --
      ------------------------

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

         Ras_Type : constant Entity_Id := Defining_Identifier (N);
         Fat_Type : constant Entity_Id := Equivalent_Type (Ras_Type);
         --  Ras_Type is the access to subprogram type; Fat_Type is the
         --  corresponding record type.

         RACW_Type : constant Entity_Id :=
                       Underlying_RACW_Type (Ras_Type);

         Stub_Elements : constant Stub_Structure :=
                           Get_Stub_Elements (RACW_Type);

         Proc : constant Entity_Id :=
                  Make_Defining_Identifier (Loc,
                    Chars => Make_TSS_Name (Ras_Type, TSS_RAS_Access));

         Proc_Spec : Node_Id;

         --  Formal parameters

         Package_Name : constant Entity_Id :=
                          Make_Defining_Identifier (Loc,
                            Chars => Name_P);

         --  Target package

         Subp_Id : constant Entity_Id :=
                     Make_Defining_Identifier (Loc,
                       Chars => Name_S);

         --  Target subprogram

         Asynch_P : constant Entity_Id :=
                      Make_Defining_Identifier (Loc,
                        Chars => Name_Asynchronous);
         --  Is the procedure to which the 'Access applies asynchronous?

         All_Calls_Remote : constant Entity_Id :=
                              Make_Defining_Identifier (Loc,
                                Chars => Name_All_Calls_Remote);
         --  True if an All_Calls_Remote pragma applies to the RCI unit
         --  that contains the subprogram.

         --  Common local variables

         Proc_Decls      : List_Id;
         Proc_Statements : List_Id;

         Subp_Ref : constant Entity_Id :=
                      Make_Defining_Identifier (Loc, Name_R);
         --  Reference that designates the target subprogram (returned
         --  by Get_RAS_Info).

         Is_Local : constant Entity_Id :=
           Make_Defining_Identifier (Loc, Name_L);
         Local_Addr : constant Entity_Id :=
           Make_Defining_Identifier (Loc, Name_A);
         --  For the call to Get_Local_Address

         Local_Stub : constant Entity_Id := Make_Temporary (Loc, 'L');
         Stub_Ptr   : constant Entity_Id := Make_Temporary (Loc, 'S');
         --  Additional local variables for the remote case

         function Set_Field
           (Field_Name : Name_Id;
            Value      : Node_Id) return Node_Id;
         --  Construct an assignment that sets the named component in the
         --  returned record

         ---------------
         -- Set_Field --
         ---------------

         function Set_Field
           (Field_Name : Name_Id;
            Value      : Node_Id) return Node_Id
         is
         begin
            return
              Make_Assignment_Statement (Loc,
                Name       =>
                  Make_Selected_Component (Loc,
                    Prefix        => Stub_Ptr,
                    Selector_Name => Field_Name),
                Expression => Value);
         end Set_Field;

      --  Start of processing for Add_RAS_Access_TSS

      begin
         Proc_Decls := New_List (

         --  Common declarations

           Make_Object_Declaration (Loc,
             Defining_Identifier => Subp_Ref,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Object_Ref), Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Is_Local,
             Object_Definition   =>
               New_Occurrence_Of (Standard_Boolean, Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Local_Addr,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Address), Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Local_Stub,
             Aliased_Present     => True,
             Object_Definition   =>
               New_Occurrence_Of (Stub_Elements.Stub_Type, Loc)),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Stub_Ptr,
             Object_Definition   =>
               New_Occurrence_Of (Stub_Elements.Stub_Type_Access, Loc),
             Expression          =>
               Make_Attribute_Reference (Loc,
                 Prefix => New_Occurrence_Of (Local_Stub, Loc),
                 Attribute_Name => Name_Unchecked_Access)));

         Set_Etype (Stub_Ptr, Stub_Elements.Stub_Type_Access);
         --  Build_Get_Unique_RP_Call needs this information

         --  Get_RAS_Info (Pkg, Subp, R);
         --  Obtain a reference to the target subprogram

         Proc_Statements := New_List (
           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc),
             Parameter_Associations => New_List (
               New_Occurrence_Of (Package_Name, Loc),
               New_Occurrence_Of (Subp_Id, Loc),
               New_Occurrence_Of (Subp_Ref, Loc))),

         --  Get_Local_Address (R, L, A);
         --  Determine whether the subprogram is local (L), and if so
         --  obtain the local address of its proxy (A).

           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
             Parameter_Associations => New_List (
               New_Occurrence_Of (Subp_Ref, Loc),
               New_Occurrence_Of (Is_Local, Loc),
               New_Occurrence_Of (Local_Addr, Loc))));

         --  Note: Here we assume that the Fat_Type is a record containing just
         --  an access to a proxy or stub object.

         Append_To (Proc_Statements,

           --  if L then

           Make_Implicit_If_Statement (N,
             Condition => New_Occurrence_Of (Is_Local, Loc),

             Then_Statements => New_List (

               --  if A.Target = null then

               Make_Implicit_If_Statement (N,
                 Condition =>
                   Make_Op_Eq (Loc,
                     Make_Selected_Component (Loc,
                       Prefix        =>
                         Unchecked_Convert_To
                           (RTE (RE_RAS_Proxy_Type_Access),
                            New_Occurrence_Of (Local_Addr, Loc)),
                       Selector_Name => Make_Identifier (Loc, Name_Target)),
                     Make_Null (Loc)),

                 Then_Statements => New_List (

                   --    A.Target := Entity_Of (Ref);

                   Make_Assignment_Statement (Loc,
                     Name =>
                       Make_Selected_Component (Loc,
                         Prefix        =>
                           Unchecked_Convert_To
                             (RTE (RE_RAS_Proxy_Type_Access),
                              New_Occurrence_Of (Local_Addr, Loc)),
                         Selector_Name => Make_Identifier (Loc, Name_Target)),
                     Expression =>
                       Make_Function_Call (Loc,
                         Name => New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
                         Parameter_Associations => New_List (
                           New_Occurrence_Of (Subp_Ref, Loc)))),

                   --    Inc_Usage (A.Target);
                   --  end if;

                   Make_Procedure_Call_Statement (Loc,
                     Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
                     Parameter_Associations => New_List (
                       Make_Selected_Component (Loc,
                         Prefix        =>
                           Unchecked_Convert_To
                             (RTE (RE_RAS_Proxy_Type_Access),
                              New_Occurrence_Of (Local_Addr, Loc)),
                         Selector_Name =>
                           Make_Identifier (Loc, Name_Target)))))),

                 --     if not All_Calls_Remote then
                 --        return Fat_Type!(A);
                 --     end if;

                 Make_Implicit_If_Statement (N,
                   Condition =>
                     Make_Op_Not (Loc,
                       Right_Opnd =>
                         New_Occurrence_Of (All_Calls_Remote, Loc)),

                   Then_Statements => New_List (
                     Make_Simple_Return_Statement (Loc,
                     Expression =>
                       Unchecked_Convert_To
                         (Fat_Type, New_Occurrence_Of (Local_Addr, Loc))))))));

         Append_List_To (Proc_Statements, New_List (

           --  Stub.Target := Entity_Of (Ref);

           Set_Field (Name_Target,
             Make_Function_Call (Loc,
               Name => New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
               Parameter_Associations => New_List (
                 New_Occurrence_Of (Subp_Ref, Loc)))),

           --  Inc_Usage (Stub.Target);

           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
             Parameter_Associations => New_List (
               Make_Selected_Component (Loc,
                 Prefix        => Stub_Ptr,
                 Selector_Name => Name_Target))),

           --  E.4.1(9) A remote call is asynchronous if it is a call to
           --  a procedure, or a call through a value of an access-to-procedure
           --  type, to which a pragma Asynchronous applies.

           --    Parameter Asynch_P is true when the procedure is asynchronous;
           --    Expression Asynch_T is true when the type is asynchronous.

           Set_Field (Name_Asynchronous,
             Make_Or_Else (Loc,
               Left_Opnd  => New_Occurrence_Of (Asynch_P, Loc),
               Right_Opnd =>
                 New_Occurrence_Of
                   (Boolean_Literals (Is_Asynchronous (Ras_Type)), Loc)))));

         Append_List_To (Proc_Statements,
           Build_Get_Unique_RP_Call (Loc, Stub_Ptr, Stub_Elements.Stub_Type));

         Append_To (Proc_Statements,
           Make_Simple_Return_Statement (Loc,
             Expression =>
               Unchecked_Convert_To (Fat_Type,
                 New_Occurrence_Of (Stub_Ptr, Loc))));

         Proc_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name       => Proc,
             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Package_Name,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_String, Loc)),

               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Subp_Id,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_String, Loc)),

               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Asynch_P,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_Boolean, Loc)),

               Make_Parameter_Specification (Loc,
                 Defining_Identifier => All_Calls_Remote,
                 Parameter_Type      =>
                   New_Occurrence_Of (Standard_Boolean, Loc))),

            Result_Definition =>
              New_Occurrence_Of (Fat_Type, Loc));

         --  Set the kind and return type of the function to prevent
         --  ambiguities between Ras_Type and Fat_Type in subsequent analysis.

         Set_Ekind (Proc, E_Function);
         Set_Etype (Proc, Fat_Type);

         Discard_Node (
           Make_Subprogram_Body (Loc,
             Specification              => Proc_Spec,
             Declarations               => Proc_Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Proc_Statements)));

         Set_TSS (Fat_Type, Proc);
      end Add_RAS_Access_TSS;

      ----------------------
      -- Add_RAS_From_Any --
      ----------------------

      procedure Add_RAS_From_Any (RAS_Type : Entity_Id) is
         Loc : constant Source_Ptr := Sloc (RAS_Type);

         Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
                  Make_TSS_Name (RAS_Type, TSS_From_Any));

         Func_Spec : Node_Id;

         Statements : List_Id;

         Any_Parameter : constant Entity_Id :=
                           Make_Defining_Identifier (Loc, Name_A);

      begin
         Statements := New_List (
           Make_Simple_Return_Statement (Loc,
             Expression =>
               Make_Aggregate (Loc,
                 Component_Associations => New_List (
                   Make_Component_Association (Loc,
                     Choices => New_List (
                       Make_Identifier (Loc, Name_Ras)),
                     Expression =>
                       PolyORB_Support.Helpers.Build_From_Any_Call (
                         Underlying_RACW_Type (RAS_Type),
                         New_Occurrence_Of (Any_Parameter, Loc),
                         No_List))))));

         Func_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name       => Fnam,
             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Any_Parameter,
                 Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))),
             Result_Definition => New_Occurrence_Of (RAS_Type, Loc));

         Discard_Node (
           Make_Subprogram_Body (Loc,
             Specification              => Func_Spec,
             Declarations               => No_List,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Statements)));
         Set_TSS (RAS_Type, Fnam);
      end Add_RAS_From_Any;

      --------------------
      -- Add_RAS_To_Any --
      --------------------

      procedure Add_RAS_To_Any (RAS_Type : Entity_Id) is
         Loc : constant Source_Ptr := Sloc (RAS_Type);

         Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
                  Make_TSS_Name (RAS_Type, TSS_To_Any));

         Decls      : List_Id;
         Statements : List_Id;

         Func_Spec : Node_Id;

         Any            : constant Entity_Id := Make_Temporary (Loc, 'A');
         RAS_Parameter  : constant Entity_Id := Make_Temporary (Loc, 'R');
         RACW_Parameter : constant Node_Id :=
                            Make_Selected_Component (Loc,
                              Prefix        => RAS_Parameter,
                              Selector_Name => Name_Ras);

      begin
         --  Object declarations

         Set_Etype (RACW_Parameter, Underlying_RACW_Type (RAS_Type));
         Decls := New_List (
           Make_Object_Declaration (Loc,
             Defining_Identifier => Any,
             Object_Definition   => New_Occurrence_Of (RTE (RE_Any), Loc),
             Expression          =>
               PolyORB_Support.Helpers.Build_To_Any_Call
                 (RACW_Parameter, No_List)));

         Statements := New_List (
           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc),
             Parameter_Associations => New_List (
               New_Occurrence_Of (Any, Loc),
               PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
                 RAS_Type, Decls))),

           Make_Simple_Return_Statement (Loc,
             Expression => New_Occurrence_Of (Any, Loc)));

         Func_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name => Fnam,
             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier => RAS_Parameter,
                 Parameter_Type      => New_Occurrence_Of (RAS_Type, Loc))),
             Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));

         Discard_Node (
           Make_Subprogram_Body (Loc,
             Specification              => Func_Spec,
             Declarations               => Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Statements)));
         Set_TSS (RAS_Type, Fnam);
      end Add_RAS_To_Any;

      ----------------------
      -- Add_RAS_TypeCode --
      ----------------------

      procedure Add_RAS_TypeCode (RAS_Type : Entity_Id) is
         Loc : constant Source_Ptr := Sloc (RAS_Type);

         Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
                  Make_TSS_Name (RAS_Type, TSS_TypeCode));

         Func_Spec      : Node_Id;
         Decls          : constant List_Id := New_List;
         Name_String    : String_Id;
         Repo_Id_String : String_Id;

      begin
         Func_Spec :=
           Make_Function_Specification (Loc,
             Defining_Unit_Name => Fnam,
             Result_Definition  => New_Occurrence_Of (RTE (RE_TypeCode), Loc));

         PolyORB_Support.Helpers.Build_Name_And_Repository_Id
           (RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String);

         Discard_Node (
           Make_Subprogram_Body (Loc,
             Specification              => Func_Spec,
             Declarations               => Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => New_List (
                   Make_Simple_Return_Statement (Loc,
                     Expression =>
                       Make_Function_Call (Loc,
                         Name => New_Occurrence_Of (RTE (RE_TC_Build), Loc),
                         Parameter_Associations => New_List (
                           New_Occurrence_Of (RTE (RE_TC_Object), Loc),
                           Make_Aggregate (Loc,
                             Expressions =>
                               New_List (
                                 Make_Function_Call (Loc,
                                   Name =>
                                     New_Occurrence_Of
                                       (RTE (RE_TA_Std_String), Loc),
                                   Parameter_Associations => New_List (
                                     Make_String_Literal (Loc, Name_String))),
                                 Make_Function_Call (Loc,
                                   Name =>
                                     New_Occurrence_Of
                                       (RTE (RE_TA_Std_String), Loc),
                                   Parameter_Associations => New_List (
                                     Make_String_Literal (Loc,
                                       Strval => Repo_Id_String))))))))))));
         Set_TSS (RAS_Type, Fnam);
      end Add_RAS_TypeCode;

      -----------------------------------------
      -- Add_Receiving_Stubs_To_Declarations --
      -----------------------------------------

      procedure Add_Receiving_Stubs_To_Declarations
        (Pkg_Spec : Node_Id;
         Decls    : List_Id;
         Stmts    : List_Id)
      is
         Loc : constant Source_Ptr := Sloc (Pkg_Spec);

         Pkg_RPC_Receiver            : constant Entity_Id :=
                                         Make_Temporary (Loc, 'H');
         Pkg_RPC_Receiver_Object     : Node_Id;
         Pkg_RPC_Receiver_Body       : Node_Id;
         Pkg_RPC_Receiver_Decls      : List_Id;
         Pkg_RPC_Receiver_Statements : List_Id;

         Pkg_RPC_Receiver_Cases : constant List_Id := New_List;
         --  A Pkg_RPC_Receiver is built to decode the request

         Request : Node_Id;
         --  Request object received from neutral layer

         Subp_Id : Entity_Id;
         --  Subprogram identifier as received from the neutral distribution
         --  core.

         Subp_Index : Entity_Id;
         --  Internal index as determined by matching either the method name
         --  from the request structure, or the local subprogram address (in
         --  case of a RAS).

         Is_Local : constant Entity_Id := Make_Temporary (Loc, 'L');

         Local_Address : constant Entity_Id := Make_Temporary (Loc, 'A');
         --  Address of a local subprogram designated by a reference
         --  corresponding to a RAS.

         Dispatch_On_Address : constant List_Id := New_List;
         Dispatch_On_Name    : constant List_Id := New_List;

         Current_Declaration       : Node_Id;
         Current_Stubs             : Node_Id;
         Current_Subprogram_Number : Int := First_RCI_Subprogram_Id;

         Subp_Info_Array : constant Entity_Id := Make_Temporary (Loc, 'I');

         Subp_Info_List : constant List_Id := New_List;

         Register_Pkg_Actuals : constant List_Id := New_List;

         All_Calls_Remote_E  : Entity_Id;

         procedure Append_Stubs_To
           (RPC_Receiver_Cases : List_Id;
            Declaration        : Node_Id;
            Stubs              : Node_Id;
            Subp_Number        : Int;
            Subp_Dist_Name     : Entity_Id;
            Subp_Proxy_Addr    : Entity_Id);
         --  Add one case to the specified RPC receiver case list associating
         --  Subprogram_Number with the subprogram declared by Declaration, for
         --  which we have receiving stubs in Stubs. Subp_Number is an internal
         --  subprogram index. Subp_Dist_Name is the string used to call the
         --  subprogram by name, and Subp_Dist_Addr is the address of the proxy
         --  object, used in the context of calls through remote
         --  access-to-subprogram types.

         ---------------------
         -- Append_Stubs_To --
         ---------------------

         procedure Append_Stubs_To
           (RPC_Receiver_Cases : List_Id;
            Declaration        : Node_Id;
            Stubs              : Node_Id;
            Subp_Number        : Int;
            Subp_Dist_Name     : Entity_Id;
            Subp_Proxy_Addr    : Entity_Id)
         is
            Case_Stmts : List_Id;
         begin
            Case_Stmts := New_List (
              Make_Procedure_Call_Statement (Loc,
                Name                   =>
                  New_Occurrence_Of (
                    Defining_Entity (Stubs), Loc),
                Parameter_Associations =>
                  New_List (New_Occurrence_Of (Request, Loc))));

            if Nkind (Specification (Declaration)) = N_Function_Specification
              or else not
                Is_Asynchronous (Defining_Entity (Specification (Declaration)))
            then
               Append_To (Case_Stmts, Make_Simple_Return_Statement (Loc));
            end if;

            Append_To (RPC_Receiver_Cases,
              Make_Case_Statement_Alternative (Loc,
                Discrete_Choices =>
                   New_List (Make_Integer_Literal (Loc, Subp_Number)),
                Statements       => Case_Stmts));

            Append_To (Dispatch_On_Name,
              Make_Elsif_Part (Loc,
                Condition =>
                  Make_Function_Call (Loc,
                    Name =>
                      New_Occurrence_Of (RTE (RE_Caseless_String_Eq), Loc),
                    Parameter_Associations => New_List (
                      New_Occurrence_Of (Subp_Id, Loc),
                      New_Occurrence_Of (Subp_Dist_Name, Loc))),

                Then_Statements => New_List (
                  Make_Assignment_Statement (Loc,
                    New_Occurrence_Of (Subp_Index, Loc),
                    Make_Integer_Literal (Loc, Subp_Number)))));

            Append_To (Dispatch_On_Address,
              Make_Elsif_Part (Loc,
                Condition =>
                  Make_Op_Eq (Loc,
                    Left_Opnd  => New_Occurrence_Of (Local_Address, Loc),
                    Right_Opnd => New_Occurrence_Of (Subp_Proxy_Addr, Loc)),

                Then_Statements => New_List (
                  Make_Assignment_Statement (Loc,
                    New_Occurrence_Of (Subp_Index, Loc),
                    Make_Integer_Literal (Loc, Subp_Number)))));
         end Append_Stubs_To;

      --  Start of processing for Add_Receiving_Stubs_To_Declarations

      begin
         --  Building receiving stubs consist in several operations:

         --    - a package RPC receiver must be built. This subprogram will get
         --      a Subprogram_Id from the incoming stream and will dispatch the
         --      call to the right subprogram;

         --    - a receiving stub for each subprogram visible in the package
         --      spec. This stub will read all the parameters from the stream,
         --      and put the result as well as the exception occurrence in the
         --      output stream;

         Build_RPC_Receiver_Body (
           RPC_Receiver => Pkg_RPC_Receiver,
           Request      => Request,
           Subp_Id      => Subp_Id,
           Subp_Index   => Subp_Index,
           Stmts        => Pkg_RPC_Receiver_Statements,
           Decl         => Pkg_RPC_Receiver_Body);
         Pkg_RPC_Receiver_Decls := Declarations (Pkg_RPC_Receiver_Body);

         --  Extract local address information from the target reference:
         --  if non-null, that means that this is a reference that denotes
         --  one particular operation, and hence that the operation name
         --  must not be taken into account for dispatching.

         Append_To (Pkg_RPC_Receiver_Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Is_Local,
             Object_Definition   =>
               New_Occurrence_Of (Standard_Boolean, Loc)));

         Append_To (Pkg_RPC_Receiver_Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Local_Address,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Address), Loc)));

         Append_To (Pkg_RPC_Receiver_Statements,
           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
             Parameter_Associations => New_List (
               Make_Selected_Component (Loc,
                 Prefix        => Request,
                 Selector_Name => Name_Target),
               New_Occurrence_Of (Is_Local, Loc),
               New_Occurrence_Of (Local_Address, Loc))));

         --  For each subprogram, the receiving stub will be built and a case
         --  statement will be made on the Subprogram_Id to dispatch to the
         --  right subprogram.

         All_Calls_Remote_E := Boolean_Literals (
           Has_All_Calls_Remote (Defining_Entity (Pkg_Spec)));

         Overload_Counter_Table.Reset;
         Reserve_NamingContext_Methods;

         Current_Declaration := First (Visible_Declarations (Pkg_Spec));
         while Present (Current_Declaration) loop
            if Nkind (Current_Declaration) = N_Subprogram_Declaration
              and then Comes_From_Source (Current_Declaration)
            then
               declare
                  Loc : constant Source_Ptr := Sloc (Current_Declaration);
                  --  While specifically processing Current_Declaration, use
                  --  its Sloc as the location of all generated nodes.

                  Subp_Def : constant Entity_Id :=
                               Defining_Unit_Name
                                 (Specification (Current_Declaration));

                  Subp_Val : String_Id;

                  Subp_Dist_Name : constant Entity_Id :=
                                     Make_Defining_Identifier (Loc,
                                       Chars =>
                                         New_External_Name
                                           (Related_Id   => Chars (Subp_Def),
                                            Suffix       => 'D',
                                            Suffix_Index => -1));

                  Proxy_Object_Addr : Entity_Id;

               begin
                  --  Build receiving stub

                  Current_Stubs :=
                    Build_Subprogram_Receiving_Stubs
                      (Vis_Decl     => Current_Declaration,
                       Asynchronous =>
                         Nkind (Specification (Current_Declaration)) =
                             N_Procedure_Specification
                           and then Is_Asynchronous (Subp_Def));

                  Append_To (Decls, Current_Stubs);
                  Analyze (Current_Stubs);

                  --  Build RAS proxy

                  Add_RAS_Proxy_And_Analyze (Decls,
                    Vis_Decl           => Current_Declaration,
                    All_Calls_Remote_E => All_Calls_Remote_E,
                    Proxy_Object_Addr  => Proxy_Object_Addr);

                  --  Compute distribution identifier

                  Assign_Subprogram_Identifier
                    (Subp_Def,
                     Current_Subprogram_Number,
                     Subp_Val);

                  pragma Assert
                    (Current_Subprogram_Number = Get_Subprogram_Id (Subp_Def));

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Subp_Dist_Name,
                      Constant_Present    => True,
                      Object_Definition   =>
                        New_Occurrence_Of (Standard_String, Loc),
                      Expression          =>
                        Make_String_Literal (Loc, Subp_Val)));
                  Analyze (Last (Decls));

                  --  Add subprogram descriptor (RCI_Subp_Info) to the
                  --  subprograms table for this receiver. The aggregate
                  --  below must be kept consistent with the declaration
                  --  of type RCI_Subp_Info in System.Partition_Interface.

                  Append_To (Subp_Info_List,
                    Make_Component_Association (Loc,
                      Choices => New_List (
                        Make_Integer_Literal (Loc, Current_Subprogram_Number)),

                      Expression =>
                        Make_Aggregate (Loc,
                          Expressions => New_List (
                            Make_Attribute_Reference (Loc,
                              Prefix =>
                                New_Occurrence_Of (Subp_Dist_Name, Loc),
                              Attribute_Name => Name_Address),

                            Make_Attribute_Reference (Loc,
                              Prefix         =>
                                New_Occurrence_Of (Subp_Dist_Name, Loc),
                              Attribute_Name => Name_Length),

                            New_Occurrence_Of (Proxy_Object_Addr, Loc)))));

                  Append_Stubs_To (Pkg_RPC_Receiver_Cases,
                    Declaration     => Current_Declaration,
                    Stubs           => Current_Stubs,
                    Subp_Number     => Current_Subprogram_Number,
                    Subp_Dist_Name  => Subp_Dist_Name,
                    Subp_Proxy_Addr => Proxy_Object_Addr);
               end;

               Current_Subprogram_Number := Current_Subprogram_Number + 1;
            end if;

            Next (Current_Declaration);
         end loop;

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Subp_Info_Array,
             Constant_Present    => True,
             Aliased_Present     => True,
             Object_Definition   =>
               Make_Subtype_Indication (Loc,
                 Subtype_Mark =>
                   New_Occurrence_Of (RTE (RE_RCI_Subp_Info_Array), Loc),
                 Constraint =>
                   Make_Index_Or_Discriminant_Constraint (Loc,
                     New_List (
                       Make_Range (Loc,
                         Low_Bound  =>
                           Make_Integer_Literal (Loc,
                             Intval => First_RCI_Subprogram_Id),
                         High_Bound =>
                           Make_Integer_Literal (Loc,
                             Intval =>
                               First_RCI_Subprogram_Id
                               + List_Length (Subp_Info_List) - 1)))))));

         if Present (First (Subp_Info_List)) then
            Set_Expression (Last (Decls),
              Make_Aggregate (Loc,
                Component_Associations => Subp_Info_List));

            --  Generate the dispatch statement to determine the subprogram id
            --  of the called subprogram.

            --  We first test whether the reference that was used to make the
            --  call was the base RCI reference (in which case Local_Address is
            --  zero, and the method identifier from the request must be used
            --  to determine which subprogram is called) or a reference
            --  identifying one particular subprogram (in which case
            --  Local_Address is the address of that subprogram, and the
            --  method name from the request is ignored). The latter occurs
            --  for the case of a call through a remote access-to-subprogram.

            --  In each case, cascaded elsifs are used to determine the proper
            --  subprogram index. Using hash tables might be more efficient.

            Append_To (Pkg_RPC_Receiver_Statements,
              Make_Implicit_If_Statement (Pkg_Spec,
                Condition =>
                  Make_Op_Ne (Loc,
                    Left_Opnd  => New_Occurrence_Of (Local_Address, Loc),
                    Right_Opnd => New_Occurrence_Of
                                    (RTE (RE_Null_Address), Loc)),

                Then_Statements => New_List (
                  Make_Implicit_If_Statement (Pkg_Spec,
                    Condition       => New_Occurrence_Of (Standard_False, Loc),
                    Then_Statements => New_List (
                      Make_Null_Statement (Loc)),
                    Elsif_Parts     => Dispatch_On_Address)),

                Else_Statements => New_List (
                  Make_Implicit_If_Statement (Pkg_Spec,
                    Condition       => New_Occurrence_Of (Standard_False, Loc),
                    Then_Statements => New_List (Make_Null_Statement (Loc)),
                    Elsif_Parts     => Dispatch_On_Name))));

         else
            --  For a degenerate RCI with no visible subprograms,
            --  Subp_Info_List has zero length, and the declaration is for an
            --  empty array, in which case no initialization aggregate must be
            --  generated. We do not generate a Dispatch_Statement either.

            --  No initialization provided: remove CONSTANT so that the
            --  declaration is not an incomplete deferred constant.

            Set_Constant_Present (Last (Decls), False);
         end if;

         --  Analyze Subp_Info_Array declaration

         Analyze (Last (Decls));

         --  If we receive an invalid Subprogram_Id, it is best to do nothing
         --  rather than raising an exception since we do not want someone
         --  to crash a remote partition by sending invalid subprogram ids.
         --  This is consistent with the other parts of the case statement
         --  since even in presence of incorrect parameters in the stream,
         --  every exception will be caught and (if the subprogram is not an
         --  APC) put into the result stream and sent away.

         Append_To (Pkg_RPC_Receiver_Cases,
           Make_Case_Statement_Alternative (Loc,
             Discrete_Choices => New_List (Make_Others_Choice (Loc)),
             Statements       => New_List (Make_Null_Statement (Loc))));

         Append_To (Pkg_RPC_Receiver_Statements,
           Make_Case_Statement (Loc,
             Expression   => New_Occurrence_Of (Subp_Index, Loc),
             Alternatives => Pkg_RPC_Receiver_Cases));

         --  Pkg_RPC_Receiver body is now complete: insert it into the tree and
         --  analyze it.

         Append_To (Decls, Pkg_RPC_Receiver_Body);
         Analyze (Last (Decls));

         Pkg_RPC_Receiver_Object :=
           Make_Object_Declaration (Loc,
             Defining_Identifier => Make_Temporary (Loc, 'R'),
             Aliased_Present     => True,
             Object_Definition   => New_Occurrence_Of (RTE (RE_Servant), Loc));
         Append_To (Decls, Pkg_RPC_Receiver_Object);
         Analyze (Last (Decls));

         Get_Library_Unit_Name_String (Pkg_Spec);

         --  Name

         Append_To (Register_Pkg_Actuals,
           Make_String_Literal (Loc,
             Strval => String_From_Name_Buffer));

         --  Version

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of
                 (Defining_Entity (Pkg_Spec), Loc),
             Attribute_Name => Name_Version));

         --  Handler

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix          =>
               New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
             Attribute_Name  => Name_Access));

         --  Receiver

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         =>
               New_Occurrence_Of (
                 Defining_Identifier (Pkg_RPC_Receiver_Object), Loc),
             Attribute_Name => Name_Access));

         --  Subp_Info

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         => New_Occurrence_Of (Subp_Info_Array, Loc),
             Attribute_Name => Name_Address));

         --  Subp_Info_Len

         Append_To (Register_Pkg_Actuals,
           Make_Attribute_Reference (Loc,
             Prefix         => New_Occurrence_Of (Subp_Info_Array, Loc),
             Attribute_Name => Name_Length));

         --  Is_All_Calls_Remote

         Append_To (Register_Pkg_Actuals,
           New_Occurrence_Of (All_Calls_Remote_E, Loc));

         --  Finally call Register_Pkg_Receiving_Stub with the above parameters

         Append_To (Stmts,
           Make_Procedure_Call_Statement (Loc,
             Name                   =>
               New_Occurrence_Of (RTE (RE_Register_Pkg_Receiving_Stub), Loc),
             Parameter_Associations => Register_Pkg_Actuals));
         Analyze (Last (Stmts));
      end Add_Receiving_Stubs_To_Declarations;

      ---------------------------------
      -- Build_General_Calling_Stubs --
      ---------------------------------

      procedure Build_General_Calling_Stubs
        (Decls                     : List_Id;
         Statements                : List_Id;
         Target_Object             : Node_Id;
         Subprogram_Id             : Node_Id;
         Asynchronous              : Node_Id   := Empty;
         Is_Known_Asynchronous     : Boolean   := False;
         Is_Known_Non_Asynchronous : Boolean   := False;
         Is_Function               : Boolean;
         Spec                      : Node_Id;
         Stub_Type                 : Entity_Id := Empty;
         RACW_Type                 : Entity_Id := Empty;
         Nod                       : Node_Id)
      is
         Loc : constant Source_Ptr := Sloc (Nod);

         Request : constant Entity_Id := Make_Temporary (Loc, 'R');
         --  The request object constructed by these stubs
         --  Could we use Name_R instead??? (see GLADE client stubs)

         function Make_Request_RTE_Call
           (RE      : RE_Id;
            Actuals : List_Id := New_List) return Node_Id;
         --  Generate a procedure call statement calling RE with the given
         --  actuals. Request is appended to the list.

         ---------------------------
         -- Make_Request_RTE_Call --
         ---------------------------

         function Make_Request_RTE_Call
           (RE      : RE_Id;
            Actuals : List_Id := New_List) return Node_Id
         is
         begin
            Append_To (Actuals, New_Occurrence_Of (Request, Loc));
            return Make_Procedure_Call_Statement (Loc,
                     Name                   =>
                       New_Occurrence_Of (RTE (RE), Loc),
                     Parameter_Associations => Actuals);
         end Make_Request_RTE_Call;

         Arguments : Node_Id;
         --  Name of the named values list used to transmit parameters
         --  to the remote package

         Result : Node_Id;
         --  Name of the result named value (in non-APC cases) which get the
         --  result of the remote subprogram.

         Result_TC : Node_Id;
         --  Typecode expression for the result of the request (void
         --  typecode for procedures).

         Exception_Return_Parameter : Node_Id;
         --  Name of the parameter which will hold the exception sent by the
         --  remote subprogram.

         Current_Parameter : Node_Id;
         --  Current parameter being handled

         Ordered_Parameters_List : constant List_Id :=
                                     Build_Ordered_Parameters_List (Spec);

         Asynchronous_P : Node_Id;
         --  A Boolean expression indicating whether this call is asynchronous

         Asynchronous_Statements     : List_Id := No_List;
         Non_Asynchronous_Statements : List_Id := No_List;
         --  Statements specifics to the Asynchronous/Non-Asynchronous cases

         Extra_Formal_Statements : constant List_Id := New_List;
         --  List of statements for extra formal parameters. It will appear
         --  after the regular statements for writing out parameters.

         After_Statements : constant List_Id := New_List;
         --  Statements to be executed after call returns (to assign IN OUT or
         --  OUT parameter values).

         Etyp : Entity_Id;
         --  The type of the formal parameter being processed

         Is_Controlling_Formal         : Boolean;
         Is_First_Controlling_Formal   : Boolean;
         First_Controlling_Formal_Seen : Boolean := False;
         --  Controlling formal parameters of distributed object primitives
         --  require special handling, and the first such parameter needs even
         --  more special handling.

      begin
         --  ??? document general form of stub subprograms for the PolyORB case

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Request,
             Aliased_Present     => False,
             Object_Definition   =>
                 New_Occurrence_Of (RTE (RE_Request_Access), Loc)));

         Result := Make_Temporary (Loc, 'R');

         if Is_Function then
            Result_TC :=
              PolyORB_Support.Helpers.Build_TypeCode_Call
                (Loc, Etype (Result_Definition (Spec)), Decls);
         else
            Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc);
         end if;

         Append_To (Decls,
           Make_Object_Declaration (Loc,
             Defining_Identifier => Result,
             Aliased_Present     => False,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_NamedValue), Loc),
             Expression =>
               Make_Aggregate (Loc,
                 Component_Associations => New_List (
                   Make_Component_Association (Loc,
                     Choices    => New_List (Make_Identifier (Loc, Name_Name)),
                     Expression =>
                       New_Occurrence_Of (RTE (RE_Result_Name), Loc)),
                   Make_Component_Association (Loc,
                     Choices => New_List (
                       Make_Identifier (Loc, Name_Argument)),
                     Expression =>
                       Make_Function_Call (Loc,
                         Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc),
                         Parameter_Associations => New_List (Result_TC))),
                   Make_Component_Association (Loc,
                     Choices    => New_List (
                       Make_Identifier (Loc, Name_Arg_Modes)),
                     Expression => Make_Integer_Literal (Loc, 0))))));

         if not Is_Known_Asynchronous then
            Exception_Return_Parameter := Make_Temporary (Loc, 'E');

            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Exception_Return_Parameter,
                Object_Definition   =>
                  New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc)));

         else
            Exception_Return_Parameter := Empty;
         end if;

         --  Initialize and fill in arguments list

         Arguments := Make_Temporary (Loc, 'A');
         Declare_Create_NVList (Loc, Arguments, Decls, Statements);

         Current_Parameter := First (Ordered_Parameters_List);
         while Present (Current_Parameter) loop
            if Is_RACW_Controlling_Formal (Current_Parameter, Stub_Type) then
               Is_Controlling_Formal := True;
               Is_First_Controlling_Formal :=
                 not First_Controlling_Formal_Seen;
               First_Controlling_Formal_Seen := True;

            else
               Is_Controlling_Formal := False;
               Is_First_Controlling_Formal := False;
            end if;

            if Is_Controlling_Formal then

               --  For a controlling formal argument, we send its reference

               Etyp := RACW_Type;

            else
               Etyp := Etype (Parameter_Type (Current_Parameter));
            end if;

            --  The first controlling formal parameter is treated specially:
            --  it is used to set the target object of the call.

            if not Is_First_Controlling_Formal then
               declare
                  Constrained : constant Boolean :=
                                  Is_Constrained (Etyp)
                                    or else Is_Elementary_Type (Etyp);

                  Any : constant Entity_Id := Make_Temporary (Loc, 'A');

                  Actual_Parameter : Node_Id :=
                                       New_Occurrence_Of (
                                         Defining_Identifier (
                                           Current_Parameter), Loc);

                  Expr : Node_Id;

               begin
                  if Is_Controlling_Formal then

                     --  For a controlling formal parameter (other than the
                     --  first one), use the corresponding RACW. If the
                     --  parameter is not an anonymous access parameter, that
                     --  involves taking its 'Unrestricted_Access.

                     if Nkind (Parameter_Type (Current_Parameter))
                       = N_Access_Definition
                     then
                        Actual_Parameter := OK_Convert_To
                          (Etyp, Actual_Parameter);
                     else
                        Actual_Parameter := OK_Convert_To (Etyp,
                          Make_Attribute_Reference (Loc,
                            Prefix         => Actual_Parameter,
                            Attribute_Name => Name_Unrestricted_Access));
                     end if;

                  end if;

                  if In_Present (Current_Parameter)
                    or else not Out_Present (Current_Parameter)
                    or else not Constrained
                    or else Is_Controlling_Formal
                  then
                     --  The parameter has an input value, is constrained at
                     --  runtime by an input value, or is a controlling formal
                     --  parameter (always passed as a reference) other than
                     --  the first one.

                     Expr := PolyORB_Support.Helpers.Build_To_Any_Call
                               (Actual_Parameter, Decls);

                  else
                     Expr := Make_Function_Call (Loc,
                       Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc),
                       Parameter_Associations => New_List (
                         PolyORB_Support.Helpers.Build_TypeCode_Call
                           (Loc, Etyp, Decls)));
                  end if;

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Any,
                      Aliased_Present     => False,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_Any), Loc),
                      Expression          => Expr));

                  Append_To (Statements,
                    Add_Parameter_To_NVList (Loc,
                      Parameter   => Current_Parameter,
                      NVList      => Arguments,
                      Constrained => Constrained,
                      Any         => Any));

                  if Out_Present (Current_Parameter)
                    and then not Is_Controlling_Formal
                  then
                     if Is_Limited_Type (Etyp) then
                        Helpers.Assign_Opaque_From_Any (Loc,
                           Stms   => After_Statements,
                           Typ    => Etyp,
                           N      => New_Occurrence_Of (Any, Loc),
                           Target =>
                             Defining_Identifier (Current_Parameter));
                     else
                        Append_To (After_Statements,
                          Make_Assignment_Statement (Loc,
                            Name =>
                              New_Occurrence_Of (
                                Defining_Identifier (Current_Parameter), Loc),
                              Expression =>
                                PolyORB_Support.Helpers.Build_From_Any_Call
                                  (Etyp,
                                   New_Occurrence_Of (Any, Loc),
                                   Decls)));
                     end if;
                  end if;
               end;
            end if;

            --  If the current parameter has a dynamic constrained status, then
            --  this status is transmitted as well.
            --  This should be done for accessibility as well ???

            if Nkind (Parameter_Type (Current_Parameter)) /=
                                                    N_Access_Definition
              and then Need_Extra_Constrained (Current_Parameter)
            then
               --  In this block, we do not use the extra formal that has been
               --  created because it does not exist at the time of expansion
               --  when building calling stubs for remote access to subprogram
               --  types. We create an extra variable of this type and push it
               --  in the stream after the regular parameters.

               declare
                  Extra_Any_Parameter : constant Entity_Id :=
                                          Make_Temporary (Loc, 'P');

                  Parameter_Exp : constant Node_Id :=
                     Make_Attribute_Reference (Loc,
                       Prefix         => New_Occurrence_Of (
                         Defining_Identifier (Current_Parameter), Loc),
                       Attribute_Name => Name_Constrained);

               begin
                  Set_Etype (Parameter_Exp, Etype (Standard_Boolean));

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Extra_Any_Parameter,
                      Aliased_Present     => False,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_Any), Loc),
                      Expression          =>
                        PolyORB_Support.Helpers.Build_To_Any_Call
                          (Parameter_Exp, Decls)));

                  Append_To (Extra_Formal_Statements,
                    Add_Parameter_To_NVList (Loc,
                      Parameter   => Extra_Any_Parameter,
                      NVList      => Arguments,
                      Constrained => True,
                      Any         => Extra_Any_Parameter));
               end;
            end if;

            Next (Current_Parameter);
         end loop;

         --  Append the formal statements list to the statements

         Append_List_To (Statements, Extra_Formal_Statements);

         Append_To (Statements,
           Make_Request_RTE_Call (RE_Request_Create, New_List (
                                    Target_Object,
                                    Subprogram_Id,
                                    New_Occurrence_Of (Arguments, Loc),
                                    New_Occurrence_Of (Result, Loc),
                                    New_Occurrence_Of
                                      (RTE (RE_Nil_Exc_List), Loc))));

         pragma Assert
           (not (Is_Known_Non_Asynchronous and Is_Known_Asynchronous));

         if Is_Known_Non_Asynchronous or Is_Known_Asynchronous then
            Asynchronous_P :=
              New_Occurrence_Of
                (Boolean_Literals (Is_Known_Asynchronous), Loc);

         else
            pragma Assert (Present (Asynchronous));
            Asynchronous_P := New_Copy_Tree (Asynchronous);

            --  The expression node Asynchronous will be used to build an 'if'
            --  statement at the end of Build_General_Calling_Stubs: we need to
            --  make a copy here.
         end if;

         Append_To (Parameter_Associations (Last (Statements)),
           Make_Indexed_Component (Loc,
             Prefix =>
               New_Occurrence_Of (
                 RTE (RE_Asynchronous_P_To_Sync_Scope), Loc),
             Expressions => New_List (Asynchronous_P)));

         Append_To (Statements, Make_Request_RTE_Call (RE_Request_Invoke));

         --  Asynchronous case

         if not Is_Known_Non_Asynchronous then
            Asynchronous_Statements :=
              New_List (Make_Request_RTE_Call (RE_Request_Destroy));
         end if;

         --  Non-asynchronous case

         if not Is_Known_Asynchronous then
            --  Reraise an exception occurrence from the completed request.
            --  If the exception occurrence is empty, this is a no-op.

            Non_Asynchronous_Statements := New_List (
              Make_Procedure_Call_Statement (Loc,
                Name                   =>
                  New_Occurrence_Of (RTE (RE_Request_Raise_Occurrence), Loc),
                Parameter_Associations => New_List (
                  New_Occurrence_Of (Request, Loc))));

            if Is_Function then

               Append_To (Non_Asynchronous_Statements,
                 Make_Request_RTE_Call (RE_Request_Destroy));

               --  If this is a function call, read the value and return it

               Append_To (Non_Asynchronous_Statements,
                 Make_Tag_Check (Loc,
                   Make_Simple_Return_Statement (Loc,
                     PolyORB_Support.Helpers.Build_From_Any_Call
                       (Etype (Result_Definition (Spec)),
                        Make_Selected_Component (Loc,
                          Prefix        => Result,
                          Selector_Name => Name_Argument),
                        Decls))));

            else

               --  Case of a procedure: deal with IN OUT and OUT formals

               Append_List_To (Non_Asynchronous_Statements, After_Statements);

               Append_To (Non_Asynchronous_Statements,
                 Make_Request_RTE_Call (RE_Request_Destroy));
            end if;
         end if;

         if Is_Known_Asynchronous then
            Append_List_To (Statements, Asynchronous_Statements);

         elsif Is_Known_Non_Asynchronous then
            Append_List_To (Statements, Non_Asynchronous_Statements);

         else
            pragma Assert (Present (Asynchronous));
            Append_To (Statements,
              Make_Implicit_If_Statement (Nod,
                Condition       => Asynchronous,
                Then_Statements => Asynchronous_Statements,
                Else_Statements => Non_Asynchronous_Statements));
         end if;
      end Build_General_Calling_Stubs;

      -----------------------
      -- Build_Stub_Target --
      -----------------------

      function Build_Stub_Target
        (Loc                   : Source_Ptr;
         Decls                 : List_Id;
         RCI_Locator           : Entity_Id;
         Controlling_Parameter : Entity_Id) return RPC_Target
      is
         Target_Info : RPC_Target (PCS_Kind => Name_PolyORB_DSA);
         Target_Reference : constant Entity_Id := Make_Temporary (Loc, 'T');

      begin
         if Present (Controlling_Parameter) then
            Append_To (Decls,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Target_Reference,

                Object_Definition   =>
                  New_Occurrence_Of (RTE (RE_Object_Ref), Loc),

                Expression          =>
                  Make_Function_Call (Loc,
                    Name =>
                      New_Occurrence_Of (RTE (RE_Make_Ref), Loc),
                    Parameter_Associations => New_List (
                      Make_Selected_Component (Loc,
                        Prefix        => Controlling_Parameter,
                        Selector_Name => Name_Target)))));

            --  Note: Controlling_Parameter has the same components as
            --  System.Partition_Interface.RACW_Stub_Type.

            Target_Info.Object := New_Occurrence_Of (Target_Reference, Loc);

         else
            Target_Info.Object :=
              Make_Selected_Component (Loc,
                Prefix        => Make_Identifier (Loc, Chars (RCI_Locator)),
                Selector_Name =>
                  Make_Identifier (Loc, Name_Get_RCI_Package_Ref));
         end if;

         return Target_Info;
      end Build_Stub_Target;

      ---------------------
      -- Build_Stub_Type --
      ---------------------

      procedure Build_Stub_Type
        (RACW_Type         : Entity_Id;
         Stub_Type_Comps   : out List_Id;
         RPC_Receiver_Decl : out Node_Id)
      is
         Loc : constant Source_Ptr := Sloc (RACW_Type);

      begin
         Stub_Type_Comps := New_List (
           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_Target),
             Component_Definition =>
               Make_Component_Definition (Loc,
                 Aliased_Present     => False,
                 Subtype_Indication  =>
                   New_Occurrence_Of (RTE (RE_Entity_Ptr), Loc))),

           Make_Component_Declaration (Loc,
             Defining_Identifier =>
               Make_Defining_Identifier (Loc, Name_Asynchronous),

             Component_Definition =>
               Make_Component_Definition (Loc,
                 Aliased_Present    => False,
                 Subtype_Indication =>
                   New_Occurrence_Of (Standard_Boolean, Loc))));

         RPC_Receiver_Decl :=
           Make_Object_Declaration (Loc,
             Defining_Identifier => Make_Temporary (Loc, 'R'),
             Aliased_Present     => True,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Servant), Loc));
      end Build_Stub_Type;

      -----------------------------
      -- Build_RPC_Receiver_Body --
      -----------------------------

      procedure Build_RPC_Receiver_Body
        (RPC_Receiver : Entity_Id;
         Request      : out Entity_Id;
         Subp_Id      : out Entity_Id;
         Subp_Index   : out Entity_Id;
         Stmts        : out List_Id;
         Decl         : out Node_Id)
      is
         Loc : constant Source_Ptr := Sloc (RPC_Receiver);

         RPC_Receiver_Spec  : Node_Id;
         RPC_Receiver_Decls : List_Id;

      begin
         Request := Make_Defining_Identifier (Loc, Name_R);

         RPC_Receiver_Spec :=
           Build_RPC_Receiver_Specification
             (RPC_Receiver      => RPC_Receiver,
              Request_Parameter => Request);

         Subp_Id    := Make_Defining_Identifier (Loc, Name_P);
         Subp_Index := Make_Defining_Identifier (Loc, Name_I);

         RPC_Receiver_Decls := New_List (
           Make_Object_Renaming_Declaration (Loc,
             Defining_Identifier => Subp_Id,
             Subtype_Mark        => New_Occurrence_Of (Standard_String, Loc),
             Name                =>
               Make_Explicit_Dereference (Loc,
                 Prefix =>
                   Make_Selected_Component (Loc,
                     Prefix        => Request,
                     Selector_Name => Name_Operation))),

           Make_Object_Declaration (Loc,
             Defining_Identifier => Subp_Index,
             Object_Definition   =>
               New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
             Expression          =>
               Make_Attribute_Reference (Loc,
                 Prefix         =>
                   New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
                 Attribute_Name => Name_Last)));

         Stmts := New_List;

         Decl :=
           Make_Subprogram_Body (Loc,
             Specification              => RPC_Receiver_Spec,
             Declarations               => RPC_Receiver_Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Stmts));
      end Build_RPC_Receiver_Body;

      --------------------------------------
      -- Build_Subprogram_Receiving_Stubs --
      --------------------------------------

      function Build_Subprogram_Receiving_Stubs
        (Vis_Decl                 : Node_Id;
         Asynchronous             : Boolean;
         Dynamically_Asynchronous : Boolean   := False;
         Stub_Type                : Entity_Id := Empty;
         RACW_Type                : Entity_Id := Empty;
         Parent_Primitive         : Entity_Id := Empty) return Node_Id
      is
         Loc : constant Source_Ptr := Sloc (Vis_Decl);

         Request_Parameter : constant Entity_Id := Make_Temporary (Loc, 'R');
         --  Formal parameter for receiving stubs: a descriptor for an incoming
         --  request.

         Outer_Decls : constant List_Id := New_List;
         --  At the outermost level, an NVList and Any's are declared for all
         --  parameters. The Dynamic_Async flag also needs to be declared there
         --  to be visible from the exception handling code.

         Outer_Statements : constant List_Id := New_List;
         --  Statements that occur prior to the declaration of the actual
         --  parameter variables.

         Outer_Extra_Formal_Statements : constant List_Id := New_List;
         --  Statements concerning extra formal parameters, prior to the
         --  declaration of the actual parameter variables.

         Decls : constant List_Id := New_List;
         --  All the parameters will get declared before calling the real
         --  subprograms. Also the out parameters will be declared. At this
         --  level, parameters may be unconstrained.

         Statements : constant List_Id := New_List;

         After_Statements : constant List_Id := New_List;
         --  Statements to be executed after the subprogram call

         Inner_Decls : List_Id := No_List;
         --  In case of a function, the inner declarations are needed since
         --  the result may be unconstrained.

         Excep_Handlers : List_Id := No_List;

         Parameter_List : constant List_Id := New_List;
         --  List of parameters to be passed to the subprogram

         First_Controlling_Formal_Seen : Boolean := False;

         Current_Parameter : Node_Id;

         Ordered_Parameters_List : constant List_Id :=
                                     Build_Ordered_Parameters_List
                                       (Specification (Vis_Decl));

         Arguments : constant Entity_Id := Make_Temporary (Loc, 'A');
         --  Name of the named values list used to retrieve parameters

         Subp_Spec : Node_Id;
         --  Subprogram specification

         Called_Subprogram : Node_Id;
         --  The subprogram to call

      begin
         if Present (RACW_Type) then
            Called_Subprogram :=
              New_Occurrence_Of (Parent_Primitive, Loc);
         else
            Called_Subprogram :=
              New_Occurrence_Of
                (Defining_Unit_Name (Specification (Vis_Decl)), Loc);
         end if;

         Declare_Create_NVList (Loc, Arguments, Outer_Decls, Outer_Statements);

         --  Loop through every parameter and get its value from the stream. If
         --  the parameter is unconstrained, then the parameter is read using
         --  'Input at the point of declaration.

         Current_Parameter := First (Ordered_Parameters_List);
         while Present (Current_Parameter) loop
            declare
               Etyp        : Entity_Id;
               Constrained : Boolean;
               Any         : Entity_Id          := Empty;
               Object      : constant Entity_Id := Make_Temporary (Loc, 'P');
               Expr        : Node_Id            := Empty;

               Is_Controlling_Formal : constant Boolean :=
                                         Is_RACW_Controlling_Formal
                                           (Current_Parameter, Stub_Type);

               Is_First_Controlling_Formal : Boolean := False;

               Need_Extra_Constrained : Boolean;
               --  True when an extra constrained actual is required

            begin
               if Is_Controlling_Formal then

                  --  Controlling formals in distributed object primitive
                  --  operations are handled specially:

                  --    - the first controlling formal is used as the
                  --      target of the call;

                  --    - the remaining controlling formals are transmitted
                  --      as RACWs.

                  Etyp := RACW_Type;
                  Is_First_Controlling_Formal :=
                    not First_Controlling_Formal_Seen;
                  First_Controlling_Formal_Seen := True;

               else
                  Etyp := Etype (Parameter_Type (Current_Parameter));
               end if;

               Constrained :=
                 Is_Constrained (Etyp) or else Is_Elementary_Type (Etyp);

               if not Is_First_Controlling_Formal then
                  Any := Make_Temporary (Loc, 'A');

                  Append_To (Outer_Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Any,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_Any), Loc),
                      Expression =>
                        Make_Function_Call (Loc,
                          Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc),
                          Parameter_Associations => New_List (
                            PolyORB_Support.Helpers.Build_TypeCode_Call
                              (Loc, Etyp, Outer_Decls)))));

                  Append_To (Outer_Statements,
                    Add_Parameter_To_NVList (Loc,
                      Parameter   => Current_Parameter,
                      NVList      => Arguments,
                      Constrained => Constrained,
                      Any         => Any));
               end if;

               if Is_First_Controlling_Formal then
                  declare
                     Addr : constant Entity_Id := Make_Temporary (Loc, 'A');

                     Is_Local : constant Entity_Id :=
                                  Make_Temporary (Loc, 'L');

                  begin
                     --  Special case: obtain the first controlling formal
                     --  from the target of the remote call, instead of the
                     --  argument list.

                     Append_To (Outer_Decls,
                       Make_Object_Declaration (Loc,
                         Defining_Identifier => Addr,
                         Object_Definition =>
                           New_Occurrence_Of (RTE (RE_Address), Loc)));

                     Append_To (Outer_Decls,
                       Make_Object_Declaration (Loc,
                         Defining_Identifier => Is_Local,
                         Object_Definition =>
                           New_Occurrence_Of (Standard_Boolean, Loc)));

                     Append_To (Outer_Statements,
                       Make_Procedure_Call_Statement (Loc,
                         Name =>
                           New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
                         Parameter_Associations => New_List (
                           Make_Selected_Component (Loc,
                             Prefix =>
                               New_Occurrence_Of (
                                 Request_Parameter, Loc),
                             Selector_Name =>
                               Make_Identifier (Loc, Name_Target)),
                           New_Occurrence_Of (Is_Local, Loc),
                           New_Occurrence_Of (Addr, Loc))));

                     Expr := Unchecked_Convert_To (RACW_Type,
                       New_Occurrence_Of (Addr, Loc));
                  end;

               elsif In_Present (Current_Parameter)
                  or else not Out_Present (Current_Parameter)
                  or else not Constrained
               then
                  --  If an input parameter is constrained, then its reading is
                  --  deferred until the beginning of the subprogram body. If
                  --  it is unconstrained, then an expression is built for
                  --  the object declaration and the variable is set using
                  --  'Input instead of 'Read.

                  if Constrained and then Is_Limited_Type (Etyp) then
                     Helpers.Assign_Opaque_From_Any (Loc,
                        Stms   => Statements,
                        Typ    => Etyp,
                        N      => New_Occurrence_Of (Any, Loc),
                        Target => Object);

                  else
                     Expr := Helpers.Build_From_Any_Call
                               (Etyp, New_Occurrence_Of (Any, Loc), Decls);

                     if Constrained then
                        Append_To (Statements,
                          Make_Assignment_Statement (Loc,
                            Name       => New_Occurrence_Of (Object, Loc),
                            Expression => Expr));
                        Expr := Empty;

                     else
                        --  Expr will be used to initialize (and constrain) the
                        --  parameter when it is declared.
                        null;
                     end if;

                     null;
                  end if;
               end if;

               Need_Extra_Constrained :=
                 Nkind (Parameter_Type (Current_Parameter)) /=
                                                         N_Access_Definition
                   and then
                     Ekind (Defining_Identifier (Current_Parameter)) /= E_Void
                   and then
                     Present (Extra_Constrained
                       (Defining_Identifier (Current_Parameter)));

               --  We may not associate an extra constrained actual to a
               --  constant object, so if one is needed, declare the actual
               --  as a variable even if it won't be modified.

               Build_Actual_Object_Declaration
                 (Object   => Object,
                  Etyp     => Etyp,
                  Variable => Need_Extra_Constrained
                                or else Out_Present (Current_Parameter),
                  Expr     => Expr,
                  Decls    => Decls);
               Set_Etype (Object, Etyp);

               --  An out parameter may be written back using a 'Write
               --  attribute instead of a 'Output because it has been
               --  constrained by the parameter given to the caller. Note that
               --  out controlling arguments in the case of a RACW are not put
               --  back in the stream because the pointer on them has not
               --  changed.

               if Out_Present (Current_Parameter)
                 and then not Is_Controlling_Formal
               then
                  Append_To (After_Statements,
                    Make_Procedure_Call_Statement (Loc,
                      Name => New_Occurrence_Of (RTE (RE_Move_Any_Value), Loc),
                      Parameter_Associations => New_List (
                        New_Occurrence_Of (Any, Loc),
                        PolyORB_Support.Helpers.Build_To_Any_Call
                          (New_Occurrence_Of (Object, Loc), Decls))));
               end if;

               --  For RACW controlling formals, the Etyp of Object is always
               --  an RACW, even if the parameter is not of an anonymous access
               --  type. In such case, we need to dereference it at call time.

               if Is_Controlling_Formal then
                  if Nkind (Parameter_Type (Current_Parameter)) /=
                                                        N_Access_Definition
                  then
                     Append_To (Parameter_List,
                       Make_Parameter_Association (Loc,
                         Selector_Name             =>
                           New_Occurrence_Of
                             (Defining_Identifier (Current_Parameter), Loc),
                         Explicit_Actual_Parameter =>
                           Make_Explicit_Dereference (Loc,
                             Prefix => New_Occurrence_Of (Object, Loc))));

                  else
                     Append_To (Parameter_List,
                       Make_Parameter_Association (Loc,
                         Selector_Name             =>
                           New_Occurrence_Of
                             (Defining_Identifier (Current_Parameter), Loc),

                         Explicit_Actual_Parameter =>
                           New_Occurrence_Of (Object, Loc)));
                  end if;

               else
                  Append_To (Parameter_List,
                    Make_Parameter_Association (Loc,
                      Selector_Name             =>
                        New_Occurrence_Of (
                          Defining_Identifier (Current_Parameter), Loc),
                      Explicit_Actual_Parameter =>
                        New_Occurrence_Of (Object, Loc)));
               end if;

               --  If the current parameter needs an extra formal, then read it
               --  from the stream and set the corresponding semantic field in
               --  the variable. If the kind of the parameter identifier is
               --  E_Void, then this is a compiler generated parameter that
               --  doesn't need an extra constrained status.

               --  The case of Extra_Accessibility should also be handled ???

               if Need_Extra_Constrained then
                  declare
                     Extra_Parameter : constant Entity_Id :=
                                         Extra_Constrained
                                           (Defining_Identifier
                                             (Current_Parameter));

                     Extra_Any : constant Entity_Id :=
                                   Make_Temporary (Loc, 'A');

                     Formal_Entity : constant Entity_Id :=
                                       Make_Defining_Identifier (Loc,
                                         Chars => Chars (Extra_Parameter));

                     Formal_Type : constant Entity_Id :=
                                     Etype (Extra_Parameter);

                  begin
                     Append_To (Outer_Decls,
                       Make_Object_Declaration (Loc,
                         Defining_Identifier => Extra_Any,
                         Object_Definition   =>
                           New_Occurrence_Of (RTE (RE_Any), Loc),
                         Expression =>
                           Make_Function_Call (Loc,
                             Name =>
                               New_Occurrence_Of (RTE (RE_Create_Any), Loc),
                             Parameter_Associations => New_List (
                               PolyORB_Support.Helpers.Build_TypeCode_Call
                                 (Loc, Formal_Type, Outer_Decls)))));

                     Append_To (Outer_Extra_Formal_Statements,
                       Add_Parameter_To_NVList (Loc,
                         Parameter   => Extra_Parameter,
                         NVList      => Arguments,
                         Constrained => True,
                         Any         => Extra_Any));

                     Append_To (Decls,
                       Make_Object_Declaration (Loc,
                         Defining_Identifier => Formal_Entity,
                         Object_Definition   =>
                           New_Occurrence_Of (Formal_Type, Loc)));

                     Append_To (Statements,
                       Make_Assignment_Statement (Loc,
                         Name => New_Occurrence_Of (Formal_Entity, Loc),
                         Expression =>
                           PolyORB_Support.Helpers.Build_From_Any_Call
                             (Formal_Type,
                              New_Occurrence_Of (Extra_Any, Loc),
                              Decls)));
                     Set_Extra_Constrained (Object, Formal_Entity);
                  end;
               end if;
            end;

            Next (Current_Parameter);
         end loop;

         --  Extra Formals should go after all the other parameters

         Append_List_To (Outer_Statements, Outer_Extra_Formal_Statements);

         Append_To (Outer_Statements,
           Make_Procedure_Call_Statement (Loc,
             Name => New_Occurrence_Of (RTE (RE_Request_Arguments), Loc),
             Parameter_Associations => New_List (
               New_Occurrence_Of (Request_Parameter, Loc),
               New_Occurrence_Of (Arguments, Loc))));

         if Nkind (Specification (Vis_Decl)) = N_Function_Specification then

            --  The remote subprogram is a function: Build an inner block to be
            --  able to hold a potentially unconstrained result in a variable.

            declare
               Etyp   : constant Entity_Id :=
                          Etype (Result_Definition (Specification (Vis_Decl)));
               Result : constant Node_Id   := Make_Temporary (Loc, 'R');

            begin
               Inner_Decls := New_List (
                 Make_Object_Declaration (Loc,
                   Defining_Identifier => Result,
                   Constant_Present    => True,
                   Object_Definition   => New_Occurrence_Of (Etyp, Loc),
                   Expression          =>
                     Make_Function_Call (Loc,
                       Name                   => Called_Subprogram,
                       Parameter_Associations => Parameter_List)));

               if Is_Class_Wide_Type (Etyp) then

                  --  For a remote call to a function with a class-wide type,
                  --  check that the returned value satisfies the requirements
                  --  of (RM E.4(18)).

                  Append_To (Inner_Decls,
                    Make_Transportable_Check (Loc,
                      New_Occurrence_Of (Result, Loc)));

               end if;

               Set_Etype (Result, Etyp);
               Append_To (After_Statements,
                 Make_Procedure_Call_Statement (Loc,
                   Name => New_Occurrence_Of (RTE (RE_Set_Result), Loc),
                   Parameter_Associations => New_List (
                     New_Occurrence_Of (Request_Parameter, Loc),
                     PolyORB_Support.Helpers.Build_To_Any_Call
                       (New_Occurrence_Of (Result, Loc), Decls))));

               --  A DSA function does not have out or inout arguments
            end;

            Append_To (Statements,
              Make_Block_Statement (Loc,
                Declarations               => Inner_Decls,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc,
                    Statements => After_Statements)));

         else
            --  The remote subprogram is a procedure. We do not need any inner
            --  block in this case. No specific processing is required here for
            --  the dynamically asynchronous case: the indication of whether
            --  call is asynchronous or not is managed by the Sync_Scope
            --  attibute of the request, and is handled entirely in the
            --  protocol layer.

            Append_To (After_Statements,
              Make_Procedure_Call_Statement (Loc,
                Name => New_Occurrence_Of (RTE (RE_Request_Set_Out), Loc),
                Parameter_Associations => New_List (
                  New_Occurrence_Of (Request_Parameter, Loc))));

            Append_To (Statements,
              Make_Procedure_Call_Statement (Loc,
                Name                   => Called_Subprogram,
                Parameter_Associations => Parameter_List));

            Append_List_To (Statements, After_Statements);
         end if;

         Subp_Spec :=
           Make_Procedure_Specification (Loc,
             Defining_Unit_Name       => Make_Temporary (Loc, 'F'),

             Parameter_Specifications => New_List (
               Make_Parameter_Specification (Loc,
                 Defining_Identifier => Request_Parameter,
                 Parameter_Type      =>
                   New_Occurrence_Of (RTE (RE_Request_Access), Loc))));

         --  An exception raised during the execution of an incoming remote
         --  subprogram call and that needs to be sent back to the caller is
         --  propagated by the receiving stubs, and will be handled by the
         --  caller (the distribution runtime).

         if Asynchronous and then not Dynamically_Asynchronous then

            --  For an asynchronous procedure, add a null exception handler

            Excep_Handlers := New_List (
              Make_Implicit_Exception_Handler (Loc,
                Exception_Choices => New_List (Make_Others_Choice (Loc)),
                Statements        => New_List (Make_Null_Statement (Loc))));

         else
            --  In the other cases, if an exception is raised, then the
            --  exception occurrence is propagated.

            null;
         end if;

         Append_To (Outer_Statements,
           Make_Block_Statement (Loc,
             Declarations => Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => Statements)));

         return
           Make_Subprogram_Body (Loc,
             Specification              => Subp_Spec,
             Declarations               => Outer_Decls,
             Handled_Statement_Sequence =>
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements         => Outer_Statements,
                 Exception_Handlers => Excep_Handlers));
      end Build_Subprogram_Receiving_Stubs;

      -------------
      -- Helpers --
      -------------

      package body Helpers is

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

         function Find_Numeric_Representation
           (Typ : Entity_Id) return Entity_Id;
         --  Given a numeric type Typ, return the smallest integer or floating
         --  point type from Standard, or the smallest unsigned (modular) type
         --  from System.Unsigned_Types, whose range encompasses that of Typ.

         function Make_Helper_Function_Name
           (Loc : Source_Ptr;
            Typ : Entity_Id;
            Nam : Name_Id) return Entity_Id;
         --  Return the name to be assigned for helper subprogram Nam of Typ

         ------------------------------------------------------------
         -- Common subprograms for building various tree fragments --
         ------------------------------------------------------------

         function Build_Get_Aggregate_Element
           (Loc : Source_Ptr;
            Any : Entity_Id;
            TC  : Node_Id;
            Idx : Node_Id) return Node_Id;
         --  Build a call to Get_Aggregate_Element on Any for typecode TC,
         --  returning the Idx'th element.

         generic
            Subprogram : Entity_Id;
            --  Reference location for constructed nodes

            Arry : Entity_Id;
            --  For 'Range and Etype

            Indices : List_Id;
            --  For the construction of the innermost element expression

            with procedure Add_Process_Element
              (Stmts   : List_Id;
               Any     : Entity_Id;
               Counter : Entity_Id;
               Datum   : Node_Id);

         procedure Append_Array_Traversal
           (Stmts   : List_Id;
            Any     : Entity_Id;
            Counter : Entity_Id := Empty;
            Depth   : Pos       := 1);
         --  Build nested loop statements that iterate over the elements of an
         --  array Arry. The statement(s) built by Add_Process_Element are
         --  executed for each element; Indices is the list of indices to be
         --  used in the construction of the indexed component that denotes the
         --  current element. Subprogram is the entity for the subprogram for
         --  which this iterator is generated. The generated statements are
         --  appended to Stmts.

         generic
            Rec : Entity_Id;
            --  The record entity being dealt with

            with procedure Add_Process_Element
              (Stmts     : List_Id;
               Container : Node_Or_Entity_Id;
               Counter   : in out Int;
               Rec       : Entity_Id;
               Field     : Node_Id);
            --  Rec is the instance of the record type, or Empty.
            --  Field is either the N_Defining_Identifier for a component,
            --  or an N_Variant_Part.

         procedure Append_Record_Traversal
           (Stmts     : List_Id;
            Clist     : Node_Id;
            Container : Node_Or_Entity_Id;
            Counter   : in out Int);
         --  Process component list Clist. Individual fields are passed
         --  to Field_Processing. Each variant part is also processed.
         --  Container is the outer Any (for From_Any/To_Any),
         --  the outer typecode (for TC) to which the operation applies.

         -----------------------------
         -- Append_Record_Traversal --
         -----------------------------

         procedure Append_Record_Traversal
           (Stmts     : List_Id;
            Clist     : Node_Id;
            Container : Node_Or_Entity_Id;
            Counter   : in out Int)
         is
            CI : List_Id;
            VP : Node_Id;
            --  Clist's Component_Items and Variant_Part

            Item : Node_Id;
            Def  : Entity_Id;

         begin
            if No (Clist) then
               return;
            end if;

            CI := Component_Items (Clist);
            VP := Variant_Part (Clist);

            Item := First (CI);
            while Present (Item) loop
               Def := Defining_Identifier (Item);

               if not Is_Internal_Name (Chars (Def)) then
                  Add_Process_Element
                    (Stmts, Container, Counter, Rec, Def);
               end if;

               Next (Item);
            end loop;

            if Present (VP) then
               Add_Process_Element (Stmts, Container, Counter, Rec, VP);
            end if;
         end Append_Record_Traversal;

         -----------------------------
         -- Assign_Opaque_From_Any --
         -----------------------------

         procedure Assign_Opaque_From_Any
           (Loc    : Source_Ptr;
            Stms   : List_Id;
            Typ    : Entity_Id;
            N      : Node_Id;
            Target : Entity_Id)
         is
            Strm : constant Entity_Id := Make_Temporary (Loc, 'S');
            Expr : Node_Id;

            Read_Call_List : List_Id;
            --  List on which to place the 'Read attribute reference

         begin
            --  Strm : Buffer_Stream_Type;

            Append_To (Stms,
              Make_Object_Declaration (Loc,
                Defining_Identifier => Strm,
                Aliased_Present     => True,
                Object_Definition   =>
                  New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));

            --  Any_To_BS (Strm, A);

            Append_To (Stms,
              Make_Procedure_Call_Statement (Loc,
                Name => New_Occurrence_Of (RTE (RE_Any_To_BS), Loc),
                Parameter_Associations => New_List (
                  N,
                  New_Occurrence_Of (Strm, Loc))));

            if Transmit_As_Unconstrained (Typ) then
               Expr :=
                 Make_Attribute_Reference (Loc,
                   Prefix         => New_Occurrence_Of (Typ, Loc),
                   Attribute_Name => Name_Input,
                   Expressions    => New_List (
                     Make_Attribute_Reference (Loc,
                       Prefix         => New_Occurrence_Of (Strm, Loc),
                       Attribute_Name => Name_Access)));

               --  Target := Typ'Input (Strm'Access)

               if Present (Target) then
                  Append_To (Stms,
                    Make_Assignment_Statement (Loc,
                      Name       => New_Occurrence_Of (Target, Loc),
                      Expression => Expr));

               --  return Typ'Input (Strm'Access);

               else
                  Append_To (Stms,
                    Make_Simple_Return_Statement (Loc,
                      Expression => Expr));
               end if;

            else
               if Present (Target) then
                  Read_Call_List := Stms;
                  Expr := New_Occurrence_Of (Target, Loc);

               else
                  declare
                     Temp : constant Entity_Id := Make_Temporary (Loc, 'R');

                  begin
                     Read_Call_List := New_List;
                     Expr := New_Occurrence_Of (Temp, Loc);

                     Append_To (Stms, Make_Block_Statement (Loc,
                       Declarations               => New_List (
                         Make_Object_Declaration (Loc,
                           Defining_Identifier =>
                             Temp,
                           Object_Definition   =>
                             New_Occurrence_Of (Typ, Loc))),

                       Handled_Statement_Sequence =>
                         Make_Handled_Sequence_Of_Statements (Loc,
                           Statements => Read_Call_List)));
                  end;
               end if;

               --  Typ'Read (Strm'Access, [Target|Temp])

               Append_To (Read_Call_List,
                 Make_Attribute_Reference (Loc,
                   Prefix         => New_Occurrence_Of (Typ, Loc),
                   Attribute_Name => Name_Read,
                   Expressions    => New_List (
                     Make_Attribute_Reference (Loc,
                       Prefix         => New_Occurrence_Of (Strm, Loc),
                       Attribute_Name => Name_Access),
                     Expr)));

               if No (Target) then

                  --  return Temp

                  Append_To (Read_Call_List,
                    Make_Simple_Return_Statement (Loc,
                       Expression => New_Copy (Expr)));
               end if;
            end if;
         end Assign_Opaque_From_Any;

         -------------------------
         -- Build_From_Any_Call --
         -------------------------

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

            U_Type : Entity_Id  := Underlying_Type (Typ);

            Fnam    : Entity_Id := Empty;
            Lib_RE  : RE_Id := RE_Null;
            Result  : Node_Id;

         begin
            --  First simple case where the From_Any function is present
            --  in the type's TSS.

            Fnam := Find_Inherited_TSS (U_Type, TSS_From_Any);

            if Sloc (U_Type) <= Standard_Location then
               U_Type := Base_Type (U_Type);
            end if;

            --  Check first for Boolean and Character. These are enumeration
            --  types, but we treat them specially, since they may require
            --  special handling in the transfer protocol. However, this
            --  special handling only applies if they have standard
            --  representation, otherwise they are treated like any other
            --  enumeration type.

            if Present (Fnam) then
               null;

            elsif U_Type = Standard_Boolean then
               Lib_RE := RE_FA_B;

            elsif U_Type = Standard_Character then
               Lib_RE := RE_FA_C;

            elsif U_Type = Standard_Wide_Character then
               Lib_RE := RE_FA_WC;

            elsif U_Type = Standard_Wide_Wide_Character then
               Lib_RE := RE_FA_WWC;

            --  Floating point types

            elsif U_Type = Standard_Short_Float then
               Lib_RE := RE_FA_SF;

            elsif U_Type = Standard_Float then
               Lib_RE := RE_FA_F;

            elsif U_Type = Standard_Long_Float then
               Lib_RE := RE_FA_LF;

            elsif U_Type = Standard_Long_Long_Float then
               Lib_RE := RE_FA_LLF;

            --  Integer types

            elsif U_Type = Etype (Standard_Short_Short_Integer) then
                  Lib_RE := RE_FA_SSI;

            elsif U_Type = Etype (Standard_Short_Integer) then
               Lib_RE := RE_FA_SI;

            elsif U_Type = Etype (Standard_Integer) then
               Lib_RE := RE_FA_I;

            elsif U_Type = Etype (Standard_Long_Integer) then
               Lib_RE := RE_FA_LI;

            elsif U_Type = Etype (Standard_Long_Long_Integer) then
               Lib_RE := RE_FA_LLI;

            --  Unsigned integer types

            elsif U_Type = RTE (RE_Short_Short_Unsigned) then
               Lib_RE := RE_FA_SSU;

            elsif U_Type = RTE (RE_Short_Unsigned) then
               Lib_RE := RE_FA_SU;

            elsif U_Type = RTE (RE_Unsigned) then
               Lib_RE := RE_FA_U;

            elsif U_Type = RTE (RE_Long_Unsigned) then
               Lib_RE := RE_FA_LU;

            elsif U_Type = RTE (RE_Long_Long_Unsigned) then
               Lib_RE := RE_FA_LLU;

            elsif Is_RTE (U_Type, RE_Unbounded_String) then
               Lib_RE := RE_FA_String;

            --  Special DSA types

            elsif Is_RTE (U_Type, RE_Any_Container_Ptr) then
               Lib_RE := RE_FA_A;

            --  Other (non-primitive) types

            else
               declare
                  Decl : Entity_Id;

               begin
                  --  For the subtype representing a generic actual type, go
                  --  to the base type.

                  if Is_Generic_Actual_Type (U_Type) then
                     U_Type := Base_Type (U_Type);
                  end if;

                  Build_From_Any_Function (Loc, U_Type, Decl, Fnam);
                  Append_To (Decls, Decl);
               end;
            end if;

            --  Call the function

            if Lib_RE /= RE_Null then
               pragma Assert (No (Fnam));
               Fnam := RTE (Lib_RE);
            end if;

            Result :=
              Make_Function_Call (Loc,
                Name                   => New_Occurrence_Of (Fnam, Loc),
                Parameter_Associations => New_List (N));

            --  We must set the type of Result, so the unchecked conversion
            --  from the underlying type to the base type is properly done.

            Set_Etype (Result, U_Type);

            return Unchecked_Convert_To (Typ, Result);
         end Build_From_Any_Call;

         -----------------------------
         -- Build_From_Any_Function --
         -----------------------------

         procedure Build_From_Any_Function
           (Loc  : Source_Ptr;
            Typ  : Entity_Id;
            Decl : out Node_Id;
            Fnam : out Entity_Id)
         is
            Spec  : Node_Id;
            Decls : constant List_Id := New_List;
            Stms  : constant List_Id := New_List;

            Any_Parameter : constant Entity_Id := Make_Temporary (Loc, 'A');

            Use_Opaque_Representation : Boolean;

         begin
            --  For a derived type, we can't go past the base type (to the
            --  parent type) here, because that would cause the attribute's
            --  formal parameter to have the wrong type; hence the Base_Type
            --  check here.

            if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then
               Build_From_Any_Function
                  (Loc  => Loc,
                   Typ  => Etype (Typ),
                   Decl => Decl,
                   Fnam => Fnam);
               return;
            end if;

            Fnam := Make_Helper_Function_Name (Loc, Typ, Name_From_Any);

            Spec :=
              Make_Function_Specification (Loc,
                Defining_Unit_Name => Fnam,
                Parameter_Specifications => New_List (
                  Make_Parameter_Specification (Loc,
                    Defining_Identifier => Any_Parameter,
                    Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))),
                Result_Definition => New_Occurrence_Of (Typ, Loc));

            --  The RACW case is taken care of by Exp_Dist.Add_RACW_From_Any

            pragma Assert
              (not (Is_Remote_Access_To_Class_Wide_Type (Typ)));

            Use_Opaque_Representation := False;

            if Has_Stream_Attribute_Definition
                 (Typ, TSS_Stream_Output, At_Any_Place => True)
              or else
               Has_Stream_Attribute_Definition
                 (Typ, TSS_Stream_Write, At_Any_Place => True)
            then
               --  If user-defined stream attributes are specified for this
               --  type, use them and transmit data as an opaque sequence of
               --  stream elements.

               Use_Opaque_Representation := True;

            elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then
               Append_To (Stms,
                 Make_Simple_Return_Statement (Loc,
                   Expression =>
                     OK_Convert_To (Typ,
                       Build_From_Any_Call
                         (Root_Type (Typ),
                          New_Occurrence_Of (Any_Parameter, Loc),
                          Decls))));

            elsif Is_Record_Type (Typ)
              and then not Is_Derived_Type (Typ)
              and then not Is_Tagged_Type (Typ)
            then
               if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
                  Append_To (Stms,
                    Make_Simple_Return_Statement (Loc,
                      Expression =>
                        Build_From_Any_Call
                          (Etype (Typ),
                           New_Occurrence_Of (Any_Parameter, Loc),
                           Decls)));

               else
                  declare
                     Disc                      : Entity_Id := Empty;
                     Discriminant_Associations : List_Id;
                     Rdef                      : constant Node_Id :=
                                                   Type_Definition
                                                     (Declaration_Node (Typ));
                     Component_Counter         : Int := 0;

                     --  The returned object

                     Res : constant Entity_Id := Make_Temporary (Loc, 'R');

                     Res_Definition : Node_Id := New_Occurrence_Of (Typ, Loc);

                     procedure FA_Rec_Add_Process_Element
                       (Stmts   : List_Id;
                        Any     : Entity_Id;
                        Counter : in out Int;
                        Rec     : Entity_Id;
                        Field   : Node_Id);

                     procedure FA_Append_Record_Traversal is
                        new Append_Record_Traversal
                          (Rec                 => Res,
                           Add_Process_Element => FA_Rec_Add_Process_Element);

                     --------------------------------
                     -- FA_Rec_Add_Process_Element --
                     --------------------------------

                     procedure FA_Rec_Add_Process_Element
                       (Stmts   : List_Id;
                        Any     : Entity_Id;
                        Counter : in out Int;
                        Rec     : Entity_Id;
                        Field   : Node_Id)
                     is
                        Ctyp : Entity_Id;
                     begin
                        if Nkind (Field) = N_Defining_Identifier then
                           --  A regular component

                           Ctyp := Etype (Field);

                           Append_To (Stmts,
                             Make_Assignment_Statement (Loc,
                               Name => Make_Selected_Component (Loc,
                                 Prefix        =>
                                   New_Occurrence_Of (Rec, Loc),
                                 Selector_Name =>
                                   New_Occurrence_Of (Field, Loc)),

                               Expression =>
                                 Build_From_Any_Call (Ctyp,
                                   Build_Get_Aggregate_Element (Loc,
                                     Any => Any,
                                     TC  =>
                                       Build_TypeCode_Call (Loc, Ctyp, Decls),
                                     Idx =>
                                       Make_Integer_Literal (Loc, Counter)),
                                   Decls)));

                        else
                           --  A variant part

                           declare
                              Variant        : Node_Id;
                              Struct_Counter : Int := 0;

                              Block_Decls : constant List_Id := New_List;
                              Block_Stmts : constant List_Id := New_List;
                              VP_Stmts    : List_Id;

                              Alt_List    : constant List_Id := New_List;
                              Choice_List : List_Id;

                              Struct_Any : constant Entity_Id :=
                                             Make_Temporary (Loc, 'S');

                           begin
                              Append_To (Decls,
                                Make_Object_Declaration (Loc,
                                  Defining_Identifier => Struct_Any,
                                  Constant_Present    => True,
                                  Object_Definition   =>
                                     New_Occurrence_Of (RTE (RE_Any), Loc),
                                  Expression          =>
                                    Make_Function_Call (Loc,
                                      Name =>
                                        New_Occurrence_Of
                                          (RTE (RE_Extract_Union_Value), Loc),

                                      Parameter_Associations => New_List (
                                        Build_Get_Aggregate_Element (Loc,
                                          Any => Any,
                                          TC  =>
                                            Make_Function_Call (Loc,
                                              Name => New_Occurrence_Of (
                                                RTE (RE_Any_Member_Type), Loc),
                                              Parameter_Associations =>
                                                New_List (
                                                  New_Occurrence_Of (Any, Loc),
                                                  Make_Integer_Literal (Loc,
                                                    Intval => Counter))),
                                          Idx =>
                                            Make_Integer_Literal (Loc,
                                             Intval => Counter))))));

                              Append_To (Stmts,
                                Make_Block_Statement (Loc,
                                  Declarations => Block_Decls,
                                  Handled_Statement_Sequence =>
                                    Make_Handled_Sequence_Of_Statements (Loc,
                                      Statements => Block_Stmts)));

                              Append_To (Block_Stmts,
                                Make_Case_Statement (Loc,
                                    Expression =>
                                      Make_Selected_Component (Loc,
                                        Prefix        => Rec,
                                        Selector_Name => Chars (Name (Field))),
                                    Alternatives => Alt_List));

                              Variant := First_Non_Pragma (Variants (Field));
                              while Present (Variant) loop
                                 Choice_List :=
                                   New_Copy_List_Tree
                                     (Discrete_Choices (Variant));

                                 VP_Stmts := New_List;

                                 --  Struct_Counter should be reset before
                                 --  handling a variant part. Indeed only one
                                 --  of the case statement alternatives will be
                                 --  executed at run-time, so the counter must
                                 --  start at 0 for every case statement.

                                 Struct_Counter := 0;

                                 FA_Append_Record_Traversal (
                                   Stmts     => VP_Stmts,
                                   Clist     => Component_List (Variant),
                                   Container => Struct_Any,
                                   Counter   => Struct_Counter);

                                 Append_To (Alt_List,
                                   Make_Case_Statement_Alternative (Loc,
                                     Discrete_Choices => Choice_List,
                                     Statements       => VP_Stmts));
                                 Next_Non_Pragma (Variant);
                              end loop;
                           end;
                        end if;

                        Counter := Counter + 1;
                     end FA_Rec_Add_Process_Element;

                  begin
                     --  First all discriminants

                     if Has_Discriminants (Typ) then
                        Discriminant_Associations := New_List;

                        Disc := First_Discriminant (Typ);
                        while Present (Disc) loop
                           declare
                              Disc_Var_Name : constant Entity_Id :=
                                                Make_Defining_Identifier (Loc,
                                                  Chars => Chars (Disc));
                              Disc_Type     : constant Entity_Id :=
                                                Etype (Disc);

                           begin
                              Append_To (Decls,
                                Make_Object_Declaration (Loc,
                                  Defining_Identifier => Disc_Var_Name,
                                  Constant_Present    => True,
                                  Object_Definition   =>
                                    New_Occurrence_Of (Disc_Type, Loc),

                                  Expression =>
                                    Build_From_Any_Call (Disc_Type,
                                      Build_Get_Aggregate_Element (Loc,
                                        Any => Any_Parameter,
                                        TC  => Build_TypeCode_Call
                                                 (Loc, Disc_Type, Decls),
                                        Idx => Make_Integer_Literal (Loc,
                                               Intval => Component_Counter)),
                                      Decls)));

                              Component_Counter := Component_Counter + 1;

                              Append_To (Discriminant_Associations,
                                Make_Discriminant_Association (Loc,
                                  Selector_Names => New_List (
                                    New_Occurrence_Of (Disc, Loc)),
                                  Expression =>
                                    New_Occurrence_Of (Disc_Var_Name, Loc)));
                           end;
                           Next_Discriminant (Disc);
                        end loop;

                        Res_Definition :=
                          Make_Subtype_Indication (Loc,
                            Subtype_Mark => Res_Definition,
                            Constraint   =>
                              Make_Index_Or_Discriminant_Constraint (Loc,
                                Discriminant_Associations));
                     end if;

                     --  Now we have all the discriminants in variables, we can
                     --  declared a constrained object. Note that we are not
                     --  initializing (non-discriminant) components directly in
                     --  the object declarations, because which fields to
                     --  initialize depends (at run time) on the discriminant
                     --  values.

                     Append_To (Decls,
                       Make_Object_Declaration (Loc,
                         Defining_Identifier => Res,
                         Object_Definition   => Res_Definition));

                     --  ... then all components

                     FA_Append_Record_Traversal (Stms,
                       Clist     => Component_List (Rdef),
                       Container => Any_Parameter,
                       Counter   => Component_Counter);

                     Append_To (Stms,
                       Make_Simple_Return_Statement (Loc,
                         Expression => New_Occurrence_Of (Res, Loc)));
                  end;
               end if;

            elsif Is_Array_Type (Typ) then
               declare
                  Constrained : constant Boolean := Is_Constrained (Typ);

                  procedure FA_Ary_Add_Process_Element
                    (Stmts   : List_Id;
                     Any     : Entity_Id;
                     Counter : Entity_Id;
                     Datum   : Node_Id);
                  --  Assign the current element (as identified by Counter) of
                  --  Any to the variable denoted by name Datum, and advance
                  --  Counter by 1. If Datum is not an Any, a call to From_Any
                  --  for its type is inserted.

                  --------------------------------
                  -- FA_Ary_Add_Process_Element --
                  --------------------------------

                  procedure FA_Ary_Add_Process_Element
                    (Stmts   : List_Id;
                     Any     : Entity_Id;
                     Counter : Entity_Id;
                     Datum   : Node_Id)
                  is
                     Assignment : constant Node_Id :=
                       Make_Assignment_Statement (Loc,
                         Name       => Datum,
                         Expression => Empty);

                     Element_Any : Node_Id;

                  begin
                     declare
                        Element_TC : Node_Id;

                     begin
                        if Etype (Datum) = RTE (RE_Any) then

                           --  When Datum is an Any the Etype field is not
                           --  sufficient to determine the typecode of Datum
                           --  (which can be a TC_SEQUENCE or TC_ARRAY
                           --  depending on the value of Constrained).

                           --  Therefore we retrieve the typecode which has
                           --  been constructed in Append_Array_Traversal with
                           --  a call to Get_Any_Type.

                           Element_TC :=
                             Make_Function_Call (Loc,
                               Name => New_Occurrence_Of (
                                 RTE (RE_Get_Any_Type), Loc),
                               Parameter_Associations => New_List (
                                 New_Occurrence_Of (Entity (Datum), Loc)));
                        else
                           --  For non Any Datum we simply construct a typecode
                           --  matching the Etype of the Datum.

                           Element_TC := Build_TypeCode_Call
                              (Loc, Etype (Datum), Decls);
                        end if;

                        Element_Any :=
                          Build_Get_Aggregate_Element (Loc,
                            Any => Any,
                            TC  => Element_TC,
                            Idx => New_Occurrence_Of (Counter, Loc));
                     end;

                     --  Note: here we *prepend* statements to Stmts, so
                     --  we must do it in reverse order.

                     Prepend_To (Stmts,
                       Make_Assignment_Statement (Loc,
                         Name =>
                           New_Occurrence_Of (Counter, Loc),
                         Expression =>
                           Make_Op_Add (Loc,
                             Left_Opnd  => New_Occurrence_Of (Counter, Loc),
                             Right_Opnd => Make_Integer_Literal (Loc, 1))));

                     if Nkind (Datum) /= N_Attribute_Reference then

                        --  We ignore the value of the length of each
                        --  dimension, since the target array has already
                        --  been constrained anyway.

                        if Etype (Datum) /= RTE (RE_Any) then
                           Set_Expression (Assignment,
                              Build_From_Any_Call
                                (Component_Type (Typ), Element_Any, Decls));
                        else
                           Set_Expression (Assignment, Element_Any);
                        end if;

                        Prepend_To (Stmts, Assignment);
                     end if;
                  end FA_Ary_Add_Process_Element;

                  ------------------------
                  -- Local Declarations --
                  ------------------------

                  Counter : constant Entity_Id :=
                              Make_Defining_Identifier (Loc, Name_J);

                  Initial_Counter_Value : Int := 0;

                  Component_TC : constant Entity_Id :=
                                   Make_Defining_Identifier (Loc, Name_T);

                  Res : constant Entity_Id :=
                          Make_Defining_Identifier (Loc, Name_R);

                  procedure Append_From_Any_Array_Iterator is
                    new Append_Array_Traversal (
                      Subprogram => Fnam,
                      Arry       => Res,
                      Indices    => New_List,
                      Add_Process_Element => FA_Ary_Add_Process_Element);

                  Res_Subtype_Indication : Node_Id :=
                                             New_Occurrence_Of (Typ, Loc);

               begin
                  if not Constrained then
                     declare
                        Ndim : constant Int := Number_Dimensions (Typ);
                        Lnam : Name_Id;
                        Hnam : Name_Id;
                        Indx : Node_Id := First_Index (Typ);
                        Indt : Entity_Id;

                        Ranges : constant List_Id := New_List;

                     begin
                        for J in 1 .. Ndim loop
                           Lnam := New_External_Name ('L', J);
                           Hnam := New_External_Name ('H', J);

                           --  Note, for empty arrays bounds may be out of
                           --  the range of Etype (Indx).

                           Indt := Base_Type (Etype (Indx));

                           Append_To (Decls,
                             Make_Object_Declaration (Loc,
                               Defining_Identifier =>
                                 Make_Defining_Identifier (Loc, Lnam),
                               Constant_Present    => True,
                               Object_Definition   =>
                                 New_Occurrence_Of (Indt, Loc),
                               Expression          =>
                                 Build_From_Any_Call
                                   (Indt,
                                    Build_Get_Aggregate_Element (Loc,
                                      Any => Any_Parameter,
                                      TC  => Build_TypeCode_Call
                                               (Loc, Indt, Decls),
                                      Idx =>
                                        Make_Integer_Literal (Loc, J - 1)),
                                   Decls)));

                           Append_To (Decls,
                             Make_Object_Declaration (Loc,
                               Defining_Identifier =>
                                 Make_Defining_Identifier (Loc, Hnam),

                               Constant_Present => True,

                               Object_Definition =>
                                 New_Occurrence_Of (Indt, Loc),

                               Expression => Make_Attribute_Reference (Loc,
                                 Prefix         =>
                                   New_Occurrence_Of (Indt, Loc),

                                 Attribute_Name => Name_Val,

                                 Expressions    => New_List (
                                   Make_Op_Subtract (Loc,
                                     Left_Opnd =>
                                       Make_Op_Add (Loc,
                                         Left_Opnd =>
                                           OK_Convert_To (
                                             Standard_Long_Integer,
                                             Make_Identifier (Loc, Lnam)),

                                         Right_Opnd =>
                                           OK_Convert_To (
                                             Standard_Long_Integer,
                                             Make_Function_Call (Loc,
                                               Name =>
                                                 New_Occurrence_Of (RTE (
                                                 RE_Get_Nested_Sequence_Length
                                                 ), Loc),
                                               Parameter_Associations =>
                                                 New_List (
                                                   New_Occurrence_Of (
                                                     Any_Parameter, Loc),
                                                   Make_Integer_Literal (Loc,
                                                     Intval => J))))),

                                     Right_Opnd =>
                                       Make_Integer_Literal (Loc, 1))))));

                           Append_To (Ranges,
                             Make_Range (Loc,
                               Low_Bound  => Make_Identifier (Loc, Lnam),
                               High_Bound => Make_Identifier (Loc, Hnam)));

                           Next_Index (Indx);
                        end loop;

                        --  Now we have all the necessary bound information:
                        --  apply the set of range constraints to the
                        --  (unconstrained) nominal subtype of Res.

                        Initial_Counter_Value := Ndim;
                        Res_Subtype_Indication := Make_Subtype_Indication (Loc,
                          Subtype_Mark => Res_Subtype_Indication,
                          Constraint   =>
                            Make_Index_Or_Discriminant_Constraint (Loc,
                              Constraints => Ranges));
                     end;
                  end if;

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Res,
                      Object_Definition => Res_Subtype_Indication));
                  Set_Etype (Res, Typ);

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Counter,
                      Object_Definition =>
                        New_Occurrence_Of (RTE (RE_Long_Unsigned), Loc),
                      Expression =>
                        Make_Integer_Literal (Loc, Initial_Counter_Value)));

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Component_TC,
                      Constant_Present    => True,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_TypeCode), Loc),
                      Expression          =>
                        Build_TypeCode_Call (Loc,
                          Component_Type (Typ), Decls)));

                  Append_From_Any_Array_Iterator
                    (Stms, Any_Parameter, Counter);

                  Append_To (Stms,
                    Make_Simple_Return_Statement (Loc,
                      Expression => New_Occurrence_Of (Res, Loc)));
               end;

            elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then
               Append_To (Stms,
                 Make_Simple_Return_Statement (Loc,
                   Expression =>
                     Unchecked_Convert_To (Typ,
                       Build_From_Any_Call
                         (Find_Numeric_Representation (Typ),
                          New_Occurrence_Of (Any_Parameter, Loc),
                          Decls))));

            else
               Use_Opaque_Representation := True;
            end if;

            if Use_Opaque_Representation then
               Assign_Opaque_From_Any (Loc,
                  Stms   => Stms,
                  Typ    => Typ,
                  N      => New_Occurrence_Of (Any_Parameter, Loc),
                  Target => Empty);
            end if;

            Decl :=
              Make_Subprogram_Body (Loc,
                Specification => Spec,
                Declarations => Decls,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc,
                    Statements => Stms));
         end Build_From_Any_Function;

         ---------------------------------
         -- Build_Get_Aggregate_Element --
         ---------------------------------

         function Build_Get_Aggregate_Element
           (Loc : Source_Ptr;
            Any : Entity_Id;
            TC  : Node_Id;
            Idx : Node_Id) return Node_Id
         is
         begin
            return Make_Function_Call (Loc,
              Name =>
                New_Occurrence_Of (RTE (RE_Get_Aggregate_Element), Loc),
              Parameter_Associations => New_List (
                New_Occurrence_Of (Any, Loc),
                TC,
                Idx));
         end Build_Get_Aggregate_Element;

         -------------------------
         -- Build_Reposiroty_Id --
         -------------------------

         procedure Build_Name_And_Repository_Id
           (E           : Entity_Id;
            Name_Str    : out String_Id;
            Repo_Id_Str : out String_Id)
         is
         begin
            Start_String;
            Store_String_Chars ("DSA:");
            Get_Library_Unit_Name_String (Scope (E));
            Store_String_Chars
              (Name_Buffer (Name_Buffer'First ..
               Name_Buffer'First + Name_Len - 1));
            Store_String_Char ('.');
            Get_Name_String (Chars (E));
            Store_String_Chars
              (Name_Buffer (Name_Buffer'First ..
               Name_Buffer'First + Name_Len - 1));
            Store_String_Chars (":1.0");
            Repo_Id_Str := End_String;
            Name_Str    := String_From_Name_Buffer;
         end Build_Name_And_Repository_Id;

         -----------------------
         -- Build_To_Any_Call --
         -----------------------

         function Build_To_Any_Call
           (N     : Node_Id;
            Decls : List_Id) return Node_Id
         is
            Loc : constant Source_Ptr := Sloc (N);

            Typ    : Entity_Id := Etype (N);
            U_Type : Entity_Id;
            C_Type : Entity_Id;
            Fnam   : Entity_Id := Empty;
            Lib_RE : RE_Id := RE_Null;

         begin
            --  If N is a selected component, then maybe its Etype has not been
            --  set yet: try to use Etype of the selector_name in that case.

            if No (Typ) and then Nkind (N) = N_Selected_Component then
               Typ := Etype (Selector_Name (N));
            end if;

            pragma Assert (Present (Typ));

            --  Get full view for private type, completion for incomplete type

            U_Type := Underlying_Type (Typ);

            --  First simple case where the To_Any function is present in the
            --  type's TSS.

            Fnam := Find_Inherited_TSS (U_Type, TSS_To_Any);

            --  Check first for Boolean and Character. These are enumeration
            --  types, but we treat them specially, since they may require
            --  special handling in the transfer protocol. However, this
            --  special handling only applies if they have standard
            --  representation, otherwise they are treated like any other
            --  enumeration type.

            if Sloc (U_Type) <= Standard_Location then
               U_Type := Base_Type (U_Type);
            end if;

            if Present (Fnam) then
               null;

            elsif U_Type = Standard_Boolean then
               Lib_RE := RE_TA_B;

            elsif U_Type = Standard_Character then
               Lib_RE := RE_TA_C;

            elsif U_Type = Standard_Wide_Character then
               Lib_RE := RE_TA_WC;

            elsif U_Type = Standard_Wide_Wide_Character then
               Lib_RE := RE_TA_WWC;

            --  Floating point types

            elsif U_Type = Standard_Short_Float then
               Lib_RE := RE_TA_SF;

            elsif U_Type = Standard_Float then
               Lib_RE := RE_TA_F;

            elsif U_Type = Standard_Long_Float then
               Lib_RE := RE_TA_LF;

            elsif U_Type = Standard_Long_Long_Float then
               Lib_RE := RE_TA_LLF;

            --  Integer types

            elsif U_Type = Etype (Standard_Short_Short_Integer) then
                  Lib_RE := RE_TA_SSI;

            elsif U_Type = Etype (Standard_Short_Integer) then
               Lib_RE := RE_TA_SI;

            elsif U_Type = Etype (Standard_Integer) then
               Lib_RE := RE_TA_I;

            elsif U_Type = Etype (Standard_Long_Integer) then
               Lib_RE := RE_TA_LI;

            elsif U_Type = Etype (Standard_Long_Long_Integer) then
               Lib_RE := RE_TA_LLI;

            --  Unsigned integer types

            elsif U_Type = RTE (RE_Short_Short_Unsigned) then
               Lib_RE := RE_TA_SSU;

            elsif U_Type = RTE (RE_Short_Unsigned) then
               Lib_RE := RE_TA_SU;

            elsif U_Type = RTE (RE_Unsigned) then
               Lib_RE := RE_TA_U;

            elsif U_Type = RTE (RE_Long_Unsigned) then
               Lib_RE := RE_TA_LU;

            elsif U_Type = RTE (RE_Long_Long_Unsigned) then
               Lib_RE := RE_TA_LLU;

            elsif Is_RTE (U_Type, RE_Unbounded_String) then
               Lib_RE := RE_TA_String;

            --  Special DSA types

            elsif Is_RTE (U_Type, RE_Any_Container_Ptr) then
               Lib_RE := RE_TA_A;
               U_Type := Typ;

            elsif U_Type = Underlying_Type (RTE (RE_TypeCode)) then

               --  No corresponding FA_TC ???

               Lib_RE := RE_TA_TC;

            --  Other (non-primitive) types

            else
               declare
                  Decl : Entity_Id;
               begin
                  Build_To_Any_Function (Loc, U_Type, Decl, Fnam);
                  Append_To (Decls, Decl);
               end;
            end if;

            --  Call the function

            if Lib_RE /= RE_Null then
               pragma Assert (No (Fnam));
               Fnam := RTE (Lib_RE);
            end if;

            --  If Fnam is already analyzed, find the proper expected type,
            --  else we have a newly constructed To_Any function and we know
            --  that the expected type of its parameter is U_Type.

            if Ekind (Fnam) = E_Function
              and then Present (First_Formal (Fnam))
            then
               C_Type := Etype (First_Formal (Fnam));
            else
               C_Type := U_Type;
            end if;

            return
                Make_Function_Call (Loc,
                  Name                   => New_Occurrence_Of (Fnam, Loc),
                  Parameter_Associations =>
                    New_List (OK_Convert_To (C_Type, N)));
         end Build_To_Any_Call;

         ---------------------------
         -- Build_To_Any_Function --
         ---------------------------

         procedure Build_To_Any_Function
           (Loc  : Source_Ptr;
            Typ  : Entity_Id;
            Decl : out Node_Id;
            Fnam : out Entity_Id)
         is
            Spec  : Node_Id;
            Decls : constant List_Id := New_List;
            Stms  : constant List_Id := New_List;

            Expr_Parameter : constant Entity_Id :=
                               Make_Defining_Identifier (Loc, Name_E);

            Any : constant Entity_Id :=
                    Make_Defining_Identifier (Loc, Name_A);

            Any_Decl  : Node_Id;
            Result_TC : Node_Id := Build_TypeCode_Call (Loc, Typ, Decls);

            Use_Opaque_Representation : Boolean;
            --  When True, use stream attributes and represent type as an
            --  opaque sequence of bytes.

         begin
            --  For a derived type, we can't go past the base type (to the
            --  parent type) here, because that would cause the attribute's
            --  formal parameter to have the wrong type; hence the Base_Type
            --  check here.

            if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then
               Build_To_Any_Function
                  (Loc  => Loc,
                  Typ  => Etype (Typ),
                  Decl => Decl,
                  Fnam => Fnam);
               return;
            end if;

            Fnam := Make_Helper_Function_Name (Loc, Typ, Name_To_Any);

            Spec :=
              Make_Function_Specification (Loc,
                Defining_Unit_Name => Fnam,
                Parameter_Specifications => New_List (
                  Make_Parameter_Specification (Loc,
                    Defining_Identifier => Expr_Parameter,
                    Parameter_Type => New_Occurrence_Of (Typ, Loc))),
                Result_Definition  => New_Occurrence_Of (RTE (RE_Any), Loc));
            Set_Etype (Expr_Parameter, Typ);

            Any_Decl :=
              Make_Object_Declaration (Loc,
                Defining_Identifier => Any,
                Object_Definition   => New_Occurrence_Of (RTE (RE_Any), Loc));

            Use_Opaque_Representation := False;

            if Has_Stream_Attribute_Definition
                 (Typ, TSS_Stream_Output, At_Any_Place => True)
              or else
               Has_Stream_Attribute_Definition
                 (Typ, TSS_Stream_Write,  At_Any_Place => True)
            then
               --  If user-defined stream attributes are specified for this
               --  type, use them and transmit data as an opaque sequence of
               --  stream elements.

               Use_Opaque_Representation := True;

            elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then

               --  Non-tagged derived type: convert to root type

               declare
                  Rt_Type : constant Entity_Id := Root_Type (Typ);
                  Expr    : constant Node_Id :=
                              OK_Convert_To
                                (Rt_Type,
                                 New_Occurrence_Of (Expr_Parameter, Loc));
               begin
                  Set_Expression (Any_Decl, Build_To_Any_Call (Expr, Decls));
               end;

            elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then

               --  Non-tagged record type

               if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
                  declare
                     Rt_Type : constant Entity_Id := Etype (Typ);
                     Expr    : constant Node_Id :=
                                 OK_Convert_To (Rt_Type,
                                   New_Occurrence_Of (Expr_Parameter, Loc));

                  begin
                     Set_Expression
                       (Any_Decl, Build_To_Any_Call (Expr, Decls));
                  end;

               --  Comment needed here (and label on declare block ???)

               else
                  declare
                     Disc     : Entity_Id := Empty;
                     Rdef     : constant Node_Id :=
                                  Type_Definition (Declaration_Node (Typ));
                     Counter  : Int := 0;
                     Elements : constant List_Id := New_List;

                     procedure TA_Rec_Add_Process_Element
                       (Stmts     : List_Id;
                        Container : Node_Or_Entity_Id;
                        Counter   : in out Int;
                        Rec       : Entity_Id;
                        Field     : Node_Id);
                     --  Processing routine for traversal below

                     procedure TA_Append_Record_Traversal is
                        new Append_Record_Traversal
                          (Rec                 => Expr_Parameter,
                           Add_Process_Element => TA_Rec_Add_Process_Element);

                     --------------------------------
                     -- TA_Rec_Add_Process_Element --
                     --------------------------------

                     procedure TA_Rec_Add_Process_Element
                       (Stmts     : List_Id;
                        Container : Node_Or_Entity_Id;
                        Counter   : in out Int;
                        Rec       : Entity_Id;
                        Field     : Node_Id)
                     is
                        Field_Ref : Node_Id;

                     begin
                        if Nkind (Field) = N_Defining_Identifier then

                           --  A regular component

                           Field_Ref := Make_Selected_Component (Loc,
                             Prefix        => New_Occurrence_Of (Rec, Loc),
                             Selector_Name => New_Occurrence_Of (Field, Loc));
                           Set_Etype (Field_Ref, Etype (Field));

                           Append_To (Stmts,
                             Make_Procedure_Call_Statement (Loc,
                               Name =>
                                 New_Occurrence_Of (
                                   RTE (RE_Add_Aggregate_Element), Loc),
                               Parameter_Associations => New_List (
                                 New_Occurrence_Of (Container, Loc),
                                 Build_To_Any_Call (Field_Ref, Decls))));

                        else
                           --  A variant part

                           Variant_Part : declare
                              Variant        : Node_Id;
                              Struct_Counter : Int := 0;

                              Block_Decls : constant List_Id := New_List;
                              Block_Stmts : constant List_Id := New_List;
                              VP_Stmts    : List_Id;

                              Alt_List    : constant List_Id := New_List;
                              Choice_List : List_Id;

                              Union_Any : constant Entity_Id :=
                                            Make_Temporary (Loc, 'V');

                              Struct_Any : constant Entity_Id :=
                                             Make_Temporary (Loc, 'S');

                              function Make_Discriminant_Reference
                                return Node_Id;
                              --  Build reference to the discriminant for this
                              --  variant part.

                              ---------------------------------
                              -- Make_Discriminant_Reference --
                              ---------------------------------

                              function Make_Discriminant_Reference
                                return Node_Id
                              is
                                 Nod : constant Node_Id :=
                                         Make_Selected_Component (Loc,
                                           Prefix        => Rec,
                                           Selector_Name =>
                                             Chars (Name (Field)));
                              begin
                                 Set_Etype (Nod, Etype (Name (Field)));
                                 return Nod;
                              end Make_Discriminant_Reference;

                           --  Start of processing for Variant_Part

                           begin
                              Append_To (Stmts,
                                Make_Block_Statement (Loc,
                                  Declarations =>
                                    Block_Decls,
                                  Handled_Statement_Sequence =>
                                    Make_Handled_Sequence_Of_Statements (Loc,
                                      Statements => Block_Stmts)));

                              --  Declare variant part aggregate (Union_Any).
                              --  Knowing the position of this VP in the
                              --  variant record, we can fetch the VP typecode
                              --  from Container.

                              Append_To (Block_Decls,
                                Make_Object_Declaration (Loc,
                                  Defining_Identifier => Union_Any,
                                  Object_Definition   =>
                                    New_Occurrence_Of (RTE (RE_Any), Loc),
                                  Expression =>
                                    Make_Function_Call (Loc,
                                      Name => New_Occurrence_Of (
                                                RTE (RE_Create_Any), Loc),
                                      Parameter_Associations => New_List (
                                        Make_Function_Call (Loc,
                                          Name =>
                                            New_Occurrence_Of (
                                              RTE (RE_Any_Member_Type), Loc),
                                          Parameter_Associations => New_List (
                                            New_Occurrence_Of (Container, Loc),
                                            Make_Integer_Literal (Loc,
                                              Counter)))))));

                              --  Declare inner struct aggregate (which
                              --  contains the components of this VP).

                              Append_To (Block_Decls,
                                Make_Object_Declaration (Loc,
                                  Defining_Identifier => Struct_Any,
                                  Object_Definition   =>
                                    New_Occurrence_Of (RTE (RE_Any), Loc),
                                  Expression =>
                                    Make_Function_Call (Loc,
                                      Name => New_Occurrence_Of (
                                        RTE (RE_Create_Any), Loc),
                                      Parameter_Associations => New_List (
                                        Make_Function_Call (Loc,
                                          Name =>
                                            New_Occurrence_Of (
                                              RTE (RE_Any_Member_Type), Loc),
                                          Parameter_Associations => New_List (
                                            New_Occurrence_Of (Union_Any, Loc),
                                            Make_Integer_Literal (Loc,
                                              Uint_1)))))));

                              --  Build case statement

                              Append_To (Block_Stmts,
                                Make_Case_Statement (Loc,
                                  Expression   => Make_Discriminant_Reference,
                                  Alternatives => Alt_List));

                              Variant := First_Non_Pragma (Variants (Field));
                              while Present (Variant) loop
                                 Choice_List := New_Copy_List_Tree
                                   (Discrete_Choices (Variant));

                                 VP_Stmts := New_List;

                                 --  Append discriminant val to union aggregate

                                 Append_To (VP_Stmts,
                                    Make_Procedure_Call_Statement (Loc,
                                      Name =>
                                        New_Occurrence_Of (
                                          RTE (RE_Add_Aggregate_Element), Loc),
                                      Parameter_Associations => New_List (
                                        New_Occurrence_Of (Union_Any, Loc),
                                          Build_To_Any_Call
                                            (Make_Discriminant_Reference,
                                             Block_Decls))));

                                 --  Populate inner struct aggregate

                                 --  Struct_Counter should be reset before
                                 --  handling a variant part. Indeed only one
                                 --  of the case statement alternatives will be
                                 --  executed at run-time, so the counter must
                                 --  start at 0 for every case statement.

                                 Struct_Counter := 0;

                                 TA_Append_Record_Traversal
                                   (Stmts     => VP_Stmts,
                                    Clist     => Component_List (Variant),
                                    Container => Struct_Any,
                                    Counter   => Struct_Counter);

                                 --  Append inner struct to union aggregate

                                 Append_To (VP_Stmts,
                                   Make_Procedure_Call_Statement (Loc,
                                     Name =>
                                       New_Occurrence_Of
                                         (RTE (RE_Add_Aggregate_Element), Loc),
                                     Parameter_Associations => New_List (
                                       New_Occurrence_Of (Union_Any, Loc),
                                       New_Occurrence_Of (Struct_Any, Loc))));

                                 --  Append union to outer aggregate

                                 Append_To (VP_Stmts,
                                   Make_Procedure_Call_Statement (Loc,
                                     Name =>
                                       New_Occurrence_Of
                                         (RTE (RE_Add_Aggregate_Element), Loc),
                                       Parameter_Associations => New_List (
                                          New_Occurrence_Of (Container, Loc),
                                          New_Occurrence_Of
                                            (Union_Any, Loc))));

                                 Append_To (Alt_List,
                                   Make_Case_Statement_Alternative (Loc,
                                     Discrete_Choices => Choice_List,
                                     Statements       => VP_Stmts));

                                 Next_Non_Pragma (Variant);
                              end loop;
                           end Variant_Part;
                        end if;

                        Counter := Counter + 1;
                     end TA_Rec_Add_Process_Element;

                  begin
                     --  Records are encoded in a TC_STRUCT aggregate:

                     --  -- Outer aggregate (TC_STRUCT)
                     --  | [discriminant1]
                     --  | [discriminant2]
                     --  | ...
                     --  |
                     --  | [component1]
                     --  | [component2]
                     --  | ...

                     --  A component can be a common component or variant part

                     --  A variant part is encoded as a TC_UNION aggregate:

                     --  -- Variant Part Aggregate (TC_UNION)
                     --  | [discriminant choice for this Variant Part]
                     --  |
                     --  | -- Inner struct (TC_STRUCT)
                     --  | |  [component1]
                     --  | |  [component2]
                     --  | |  ...

                     --  Let's start by building the outer aggregate. First we
                     --  construct Elements array containing all discriminants.

                     if Has_Discriminants (Typ) then
                        Disc := First_Discriminant (Typ);
                        while Present (Disc) loop
                           declare
                              Discriminant : constant Entity_Id :=
                                               Make_Selected_Component (Loc,
                                                 Prefix        =>
                                                   Expr_Parameter,
                                                 Selector_Name =>
                                                   Chars (Disc));

                           begin
                              Set_Etype (Discriminant, Etype (Disc));

                              Append_To (Elements,
                                Make_Component_Association (Loc,
                                  Choices => New_List (
                                    Make_Integer_Literal (Loc, Counter)),
                                  Expression =>
                                    Build_To_Any_Call (Discriminant, Decls)));
                           end;

                           Counter := Counter + 1;
                           Next_Discriminant (Disc);
                        end loop;

                     else
                        --  If there are no discriminants, we declare an empty
                        --  Elements array.

                        declare
                           Dummy_Any : constant Entity_Id :=
                                         Make_Temporary (Loc, 'A');

                        begin
                           Append_To (Decls,
                             Make_Object_Declaration (Loc,
                               Defining_Identifier => Dummy_Any,
                               Object_Definition   =>
                                 New_Occurrence_Of (RTE (RE_Any), Loc)));

                           Append_To (Elements,
                             Make_Component_Association (Loc,
                               Choices => New_List (
                                 Make_Range (Loc,
                                   Low_Bound  =>
                                     Make_Integer_Literal (Loc, 1),
                                   High_Bound =>
                                     Make_Integer_Literal (Loc, 0))),
                               Expression =>
                                 New_Occurrence_Of (Dummy_Any, Loc)));
                        end;
                     end if;

                     --  We build the result aggregate with discriminants
                     --  as the first elements.

                     Set_Expression (Any_Decl,
                       Make_Function_Call (Loc,
                         Name => New_Occurrence_Of
                                   (RTE (RE_Any_Aggregate_Build), Loc),
                         Parameter_Associations => New_List (
                           Result_TC,
                           Make_Aggregate (Loc,
                             Component_Associations => Elements))));
                     Result_TC := Empty;

                     --  Then we append all the components to the result
                     --  aggregate.

                     TA_Append_Record_Traversal (Stms,
                       Clist     => Component_List (Rdef),
                       Container => Any,
                       Counter   => Counter);
                  end;
               end if;

            elsif Is_Array_Type (Typ) then

               --  Constrained and unconstrained array types

               declare
                  Constrained : constant Boolean := Is_Constrained (Typ);

                  procedure TA_Ary_Add_Process_Element
                    (Stmts   : List_Id;
                     Any     : Entity_Id;
                     Counter : Entity_Id;
                     Datum   : Node_Id);

                  --------------------------------
                  -- TA_Ary_Add_Process_Element --
                  --------------------------------

                  procedure TA_Ary_Add_Process_Element
                    (Stmts   : List_Id;
                     Any     : Entity_Id;
                     Counter : Entity_Id;
                     Datum   : Node_Id)
                  is
                     pragma Unreferenced (Counter);

                     Element_Any : Node_Id;

                  begin
                     if Etype (Datum) = RTE (RE_Any) then
                        Element_Any := Datum;
                     else
                        Element_Any := Build_To_Any_Call (Datum, Decls);
                     end if;

                     Append_To (Stmts,
                       Make_Procedure_Call_Statement (Loc,
                         Name => New_Occurrence_Of (
                                   RTE (RE_Add_Aggregate_Element), Loc),
                         Parameter_Associations => New_List (
                           New_Occurrence_Of (Any, Loc),
                           Element_Any)));
                  end TA_Ary_Add_Process_Element;

                  procedure Append_To_Any_Array_Iterator is
                    new Append_Array_Traversal (
                      Subprogram => Fnam,
                      Arry       => Expr_Parameter,
                      Indices    => New_List,
                      Add_Process_Element => TA_Ary_Add_Process_Element);

                  Index : Node_Id;

               begin
                  Set_Expression (Any_Decl,
                    Make_Function_Call (Loc,
                      Name =>
                        New_Occurrence_Of (RTE (RE_Create_Any), Loc),
                      Parameter_Associations => New_List (Result_TC)));
                  Result_TC := Empty;

                  if not Constrained then
                     Index := First_Index (Typ);
                     for J in 1 .. Number_Dimensions (Typ) loop
                        Append_To (Stms,
                          Make_Procedure_Call_Statement (Loc,
                            Name =>
                              New_Occurrence_Of (
                                RTE (RE_Add_Aggregate_Element), Loc),
                            Parameter_Associations => New_List (
                              New_Occurrence_Of (Any, Loc),
                              Build_To_Any_Call (
                                OK_Convert_To (Etype (Index),
                                  Make_Attribute_Reference (Loc,
                                    Prefix         =>
                                      New_Occurrence_Of (Expr_Parameter, Loc),
                                    Attribute_Name => Name_First,
                                    Expressions    => New_List (
                                      Make_Integer_Literal (Loc, J)))),
                                Decls))));
                        Next_Index (Index);
                     end loop;
                  end if;

                  Append_To_Any_Array_Iterator (Stms, Any);
               end;

            elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then

               --  Integer types

               Set_Expression (Any_Decl,
                 Build_To_Any_Call (
                   OK_Convert_To (
                     Find_Numeric_Representation (Typ),
                     New_Occurrence_Of (Expr_Parameter, Loc)),
                   Decls));

            else
               --  Default case, including tagged types: opaque representation

               Use_Opaque_Representation := True;
            end if;

            if Use_Opaque_Representation then
               declare
                  Strm : constant Entity_Id := Make_Temporary (Loc, 'S');
                  --  Stream used to store data representation produced by
                  --  stream attribute.

               begin
                  --  Generate:
                  --    Strm : aliased Buffer_Stream_Type;

                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier =>
                        Strm,
                      Aliased_Present     =>
                        True,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));

                  --  Generate:
                  --    T'Output (Strm'Access, E);

                  Append_To (Stms,
                      Make_Attribute_Reference (Loc,
                        Prefix         => New_Occurrence_Of (Typ, Loc),
                        Attribute_Name => Name_Output,
                        Expressions    => New_List (
                          Make_Attribute_Reference (Loc,
                            Prefix         => New_Occurrence_Of (Strm, Loc),
                            Attribute_Name => Name_Access),
                          New_Occurrence_Of (Expr_Parameter, Loc))));

                  --  Generate:
                  --    BS_To_Any (Strm, A);

                  Append_To (Stms,
                    Make_Procedure_Call_Statement (Loc,
                      Name => New_Occurrence_Of (RTE (RE_BS_To_Any), Loc),
                      Parameter_Associations => New_List (
                        New_Occurrence_Of (Strm, Loc),
                        New_Occurrence_Of (Any, Loc))));

                  --  Generate:
                  --    Release_Buffer (Strm);

                  Append_To (Stms,
                    Make_Procedure_Call_Statement (Loc,
                      Name => New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
                      Parameter_Associations => New_List (
                        New_Occurrence_Of (Strm, Loc))));
               end;
            end if;

            Append_To (Decls, Any_Decl);

            if Present (Result_TC) then
               Append_To (Stms,
                 Make_Procedure_Call_Statement (Loc,
                   Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc),
                   Parameter_Associations => New_List (
                     New_Occurrence_Of (Any, Loc),
                     Result_TC)));
            end if;

            Append_To (Stms,
              Make_Simple_Return_Statement (Loc,
                Expression => New_Occurrence_Of (Any, Loc)));

            Decl :=
              Make_Subprogram_Body (Loc,
                Specification              => Spec,
                Declarations               => Decls,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc,
                    Statements => Stms));
         end Build_To_Any_Function;

         -------------------------
         -- Build_TypeCode_Call --
         -------------------------

         function Build_TypeCode_Call
           (Loc   : Source_Ptr;
            Typ   : Entity_Id;
            Decls : List_Id) return Node_Id
         is
            U_Type : Entity_Id := Underlying_Type (Typ);
            --  The full view, if Typ is private; the completion,
            --  if Typ is incomplete.

            Fnam   : Entity_Id := Empty;
            Lib_RE : RE_Id := RE_Null;
            Expr   : Node_Id;

         begin
            --  Special case System.PolyORB.Interface.Any: its primitives have
            --  not been set yet, so can't call Find_Inherited_TSS.

            if Typ = RTE (RE_Any) then
               Fnam := RTE (RE_TC_A);

            else
               --  First simple case where the TypeCode is present
               --  in the type's TSS.

               Fnam := Find_Inherited_TSS (U_Type, TSS_TypeCode);
            end if;

            if No (Fnam) then
               if Sloc (U_Type) <= Standard_Location then

                  --  Do not try to build alias typecodes for subtypes from
                  --  Standard.

                  U_Type := Base_Type (U_Type);
               end if;

               if U_Type = Standard_Boolean then
                  Lib_RE := RE_TC_B;

               elsif U_Type = Standard_Character then
                  Lib_RE := RE_TC_C;

               elsif U_Type = Standard_Wide_Character then
                  Lib_RE := RE_TC_WC;

               elsif U_Type = Standard_Wide_Wide_Character then
                  Lib_RE := RE_TC_WWC;

               --  Floating point types

               elsif U_Type = Standard_Short_Float then
                  Lib_RE := RE_TC_SF;

               elsif U_Type = Standard_Float then
                  Lib_RE := RE_TC_F;

               elsif U_Type = Standard_Long_Float then
                  Lib_RE := RE_TC_LF;

               elsif U_Type = Standard_Long_Long_Float then
                  Lib_RE := RE_TC_LLF;

               --  Integer types (walk back to the base type)

               elsif U_Type = Etype (Standard_Short_Short_Integer) then
                     Lib_RE := RE_TC_SSI;

               elsif U_Type = Etype (Standard_Short_Integer) then
                  Lib_RE := RE_TC_SI;

               elsif U_Type = Etype (Standard_Integer) then
                  Lib_RE := RE_TC_I;

               elsif U_Type = Etype (Standard_Long_Integer) then
                  Lib_RE := RE_TC_LI;

               elsif U_Type = Etype (Standard_Long_Long_Integer) then
                  Lib_RE := RE_TC_LLI;

               --  Unsigned integer types

               elsif U_Type = RTE (RE_Short_Short_Unsigned) then
                  Lib_RE := RE_TC_SSU;

               elsif U_Type = RTE (RE_Short_Unsigned) then
                  Lib_RE := RE_TC_SU;

               elsif U_Type = RTE (RE_Unsigned) then
                  Lib_RE := RE_TC_U;

               elsif U_Type = RTE (RE_Long_Unsigned) then
                  Lib_RE := RE_TC_LU;

               elsif U_Type = RTE (RE_Long_Long_Unsigned) then
                  Lib_RE := RE_TC_LLU;

               elsif Is_RTE (U_Type, RE_Unbounded_String) then
                  Lib_RE := RE_TC_String;

               --  Special DSA types

               elsif Is_RTE (U_Type, RE_Any_Container_Ptr) then
                  Lib_RE := RE_TC_A;

               --  Other (non-primitive) types

               else
                  declare
                     Decl : Entity_Id;
                  begin
                     Build_TypeCode_Function (Loc, U_Type, Decl, Fnam);
                     Append_To (Decls, Decl);
                  end;
               end if;

               if Lib_RE /= RE_Null then
                  Fnam := RTE (Lib_RE);
               end if;
            end if;

            --  Call the function

            Expr :=
              Make_Function_Call (Loc, Name => New_Occurrence_Of (Fnam, Loc));

            --  Allow Expr to be used as arg to Build_To_Any_Call immediately

            Set_Etype (Expr, RTE (RE_TypeCode));

            return Expr;
         end Build_TypeCode_Call;

         -----------------------------
         -- Build_TypeCode_Function --
         -----------------------------

         procedure Build_TypeCode_Function
           (Loc  : Source_Ptr;
            Typ  : Entity_Id;
            Decl : out Node_Id;
            Fnam : out Entity_Id)
         is
            Spec  : Node_Id;
            Decls : constant List_Id := New_List;
            Stms  : constant List_Id := New_List;

            TCNam : constant Entity_Id :=
                      Make_Helper_Function_Name (Loc, Typ, Name_TypeCode);

            Parameters : List_Id;

            procedure Add_String_Parameter
              (S              : String_Id;
               Parameter_List : List_Id);
            --  Add a literal for S to Parameters

            procedure Add_TypeCode_Parameter
              (TC_Node        : Node_Id;
               Parameter_List : List_Id);
            --  Add the typecode for Typ to Parameters

            procedure Add_Long_Parameter
              (Expr_Node      : Node_Id;
               Parameter_List : List_Id);
            --  Add a signed long integer expression to Parameters

            procedure Initialize_Parameter_List
              (Name_String    : String_Id;
               Repo_Id_String : String_Id;
               Parameter_List : out List_Id);
            --  Return a list that contains the first two parameters
            --  for a parameterized typecode: name and repository id.

            function Make_Constructed_TypeCode
              (Kind       : Entity_Id;
               Parameters : List_Id) return Node_Id;
            --  Call TC_Build with the given kind and parameters

            procedure Return_Constructed_TypeCode (Kind : Entity_Id);
            --  Make a return statement that calls TC_Build with the given
            --  typecode kind, and the constructed parameters list.

            procedure Return_Alias_TypeCode (Base_TypeCode  : Node_Id);
            --  Return a typecode that is a TC_Alias for the given typecode

            --------------------------
            -- Add_String_Parameter --
            --------------------------

            procedure Add_String_Parameter
              (S              : String_Id;
               Parameter_List : List_Id)
            is
            begin
               Append_To (Parameter_List,
                 Make_Function_Call (Loc,
                   Name => New_Occurrence_Of (RTE (RE_TA_Std_String), Loc),
                   Parameter_Associations => New_List (
                     Make_String_Literal (Loc, S))));
            end Add_String_Parameter;

            ----------------------------
            -- Add_TypeCode_Parameter --
            ----------------------------

            procedure Add_TypeCode_Parameter
              (TC_Node        : Node_Id;
               Parameter_List : List_Id)
            is
            begin
               Append_To (Parameter_List,
                 Make_Function_Call (Loc,
                   Name => New_Occurrence_Of (RTE (RE_TA_TC), Loc),
                   Parameter_Associations => New_List (TC_Node)));
            end Add_TypeCode_Parameter;

            ------------------------
            -- Add_Long_Parameter --
            ------------------------

            procedure Add_Long_Parameter
              (Expr_Node      : Node_Id;
               Parameter_List : List_Id)
            is
            begin
               Append_To (Parameter_List,
                 Make_Function_Call (Loc,
                   Name => New_Occurrence_Of (RTE (RE_TA_LI), Loc),
                   Parameter_Associations => New_List (Expr_Node)));
            end Add_Long_Parameter;

            -------------------------------
            -- Initialize_Parameter_List --
            -------------------------------

            procedure Initialize_Parameter_List
              (Name_String    : String_Id;
               Repo_Id_String : String_Id;
               Parameter_List : out List_Id)
            is
            begin
               Parameter_List := New_List;
               Add_String_Parameter (Name_String, Parameter_List);
               Add_String_Parameter (Repo_Id_String, Parameter_List);
            end Initialize_Parameter_List;

            ---------------------------
            -- Return_Alias_TypeCode --
            ---------------------------

            procedure Return_Alias_TypeCode
              (Base_TypeCode  : Node_Id)
            is
            begin
               Add_TypeCode_Parameter (Base_TypeCode, Parameters);
               Return_Constructed_TypeCode (RTE (RE_TC_Alias));
            end Return_Alias_TypeCode;

            -------------------------------
            -- Make_Constructed_TypeCode --
            -------------------------------

            function Make_Constructed_TypeCode
              (Kind       : Entity_Id;
               Parameters : List_Id) return Node_Id
            is
               Constructed_TC : constant Node_Id :=
                 Make_Function_Call (Loc,
                   Name =>
                     New_Occurrence_Of (RTE (RE_TC_Build), Loc),
                   Parameter_Associations => New_List (
                     New_Occurrence_Of (Kind, Loc),
                     Make_Aggregate (Loc,
                        Expressions => Parameters)));
            begin
               Set_Etype (Constructed_TC, RTE (RE_TypeCode));
               return Constructed_TC;
            end Make_Constructed_TypeCode;

            ---------------------------------
            -- Return_Constructed_TypeCode --
            ---------------------------------

            procedure Return_Constructed_TypeCode (Kind : Entity_Id) is
            begin
               Append_To (Stms,
                 Make_Simple_Return_Statement (Loc,
                   Expression =>
                     Make_Constructed_TypeCode (Kind, Parameters)));
            end Return_Constructed_TypeCode;

            ------------------
            -- Record types --
            ------------------

            procedure TC_Rec_Add_Process_Element
              (Params  : List_Id;
               Any     : Entity_Id;
               Counter : in out Int;
               Rec     : Entity_Id;
               Field   : Node_Id);

            procedure TC_Append_Record_Traversal is
              new Append_Record_Traversal (
                Rec                 => Empty,
                Add_Process_Element => TC_Rec_Add_Process_Element);

            --------------------------------
            -- TC_Rec_Add_Process_Element --
            --------------------------------

            procedure TC_Rec_Add_Process_Element
              (Params  : List_Id;
               Any     : Entity_Id;
               Counter : in out Int;
               Rec     : Entity_Id;
               Field   : Node_Id)
            is
               pragma Unreferenced (Any, Counter, Rec);

            begin
               if Nkind (Field) = N_Defining_Identifier then

                  --  A regular component

                  Add_TypeCode_Parameter
                    (Build_TypeCode_Call (Loc, Etype (Field), Decls), Params);
                  Get_Name_String (Chars (Field));
                  Add_String_Parameter (String_From_Name_Buffer, Params);

               else

                  --  A variant part

                  declare
                     Discriminant_Type : constant Entity_Id :=
                                           Etype (Name (Field));

                     Is_Enum : constant Boolean :=
                                 Is_Enumeration_Type (Discriminant_Type);

                     Union_TC_Params : List_Id;

                     U_Name : constant Name_Id :=
                                New_External_Name (Chars (Typ), 'V', -1);

                     Name_Str         : String_Id;
                     Struct_TC_Params : List_Id;

                     Variant : Node_Id;
                     Choice  : Node_Id;
                     Default : constant Node_Id :=
                                 Make_Integer_Literal (Loc, -1);

                     Dummy_Counter : Int := 0;

                     Choice_Index : Int := 0;

                     procedure Add_Params_For_Variant_Components;
                     --  Add a struct TypeCode and a corresponding member name
                     --  to the union parameter list.

                     --  Ordering of declarations is a complete mess in this
                     --  area, it is supposed to be types/variables, then
                     --  subprogram specs, then subprogram bodies ???

                     ---------------------------------------
                     -- Add_Params_For_Variant_Components --
                     ---------------------------------------

                     procedure Add_Params_For_Variant_Components
                     is
                        S_Name : constant Name_Id :=
                                   New_External_Name (U_Name, 'S', -1);

                     begin
                        Get_Name_String (S_Name);
                        Name_Str := String_From_Name_Buffer;
                        Initialize_Parameter_List
                          (Name_Str, Name_Str, Struct_TC_Params);

                        --  Build struct parameters

                        TC_Append_Record_Traversal (Struct_TC_Params,
                          Component_List (Variant),
                          Empty,
                          Dummy_Counter);

                        Add_TypeCode_Parameter
                          (Make_Constructed_TypeCode
                           (RTE (RE_TC_Struct), Struct_TC_Params),
                           Union_TC_Params);

                        Add_String_Parameter (Name_Str, Union_TC_Params);
                     end Add_Params_For_Variant_Components;

                  begin
                     Get_Name_String (U_Name);
                     Name_Str := String_From_Name_Buffer;

                     Initialize_Parameter_List
                       (Name_Str, Name_Str, Union_TC_Params);

                     --  Add union in enclosing parameter list

                     Add_TypeCode_Parameter
                       (Make_Constructed_TypeCode
                        (RTE (RE_TC_Union), Union_TC_Params),
                        Params);

                     Add_String_Parameter (Name_Str, Params);

                     --  Build union parameters

                     Add_TypeCode_Parameter
                       (Build_TypeCode_Call
                          (Loc, Discriminant_Type, Decls),
                        Union_TC_Params);

                     Add_Long_Parameter (Default, Union_TC_Params);

                     Variant := First_Non_Pragma (Variants (Field));
                     while Present (Variant) loop
                        Choice := First (Discrete_Choices (Variant));
                        while Present (Choice) loop
                           case Nkind (Choice) is
                              when N_Range =>
                                 declare
                                    L : constant Uint :=
                                          Expr_Value (Low_Bound (Choice));
                                    H : constant Uint :=
                                          Expr_Value (High_Bound (Choice));
                                    J : Uint := L;
                                    --  3.8.1(8) guarantees that the bounds of
                                    --  this range are static.

                                    Expr : Node_Id;

                                 begin
                                    while J <= H loop
                                       if Is_Enum then
                                          Expr := New_Occurrence_Of (
                                            Get_Enum_Lit_From_Pos (
                                              Discriminant_Type, J, Loc), Loc);
                                       else
                                          Expr :=
                                            Make_Integer_Literal (Loc, J);
                                       end if;
                                       Append_To (Union_TC_Params,
                                         Build_To_Any_Call (Expr, Decls));

                                       Add_Params_For_Variant_Components;
                                       J := J + Uint_1;
                                    end loop;
                                 end;

                              when N_Others_Choice =>

                                 --  This variant possess a default choice.
                                 --  We must therefore set the default
                                 --  parameter to the current choice index. The
                                 --  default parameter is by construction the
                                 --  fourth in the Union_TC_Params list.

                                 declare
                                    Default_Node : constant Node_Id :=
                                                     Pick (Union_TC_Params, 4);

                                    New_Default_Node : constant Node_Id :=
                                      Make_Function_Call (Loc,
                                       Name =>
                                         New_Occurrence_Of
                                           (RTE (RE_TA_LI), Loc),
                                       Parameter_Associations =>
                                         New_List (
                                           Make_Integer_Literal
                                             (Loc, Choice_Index)));
                                 begin
                                    Insert_Before (
                                      Default_Node,
                                      New_Default_Node);

                                    Remove (Default_Node);
                                 end;

                                 --  Add a placeholder member label
                                 --  for the default case.
                                 --  It must be of the discriminant type.

                                 declare
                                    Exp : constant Node_Id :=
                                      Make_Attribute_Reference (Loc,
                                       Prefix => New_Occurrence_Of
                                         (Discriminant_Type, Loc),
                                       Attribute_Name => Name_First);
                                 begin
                                    Set_Etype (Exp, Discriminant_Type);
                                    Append_To (Union_TC_Params,
                                      Build_To_Any_Call (Exp, Decls));
                                 end;

                                 Add_Params_For_Variant_Components;

                              when others =>

                                 --  Case of an explicit choice

                                 declare
                                    Exp : constant Node_Id :=
                                            New_Copy_Tree (Choice);
                                 begin
                                    Append_To (Union_TC_Params,
                                      Build_To_Any_Call (Exp, Decls));
                                 end;

                                 Add_Params_For_Variant_Components;
                           end case;

                           Next (Choice);
                           Choice_Index := Choice_Index + 1;
                        end loop;

                        Next_Non_Pragma (Variant);
                     end loop;
                  end;
               end if;
            end TC_Rec_Add_Process_Element;

            Type_Name_Str    : String_Id;
            Type_Repo_Id_Str : String_Id;

         --  Start of processing for Build_TypeCode_Function

         begin
            --  For a derived type, we can't go past the base type (to the
            --  parent type) here, because that would cause the attribute's
            --  formal parameter to have the wrong type; hence the Base_Type
            --  check here.

            if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then
               Build_TypeCode_Function
                  (Loc  => Loc,
                  Typ  => Etype (Typ),
                  Decl => Decl,
                  Fnam => Fnam);
               return;
            end if;

            Fnam := TCNam;

            Spec :=
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Fnam,
                Parameter_Specifications => Empty_List,
                Result_Definition        =>
                  New_Occurrence_Of (RTE (RE_TypeCode), Loc));

            Build_Name_And_Repository_Id (Typ,
              Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str);

            Initialize_Parameter_List
              (Type_Name_Str, Type_Repo_Id_Str, Parameters);

            if Has_Stream_Attribute_Definition
                 (Typ, TSS_Stream_Output, At_Any_Place => True)
              or else
               Has_Stream_Attribute_Definition
                 (Typ, TSS_Stream_Write, At_Any_Place => True)
            then
               --  If user-defined stream attributes are specified for this
               --  type, use them and transmit data as an opaque sequence of
               --  stream elements.

               Return_Alias_TypeCode
                 (New_Occurrence_Of (RTE (RE_TC_Opaque), Loc));

            elsif Is_Derived_Type (Typ) and then not Is_Tagged_Type (Typ) then
               Return_Alias_TypeCode (
                 Build_TypeCode_Call (Loc, Etype (Typ), Decls));

            elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then
               Return_Alias_TypeCode (
                 Build_TypeCode_Call (Loc,
                   Find_Numeric_Representation (Typ), Decls));

            elsif Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) then

               --  Record typecodes are encoded as follows:
               --  -- TC_STRUCT
               --  |
               --  |  [Name]
               --  |  [Repository Id]
               --
               --  Then for each discriminant:
               --
               --  |  [Discriminant Type Code]
               --  |  [Discriminant Name]
               --  |  ...
               --
               --  Then for each component:
               --
               --  |  [Component Type Code]
               --  |  [Component Name]
               --  |  ...
               --
               --  Variants components type codes are encoded as follows:
               --  --  TC_UNION
               --  |
               --  |  [Name]
               --  |  [Repository Id]
               --  |  [Discriminant Type Code]
               --  |  [Index of Default Variant Part or -1 for no default]
               --
               --  Then for each Variant Part :
               --
               --  |  [VP Label]
               --  |
               --  |  -- TC_STRUCT
               --  |  | [Variant Part Name]
               --  |  | [Variant Part Repository Id]
               --  |  |
               --  |    Then for each VP component:
               --  |  | [VP component Typecode]
               --  |  | [VP component Name]
               --  |  | ...
               --  |  --
               --  |
               --  |  [VP Name]

               if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
                  Return_Alias_TypeCode
                    (Build_TypeCode_Call (Loc, Etype (Typ), Decls));

               else
                  declare
                     Disc : Entity_Id := Empty;
                     Rdef : constant Node_Id :=
                              Type_Definition (Declaration_Node (Typ));
                     Dummy_Counter : Int := 0;

                  begin
                     --  Construct the discriminants typecodes

                     if Has_Discriminants (Typ) then
                        Disc := First_Discriminant (Typ);
                     end if;

                     while Present (Disc) loop
                        Add_TypeCode_Parameter (
                          Build_TypeCode_Call (Loc, Etype (Disc), Decls),
                          Parameters);
                        Get_Name_String (Chars (Disc));
                        Add_String_Parameter (
                          String_From_Name_Buffer,
                          Parameters);
                        Next_Discriminant (Disc);
                     end loop;

                     --  then the components typecodes

                     TC_Append_Record_Traversal
                       (Parameters, Component_List (Rdef),
                        Empty, Dummy_Counter);
                     Return_Constructed_TypeCode (RTE (RE_TC_Struct));
                  end;
               end if;

            elsif Is_Array_Type (Typ) then
               declare
                  Ndim           : constant Pos := Number_Dimensions (Typ);
                  Inner_TypeCode : Node_Id;
                  Constrained    : constant Boolean := Is_Constrained (Typ);
                  Indx           : Node_Id          := First_Index (Typ);

               begin
                  Inner_TypeCode :=
                    Build_TypeCode_Call (Loc, Component_Type (Typ), Decls);

                  for J in 1 .. Ndim loop
                     if Constrained then
                        Inner_TypeCode := Make_Constructed_TypeCode
                          (RTE (RE_TC_Array), New_List (
                            Build_To_Any_Call (
                              OK_Convert_To (RTE (RE_Long_Unsigned),
                                Make_Attribute_Reference (Loc,
                                  Prefix => New_Occurrence_Of (Typ, Loc),
                                  Attribute_Name => Name_Length,
                                  Expressions => New_List (
                                    Make_Integer_Literal (Loc,
                                      Intval => Ndim - J + 1)))),
                              Decls),
                            Build_To_Any_Call (Inner_TypeCode, Decls)));

                     else
                        --  Unconstrained case: add low bound for each
                        --  dimension.

                        Add_TypeCode_Parameter
                          (Build_TypeCode_Call (Loc, Etype (Indx), Decls),
                           Parameters);
                        Get_Name_String (New_External_Name ('L', J));
                        Add_String_Parameter (
                          String_From_Name_Buffer,
                          Parameters);
                        Next_Index (Indx);

                        Inner_TypeCode := Make_Constructed_TypeCode
                          (RTE (RE_TC_Sequence), New_List (
                            Build_To_Any_Call (
                              OK_Convert_To (RTE (RE_Long_Unsigned),
                                Make_Integer_Literal (Loc, 0)),
                              Decls),
                            Build_To_Any_Call (Inner_TypeCode, Decls)));
                     end if;
                  end loop;

                  if Constrained then
                     Return_Alias_TypeCode (Inner_TypeCode);
                  else
                     Add_TypeCode_Parameter (Inner_TypeCode, Parameters);
                     Start_String;
                     Store_String_Char ('V');
                     Add_String_Parameter (End_String, Parameters);
                     Return_Constructed_TypeCode (RTE (RE_TC_Struct));
                  end if;
               end;

            else
               --  Default: type is represented as an opaque sequence of bytes

               Return_Alias_TypeCode
                 (New_Occurrence_Of (RTE (RE_TC_Opaque), Loc));
            end if;

            Decl :=
              Make_Subprogram_Body (Loc,
                Specification              => Spec,
                Declarations               => Decls,
                Handled_Statement_Sequence =>
                  Make_Handled_Sequence_Of_Statements (Loc,
                    Statements => Stms));
         end Build_TypeCode_Function;

         ---------------------------------
         -- Find_Numeric_Representation --
         ---------------------------------

         function Find_Numeric_Representation
           (Typ : Entity_Id) return Entity_Id
         is
            FST    : constant Entity_Id := First_Subtype (Typ);
            P_Size : constant Uint      := Esize (FST);

         begin
            if Is_Unsigned_Type (Typ) then
               if P_Size <= Standard_Short_Short_Integer_Size then
                  return RTE (RE_Short_Short_Unsigned);

               elsif P_Size <= Standard_Short_Integer_Size then
                  return RTE (RE_Short_Unsigned);

               elsif P_Size <= Standard_Integer_Size then
                  return RTE (RE_Unsigned);

               elsif P_Size <= Standard_Long_Integer_Size then
                  return RTE (RE_Long_Unsigned);

               else
                  return RTE (RE_Long_Long_Unsigned);
               end if;

            elsif Is_Integer_Type (Typ) then
               if P_Size <= Standard_Short_Short_Integer_Size then
                  return Standard_Short_Short_Integer;

               elsif P_Size <= Standard_Short_Integer_Size then
                  return Standard_Short_Integer;

               elsif P_Size <= Standard_Integer_Size then
                  return Standard_Integer;

               elsif P_Size <= Standard_Long_Integer_Size then
                  return Standard_Long_Integer;

               else
                  return Standard_Long_Long_Integer;
               end if;

            elsif Is_Floating_Point_Type (Typ) then
               if P_Size <= Standard_Short_Float_Size then
                  return Standard_Short_Float;

               elsif P_Size <= Standard_Float_Size then
                  return Standard_Float;

               elsif P_Size <= Standard_Long_Float_Size then
                  return Standard_Long_Float;

               else
                  return Standard_Long_Long_Float;
               end if;

            else
               raise Program_Error;
            end if;

            --  TBD: fixed point types???
            --  TBverified numeric types with a biased representation???

         end Find_Numeric_Representation;

         ---------------------------
         -- Append_Array_Traversal --
         ---------------------------

         procedure Append_Array_Traversal
           (Stmts   : List_Id;
            Any     : Entity_Id;
            Counter : Entity_Id := Empty;
            Depth   : Pos       := 1)
         is
            Loc         : constant Source_Ptr := Sloc (Subprogram);
            Typ         : constant Entity_Id  := Etype (Arry);
            Constrained : constant Boolean    := Is_Constrained (Typ);
            Ndim        : constant Pos        := Number_Dimensions (Typ);

            Inner_Any, Inner_Counter : Entity_Id;

            Loop_Stm    : Node_Id;
            Inner_Stmts : constant List_Id := New_List;

         begin
            if Depth > Ndim then

               --  Processing for one element of an array

               declare
                  Element_Expr : constant Node_Id :=
                                   Make_Indexed_Component (Loc,
                                     New_Occurrence_Of (Arry, Loc),
                                     Indices);
               begin
                  Set_Etype (Element_Expr, Component_Type (Typ));
                  Add_Process_Element (Stmts,
                    Any     => Any,
                    Counter => Counter,
                    Datum   => Element_Expr);
               end;

               return;
            end if;

            Append_To (Indices,
              Make_Identifier (Loc, New_External_Name ('L', Depth)));

            if not Constrained or else Depth > 1 then
               Inner_Any := Make_Defining_Identifier (Loc,
                              New_External_Name ('A', Depth));
               Set_Etype (Inner_Any, RTE (RE_Any));
            else
               Inner_Any := Empty;
            end if;

            if Present (Counter) then
               Inner_Counter := Make_Defining_Identifier (Loc,
                                  New_External_Name ('J', Depth));
            else
               Inner_Counter := Empty;
            end if;

            declare
               Loop_Any : Node_Id := Inner_Any;

            begin
               --  For the first dimension of a constrained array, we add
               --  elements directly in the corresponding Any; there is no
               --  intervening inner Any.

               if No (Loop_Any) then
                  Loop_Any := Any;
               end if;

               Append_Array_Traversal (Inner_Stmts,
                 Any     => Loop_Any,
                 Counter => Inner_Counter,
                 Depth   => Depth + 1);
            end;

            Loop_Stm :=
              Make_Implicit_Loop_Statement (Subprogram,
                Iteration_Scheme =>
                  Make_Iteration_Scheme (Loc,
                    Loop_Parameter_Specification =>
                      Make_Loop_Parameter_Specification (Loc,
                        Defining_Identifier =>
                          Make_Defining_Identifier (Loc,
                            Chars => New_External_Name ('L', Depth)),

                        Discrete_Subtype_Definition =>
                          Make_Attribute_Reference (Loc,
                            Prefix         => New_Occurrence_Of (Arry, Loc),
                            Attribute_Name => Name_Range,

                            Expressions => New_List (
                              Make_Integer_Literal (Loc, Depth))))),
                Statements => Inner_Stmts);

            declare
               Decls       : constant List_Id := New_List;
               Dimen_Stmts : constant List_Id := New_List;
               Length_Node : Node_Id;

               Inner_Any_TypeCode : constant Entity_Id :=
                                      Make_Defining_Identifier (Loc,
                                        New_External_Name ('T', Depth));

               Inner_Any_TypeCode_Expr : Node_Id;

            begin
               if Depth = 1 then
                  if Constrained then
                     Inner_Any_TypeCode_Expr :=
                       Make_Function_Call (Loc,
                         Name => New_Occurrence_Of (RTE (RE_Get_TC), Loc),
                         Parameter_Associations => New_List (
                           New_Occurrence_Of (Any, Loc)));

                  else
                     Inner_Any_TypeCode_Expr :=
                       Make_Function_Call (Loc,
                         Name =>
                           New_Occurrence_Of (RTE (RE_Any_Member_Type), Loc),
                             Parameter_Associations => New_List (
                               New_Occurrence_Of (Any, Loc),
                               Make_Integer_Literal (Loc, Ndim)));
                  end if;

               else
                  Inner_Any_TypeCode_Expr :=
                    Make_Function_Call (Loc,
                      Name => New_Occurrence_Of (RTE (RE_Content_Type), Loc),
                      Parameter_Associations => New_List (
                        Make_Identifier (Loc,
                          Chars => New_External_Name ('T', Depth - 1))));
               end if;

               Append_To (Decls,
                 Make_Object_Declaration (Loc,
                   Defining_Identifier => Inner_Any_TypeCode,
                   Constant_Present    => True,
                   Object_Definition   => New_Occurrence_Of (
                                            RTE (RE_TypeCode), Loc),
                   Expression          => Inner_Any_TypeCode_Expr));

               if Present (Inner_Any) then
                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Inner_Any,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_Any), Loc),
                      Expression          =>
                        Make_Function_Call (Loc,
                          Name =>
                            New_Occurrence_Of (
                              RTE (RE_Create_Any), Loc),
                          Parameter_Associations => New_List (
                            New_Occurrence_Of (Inner_Any_TypeCode, Loc)))));
               end if;

               if Present (Inner_Counter) then
                  Append_To (Decls,
                    Make_Object_Declaration (Loc,
                      Defining_Identifier => Inner_Counter,
                      Object_Definition   =>
                        New_Occurrence_Of (RTE (RE_Long_Unsigned), Loc),
                      Expression          =>
                        Make_Integer_Literal (Loc, 0)));
               end if;

               if not Constrained then
                  Length_Node := Make_Attribute_Reference (Loc,
                        Prefix         => New_Occurrence_Of (Arry, Loc),
                        Attribute_Name => Name_Length,
                        Expressions    =>
                          New_List (Make_Integer_Literal (Loc, Depth)));
                  Set_Etype (Length_Node, RTE (RE_Long_Unsigned));

                  Add_Process_Element (Dimen_Stmts,
                    Datum   => Length_Node,
                    Any     => Inner_Any,
                    Counter => Inner_Counter);
               end if;

               --  Loop_Stm does appropriate processing for each element
               --  of Inner_Any.

               Append_To (Dimen_Stmts, Loop_Stm);

               --  Link outer and inner any

               if Present (Inner_Any) then
                  Add_Process_Element (Dimen_Stmts,
                    Any     => Any,
                    Counter => Counter,
                    Datum   => New_Occurrence_Of (Inner_Any, Loc));
               end if;

               Append_To (Stmts,
                 Make_Block_Statement (Loc,
                   Declarations =>
                     Decls,
                   Handled_Statement_Sequence =>
                     Make_Handled_Sequence_Of_Statements (Loc,
                       Statements => Dimen_Stmts)));
            end;
         end Append_Array_Traversal;

         -------------------------------
         -- Make_Helper_Function_Name --
         -------------------------------

         function Make_Helper_Function_Name
           (Loc : Source_Ptr;
            Typ : Entity_Id;
            Nam : Name_Id) return Entity_Id
         is
         begin
            declare
               Serial : Nat := 0;
               --  For tagged types, we use a canonical name so that it matches
               --  the primitive spec. For all other cases, we use a serialized
               --  name so that multiple generations of the same procedure do
               --  not clash.

            begin
               if not Is_Tagged_Type (Typ) then
                  Serial := Increment_Serial_Number;
               end if;

               --  Use prefixed underscore to avoid potential clash with used
               --  identifier (we use attribute names for Nam).

               return
                 Make_Defining_Identifier (Loc,
                   Chars =>
                     New_External_Name
                       (Related_Id => Nam,
                        Suffix => ' ', Suffix_Index => Serial,
                        Prefix => '_'));
            end;
         end Make_Helper_Function_Name;
      end Helpers;

      -----------------------------------
      -- Reserve_NamingContext_Methods --
      -----------------------------------

      procedure Reserve_NamingContext_Methods is
         Str_Resolve : constant String := "resolve";
      begin
         Name_Buffer (1 .. Str_Resolve'Length) := Str_Resolve;
         Name_Len := Str_Resolve'Length;
         Overload_Counter_Table.Set (Name_Find, 1);
      end Reserve_NamingContext_Methods;

   end PolyORB_Support;

   -------------------------------
   -- RACW_Type_Is_Asynchronous --
   -------------------------------

   procedure RACW_Type_Is_Asynchronous (RACW_Type : Entity_Id) is
      Asynchronous_Flag : constant Entity_Id :=
                            Asynchronous_Flags_Table.Get (RACW_Type);
   begin
      Replace (Expression (Parent (Asynchronous_Flag)),
        New_Occurrence_Of (Standard_True, Sloc (Asynchronous_Flag)));
   end RACW_Type_Is_Asynchronous;

   -------------------------
   -- RCI_Package_Locator --
   -------------------------

   function RCI_Package_Locator
     (Loc          : Source_Ptr;
      Package_Spec : Node_Id) return Node_Id
   is
      Inst     : Node_Id;
      Pkg_Name : String_Id;

   begin
      Get_Library_Unit_Name_String (Package_Spec);
      Pkg_Name := String_From_Name_Buffer;
      Inst :=
        Make_Package_Instantiation (Loc,
          Defining_Unit_Name   => Make_Temporary (Loc, 'R'),

          Name                 =>
            New_Occurrence_Of (RTE (RE_RCI_Locator), Loc),

          Generic_Associations => New_List (
            Make_Generic_Association (Loc,
              Selector_Name                     =>
                Make_Identifier (Loc, Name_RCI_Name),
              Explicit_Generic_Actual_Parameter =>
                Make_String_Literal (Loc,
                  Strval => Pkg_Name)),

            Make_Generic_Association (Loc,
              Selector_Name                     =>
                Make_Identifier (Loc, Name_Version),
              Explicit_Generic_Actual_Parameter =>
                Make_Attribute_Reference (Loc,
                  Prefix         =>
                    New_Occurrence_Of (Defining_Entity (Package_Spec), Loc),
                  Attribute_Name =>
                    Name_Version))));

      RCI_Locator_Table.Set
        (Defining_Unit_Name (Package_Spec),
         Defining_Unit_Name (Inst));
      return Inst;
   end RCI_Package_Locator;

   -----------------------------------------------
   -- Remote_Types_Tagged_Full_View_Encountered --
   -----------------------------------------------

   procedure Remote_Types_Tagged_Full_View_Encountered
     (Full_View : Entity_Id)
   is
      Stub_Elements : constant Stub_Structure :=
                        Stubs_Table.Get (Full_View);

   begin
      --  For an RACW encountered before the freeze point of its designated
      --  type, the stub type is generated at the point of the RACW declaration
      --  but the primitives are generated only once the designated type is
      --  frozen. That freeze can occur in another scope, for example when the
      --  RACW is declared in a nested package. In that case we need to
      --  reestablish the stub type's scope prior to generating its primitive
      --  operations.

      if Stub_Elements /= Empty_Stub_Structure then
         declare
            Saved_Scope : constant Entity_Id := Current_Scope;
            Stubs_Scope : constant Entity_Id :=
                            Scope (Stub_Elements.Stub_Type);

         begin
            if Current_Scope /= Stubs_Scope then
               Push_Scope (Stubs_Scope);
            end if;

            Add_RACW_Primitive_Declarations_And_Bodies
              (Full_View,
               Stub_Elements.RPC_Receiver_Decl,
               Stub_Elements.Body_Decls);

            if Current_Scope /= Saved_Scope then
               Pop_Scope;
            end if;
         end;
      end if;
   end Remote_Types_Tagged_Full_View_Encountered;

   -------------------
   -- Scope_Of_Spec --
   -------------------

   function Scope_Of_Spec (Spec : Node_Id) return Entity_Id is
      Unit_Name : Node_Id;

   begin
      Unit_Name := Defining_Unit_Name (Spec);
      while Nkind (Unit_Name) /= N_Defining_Identifier loop
         Unit_Name := Defining_Identifier (Unit_Name);
      end loop;

      return Unit_Name;
   end Scope_Of_Spec;

   ----------------------
   -- Set_Renaming_TSS --
   ----------------------

   procedure Set_Renaming_TSS
     (Typ     : Entity_Id;
      Nam     : Entity_Id;
      TSS_Nam : TSS_Name_Type)
   is
      Loc  : constant Source_Ptr := Sloc (Nam);
      Spec : constant Node_Id := Parent (Nam);

      TSS_Node : constant Node_Id :=
                   Make_Subprogram_Renaming_Declaration (Loc,
                     Specification =>
                       Copy_Specification (Loc,
                         Spec     => Spec,
                         New_Name => Make_TSS_Name (Typ, TSS_Nam)),
                       Name => New_Occurrence_Of (Nam, Loc));

      Snam : constant Entity_Id :=
               Defining_Unit_Name (Specification (TSS_Node));

   begin
      if Nkind (Spec) = N_Function_Specification then
         Set_Ekind (Snam, E_Function);
         Set_Etype (Snam, Entity (Result_Definition (Spec)));
      else
         Set_Ekind (Snam, E_Procedure);
         Set_Etype (Snam, Standard_Void_Type);
      end if;

      Set_TSS (Typ, Snam);
   end Set_Renaming_TSS;

   ----------------------------------------------
   -- Specific_Add_Obj_RPC_Receiver_Completion --
   ----------------------------------------------

   procedure Specific_Add_Obj_RPC_Receiver_Completion
     (Loc           : Source_Ptr;
      Decls         : List_Id;
      RPC_Receiver  : Entity_Id;
      Stub_Elements : Stub_Structure)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Add_Obj_RPC_Receiver_Completion
              (Loc, Decls, RPC_Receiver, Stub_Elements);
         when others =>
            GARLIC_Support.Add_Obj_RPC_Receiver_Completion
              (Loc, Decls, RPC_Receiver, Stub_Elements);
      end case;
   end Specific_Add_Obj_RPC_Receiver_Completion;

   --------------------------------
   -- Specific_Add_RACW_Features --
   --------------------------------

   procedure Specific_Add_RACW_Features
     (RACW_Type         : Entity_Id;
      Desig             : Entity_Id;
      Stub_Type         : Entity_Id;
      Stub_Type_Access  : Entity_Id;
      RPC_Receiver_Decl : Node_Id;
      Body_Decls        : List_Id)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Add_RACW_Features
              (RACW_Type,
               Desig,
               Stub_Type,
               Stub_Type_Access,
               RPC_Receiver_Decl,
               Body_Decls);

         when others =>
            GARLIC_Support.Add_RACW_Features
              (RACW_Type,
               Stub_Type,
               Stub_Type_Access,
               RPC_Receiver_Decl,
               Body_Decls);
      end case;
   end Specific_Add_RACW_Features;

   --------------------------------
   -- Specific_Add_RAST_Features --
   --------------------------------

   procedure Specific_Add_RAST_Features
     (Vis_Decl : Node_Id;
      RAS_Type : Entity_Id)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Add_RAST_Features (Vis_Decl, RAS_Type);
         when others =>
            GARLIC_Support.Add_RAST_Features (Vis_Decl, RAS_Type);
      end case;
   end Specific_Add_RAST_Features;

   --------------------------------------------------
   -- Specific_Add_Receiving_Stubs_To_Declarations --
   --------------------------------------------------

   procedure Specific_Add_Receiving_Stubs_To_Declarations
     (Pkg_Spec : Node_Id;
      Decls    : List_Id;
      Stmts    : List_Id)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Add_Receiving_Stubs_To_Declarations
              (Pkg_Spec, Decls, Stmts);
         when others =>
            GARLIC_Support.Add_Receiving_Stubs_To_Declarations
              (Pkg_Spec, Decls, Stmts);
      end case;
   end Specific_Add_Receiving_Stubs_To_Declarations;

   ------------------------------------------
   -- Specific_Build_General_Calling_Stubs --
   ------------------------------------------

   procedure Specific_Build_General_Calling_Stubs
     (Decls                     : List_Id;
      Statements                : List_Id;
      Target                    : RPC_Target;
      Subprogram_Id             : Node_Id;
      Asynchronous              : Node_Id   := Empty;
      Is_Known_Asynchronous     : Boolean   := False;
      Is_Known_Non_Asynchronous : Boolean   := False;
      Is_Function               : Boolean;
      Spec                      : Node_Id;
      Stub_Type                 : Entity_Id := Empty;
      RACW_Type                 : Entity_Id := Empty;
      Nod                       : Node_Id)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Build_General_Calling_Stubs
              (Decls,
               Statements,
               Target.Object,
               Subprogram_Id,
               Asynchronous,
               Is_Known_Asynchronous,
               Is_Known_Non_Asynchronous,
               Is_Function,
               Spec,
               Stub_Type,
               RACW_Type,
               Nod);

         when others =>
            GARLIC_Support.Build_General_Calling_Stubs
              (Decls,
               Statements,
               Target.Partition,
               Target.RPC_Receiver,
               Subprogram_Id,
               Asynchronous,
               Is_Known_Asynchronous,
               Is_Known_Non_Asynchronous,
               Is_Function,
               Spec,
               Stub_Type,
               RACW_Type,
               Nod);
      end case;
   end Specific_Build_General_Calling_Stubs;

   --------------------------------------
   -- Specific_Build_RPC_Receiver_Body --
   --------------------------------------

   procedure Specific_Build_RPC_Receiver_Body
     (RPC_Receiver : Entity_Id;
      Request      : out Entity_Id;
      Subp_Id      : out Entity_Id;
      Subp_Index   : out Entity_Id;
      Stmts        : out List_Id;
      Decl         : out Node_Id)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Build_RPC_Receiver_Body
              (RPC_Receiver,
               Request,
               Subp_Id,
               Subp_Index,
               Stmts,
               Decl);

         when others =>
            GARLIC_Support.Build_RPC_Receiver_Body
              (RPC_Receiver,
               Request,
               Subp_Id,
               Subp_Index,
               Stmts,
               Decl);
      end case;
   end Specific_Build_RPC_Receiver_Body;

   --------------------------------
   -- Specific_Build_Stub_Target --
   --------------------------------

   function Specific_Build_Stub_Target
     (Loc                   : Source_Ptr;
      Decls                 : List_Id;
      RCI_Locator           : Entity_Id;
      Controlling_Parameter : Entity_Id) return RPC_Target
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            return
              PolyORB_Support.Build_Stub_Target
                (Loc, Decls, RCI_Locator, Controlling_Parameter);

         when others =>
            return
              GARLIC_Support.Build_Stub_Target
                (Loc, Decls, RCI_Locator, Controlling_Parameter);
      end case;
   end Specific_Build_Stub_Target;

   ------------------------------
   -- Specific_Build_Stub_Type --
   ------------------------------

   procedure Specific_Build_Stub_Type
     (RACW_Type         : Entity_Id;
      Stub_Type_Comps   : out List_Id;
      RPC_Receiver_Decl : out Node_Id)
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            PolyORB_Support.Build_Stub_Type
              (RACW_Type, Stub_Type_Comps, RPC_Receiver_Decl);

         when others =>
            GARLIC_Support.Build_Stub_Type
              (RACW_Type, Stub_Type_Comps, RPC_Receiver_Decl);
      end case;
   end Specific_Build_Stub_Type;

   -----------------------------------------------
   -- Specific_Build_Subprogram_Receiving_Stubs --
   -----------------------------------------------

   function Specific_Build_Subprogram_Receiving_Stubs
     (Vis_Decl                 : Node_Id;
      Asynchronous             : Boolean;
      Dynamically_Asynchronous : Boolean   := False;
      Stub_Type                : Entity_Id := Empty;
      RACW_Type                : Entity_Id := Empty;
      Parent_Primitive         : Entity_Id := Empty) return Node_Id
   is
   begin
      case Get_PCS_Name is
         when Name_PolyORB_DSA =>
            return
              PolyORB_Support.Build_Subprogram_Receiving_Stubs
                (Vis_Decl,
                 Asynchronous,
                 Dynamically_Asynchronous,
                 Stub_Type,
                 RACW_Type,
                 Parent_Primitive);

         when others =>
            return
              GARLIC_Support.Build_Subprogram_Receiving_Stubs
                (Vis_Decl,
                 Asynchronous,
                 Dynamically_Asynchronous,
                 Stub_Type,
                 RACW_Type,
                 Parent_Primitive);
      end case;
   end Specific_Build_Subprogram_Receiving_Stubs;

   -------------------------------
   -- Transmit_As_Unconstrained --
   -------------------------------

   function Transmit_As_Unconstrained (Typ : Entity_Id) return Boolean is
   begin
      return
        not (Is_Elementary_Type (Typ) or else Is_Constrained (Typ))
          or else (Is_Access_Type (Typ) and then Can_Never_Be_Null (Typ));
   end Transmit_As_Unconstrained;

   --------------------------
   -- Underlying_RACW_Type --
   --------------------------

   function Underlying_RACW_Type (RAS_Typ : Entity_Id) return Entity_Id is
      Record_Type : Entity_Id;

   begin
      if Ekind (RAS_Typ) = E_Record_Type then
         Record_Type := RAS_Typ;
      else
         pragma Assert (Present (Equivalent_Type (RAS_Typ)));
         Record_Type := Equivalent_Type (RAS_Typ);
      end if;

      return
        Etype (Subtype_Indication
                (Component_Definition
                  (First (Component_Items
                           (Component_List
                             (Type_Definition
                               (Declaration_Node (Record_Type))))))));
   end Underlying_RACW_Type;

end Exp_Dist;