Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              E X P_ D I S T                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2011, 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 Errout;   use Errout;

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_Ch12; use Sem_Ch12;

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

   --  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, in the case of GARLIC, for 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.

   function Specific_RPC_Receiver_Decl

     (RACW_Type : Entity_Id) return Node_Id;

   --  Build the RPC receiver, for RACW, if applicable, else return 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;

      function RPC_Receiver_Decl (RACW_Type : Entity_Id) return 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;

      function RPC_Receiver_Decl (RACW_Type : Entity_Id) return 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.