home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / exp_dist.adb < prev    next >
Text File  |  1996-09-28  |  188KB  |  5,061 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                              E X P_ D I S T                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.27 $                             --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Atree;    use Atree;
  26. with Einfo;    use Einfo;
  27. with Fname;    use Fname;
  28. with Lib;      use Lib;
  29. with Lib.Load; use Lib.Load;
  30. with Nlists;   use Nlists;
  31. with Nmake;    use Nmake;
  32. with Namet;    use Namet;
  33. with Output;   use Output;
  34. with Rtsfind;  use Rtsfind;
  35. with Sem;      use Sem;
  36. with Sem_Dist; use Sem_Dist;
  37. with Sem_Util; use Sem_Util;
  38. with Sinfo;    use Sinfo;
  39. with Snames;   use Snames;
  40. with Sprint;   use Sprint;
  41. with Stringt;  use Stringt;
  42. with Tbuild;   use Tbuild;
  43. with Uintp;    use Uintp;
  44. with Uname;    use Uname;
  45.  
  46. package body Exp_Dist is
  47.  
  48.    ------------------------------------------
  49.    --  Global constants for external names --
  50.    ------------------------------------------
  51.  
  52.    Stream_Name                        : Name_Id;
  53.    Item_Name                          : Name_Id;
  54.    Params_Name                        : Name_Id;
  55.    Result_Name                        : Name_Id;
  56.    RPC_Receiver_Name                  : Name_Id;
  57.    Params_Stream_Type_Name            : Name_Id;
  58.    Do_Rpc_Name                        : Name_Id;
  59.    Do_Apc_Name                        : Name_Id;
  60.    Exceptions_Name                    : Name_Id;
  61.    Exception_Occurrence_Name          : Name_Id;
  62.    Null_Occurrence_Name               : Name_Id;
  63.    Reraise_Occurrence_Name            : Name_Id;
  64.    Subprogram_Id_Name                 : Name_Id;
  65.    Get_Active_Partition_Id_Name       : Name_Id;
  66.    Get_RCI_Package_Receiver_Name      : Name_Id;
  67.    Get_Local_Partition_Id_Name        : Name_Id;
  68.    Get_Passive_Partition_Id_Name      : Name_Id;
  69.    Register_Receiver_Elaboration_Name : Name_Id;
  70.    Root_Stream_Type_Name              : Name_Id;
  71.    Stream_Element_Count_Name          : Name_Id;
  72.    Partition_Interface_Name           : Name_Id;
  73.    Unchecked_Conversion_Name          : Name_Id;
  74.  
  75.    -----------------------------------------
  76.    -- Global constants for internal names --
  77.    -----------------------------------------
  78.  
  79.  
  80.    Stream_In_Name : Name_Id;
  81.    --  Name for stream input
  82.  
  83.    Stream_Out_Name : Name_Id;
  84.    --  Name for stream output
  85.  
  86.    Except_Name : Name_Id;
  87.    --  Name for exception occurence
  88.  
  89.    Returned_Val_Name : Name_Id;
  90.    --  Name for value returned by a function
  91.  
  92.    -----------------------
  93.    -- Local Subprograms --
  94.    -----------------------
  95.  
  96.    procedure Add_Racw_Stubs
  97.      (Vis_Decl      : Node_Id;
  98.       Pkg_Bdy_Decls : List_Id;
  99.       Last_Racw_Num : Int);
  100.    --  Builds and adds the calling stubs bodies for the primitive operations
  101.    --  of a racw type to the calling stubs package body declarations. Vis_Decl
  102.    --  is the declaration node of the racw type.
  103.  
  104.    procedure Add_System_Rpc (C_Unit : Node_Id);
  105.    --  Adds implicit with for system_rpc. Also appends system.rpc to the use
  106.    --  clause.
  107.  
  108.    procedure Add_With_Clause
  109.      (Nam    : in Node_Id;
  110.       CItems : in out List_Id);
  111.    --  Adds with clause for Nam to the specified context item list if not
  112.    --  already present.
  113.  
  114.    procedure Append_Nat_To_String (S : String; V : Nat);
  115.    --  Stores in the name buffer the result of the concatenation
  116.    --  S & Nat'image (N)
  117.  
  118.    procedure Build_Calling_Stubs_Pkg_Body
  119.      (Pkg_Decl       : in Node_Id;
  120.       Last_Stub_Num  : in out Int;
  121.       Last_Racw_Num  : in out Int;
  122.       Stubs_Pkg_Body : out Node_Id);
  123.    --  This procedure builds the calling stubs package body for a given
  124.    --  package declaration. Last_Stub_Num is the number given to the last
  125.    --  stub built. Last_Racw_Num is the number given to the last remote access
  126.    --  to class wide encountered. Pkg_Decl is the declaration node of a RCI
  127.    --  package or the node of a package declaration appearing in the visible
  128.    --  part of a RCI package declaration.
  129.  
  130.    procedure Build_Receiving_Stubs_Pkg_Body
  131.      (Unit_Node      : in Node_Id;
  132.       Last_Racw_Num  : in out Int;
  133.       Stubs_Pkg_Body : out Node_Id);
  134.    --  Builds the receiving stubs package body unit node. Unit_Node
  135.    --  is either the declaration node of a RCI package which requires no body
  136.    --  or a RCI package body node. Last_Racw_Num is the number given to the
  137.    --  last remote access to class wide encountered.
  138.  
  139.    procedure Remove_Categorizations (From : List_Id);
  140.    --  Removes categorization pragmas and pragma asynchonous from the
  141.    --  specified list.
  142.  
  143.    procedure Remove_Categor_And_Import (From : List_Id);
  144.    --  Remove categorization pragmas and the pragmas asynchonous, import,
  145.    --  interface, interface name  applied to the subprograms appearing in
  146.    --  the specified list.
  147.  
  148.    procedure Remove_Pragma_RCI (From : List_Id);
  149.    --  Remove the declaration of the pragma remote call interface
  150.    --  from the specified list.
  151.  
  152.    --  functions used to build the most used external name nodes.
  153.  
  154.    function Ada_Streams (Loc : Source_Ptr) return Node_Id;
  155.    --  returns the selected component ada.streams
  156.  
  157.    function Ada_Exceptions (Loc : Source_Ptr) return Node_Id;
  158.    --  returns the selected component ada.exceptions
  159.  
  160.    function System_Rpc (Loc : Source_Ptr) return Node_Id;
  161.    --  returns the selected component system.rpc
  162.  
  163.    function System_Rpc_PInterface (Loc : Source_Ptr) return Node_Id;
  164.    --  returns the selected component system.rpc.partition_interface
  165.  
  166.    function SR_Partition_ID (Loc : Source_Ptr) return Node_Id;
  167.    --  returns the selected component system.rpc.parition_id
  168.  
  169.    function SR_RPC_Receiver (Loc : Source_Ptr) return Node_Id;
  170.    --  returns the selected component system.rpc.rpc_receiver
  171.  
  172.    function SR_Params_Stream_Type (Loc : Source_Ptr) return Node_Id;
  173.    --  returns the selected component system.rpc.params_stream_type
  174.  
  175.    function SR_Do_Rpc (Loc : Source_Ptr) return Node_Id;
  176.    --  returns the selected component system.rpc.do_rpc
  177.  
  178.    function SR_Do_Apc (Loc : Source_Ptr) return Node_Id;
  179.    --  returns the selected component system.rpc.do_apc;
  180.  
  181.    function AE_Exception_Occurrence (Loc : Source_Ptr) return Node_Id;
  182.    --  returns the selected component ada.exceptions.exception_occurrence
  183.  
  184.    function AE_Null_Occurrence (Loc : Source_Ptr) return Node_Id;
  185.    --  returns the selected component ada.exceptions.null_occurrence
  186.  
  187.    function AE_Reraise_Occurrence (Loc : Source_Ptr) return Node_Id;
  188.    --  returns the selected component ada.exceptions.reraise_occurrence
  189.  
  190.    function AS_Root_Stream_Type (Loc : Source_Ptr) return Node_Id;
  191.    --  returns the selected component ada.streams.root_stream_type
  192.  
  193.    function SRP_Subprogram_Id (Loc : Source_Ptr) return Node_Id;
  194.    --  returns the selected component system.rpc.partition_interface.-
  195.    --  subprogram_id
  196.  
  197.    function SRP_Get_Local_Partition_Id (Loc : Source_Ptr) return Node_Id;
  198.    --  returns the selected component system.rpc.partition_interface.-
  199.    --  get_local_partition_id
  200.  
  201.    function SRP_Get_Active_Partition_Id (Loc : Source_Ptr) return Node_Id;
  202.    --  returns the selected component system.rpc.partition_interface.-
  203.    --  get_active_partition_id
  204.  
  205.    function SRP_Get_RCI_Package_Receiver (Loc : Source_Ptr) return Node_Id;
  206.    --  returns the selected component system.rpc.partition_interface.-
  207.    --  get_rci_package_receiver
  208.  
  209.    function SRP_Register_Receiver_Elaboration
  210.     (Loc  : Source_Ptr)
  211.      return Node_Id;
  212.    --  returns the selected component system.rpc.partition_interface.-
  213.    --  register_server_elaboration
  214.  
  215.    function Build_Parent_Full_Name (P : Node_Id)  return Node_Id;
  216.    --  Build prefix of child unit name. Recurse if needed.
  217.  
  218.    function Build_Unit_Full_Name (U : Node_Id) return Node_Id;
  219.    --  If the unit is a child unit, build name with all ancestors. otherwise,
  220.    --  returns a new reference to the unit name.
  221.  
  222.    function New_List_Copy_Original_Tree (L : List_Id) return List_Id;
  223.    --  Returns a new copy of the list. Uses Copy_Original_Node.
  224.  
  225.    function Find_Lib_Unit_Entity (Lib_Unit : Node_Id) return Entity_Id;
  226.    --  Retrieve the entity for various kinds of library unit nodes that
  227.    --  have different structure.
  228.  
  229.    function Get_Name_Id (Name : String) return Name_Id;
  230.    --  Returns the corresponding Name_Id for a given string;
  231.  
  232.    function Get_Pkg_Name_String_Id (Decl_Node : Node_Id) return String_Id;
  233.    --  Gets the full name of a package. Its parameter is the declaration
  234.    --  node of the package.
  235.  
  236.    function Get_String_Id (Val : String) return String_Id;
  237.    --  Returns the corresponding String_Id for a given string
  238.  
  239.    function Has_Pragma_RCI (L : List_Id) return Boolean;
  240.    --  Return true if L contains a pragma Remote_Call_Interface node.
  241.  
  242.    function Has_Unknown_Size (E : Entity_Id) return Boolean;
  243.    --  returns true if the type E is unconstrained or has unknown
  244.    --  discriminants.
  245.  
  246.    function Is_RCI_Pkg_Decl_Cunit (Cunit : Node_Id) return Boolean;
  247.    --  Returns true if the unit of Cunit is an RCI package declaration;
  248.    --  the parameter is supposed to be a compilation unit node;
  249.  
  250.    function AStub_Param_Specs (Loc : Source_Ptr) return List_Id;
  251.    --  returns a new parameter specification list for an asynchronous
  252.    --  receiving stub.
  253.  
  254.    function NStub_Param_Specs (Loc : Source_Ptr) return List_Id;
  255.    --  returns a new parameter specification list for a normal receiving stub
  256.  
  257.    function Racw_Read_Spec
  258.      (Loc       : Source_Ptr;
  259.       Racw_Type : Entity_Id)
  260.       return      Node_Id;
  261.    --  Builds a read operation specification for a given racw entity.
  262.  
  263.    function Racw_Write_Spec
  264.      (Loc       : Source_Ptr;
  265.       Racw_Type : Entity_Id)
  266.      return       Node_Id;
  267.    --  Builds a write operation specification for a given racw entity.
  268.  
  269.    ------------------
  270.    --  Add_Racw_RW --
  271.    ------------------
  272.  
  273.    procedure Add_Racw_RW (N : Node_Id) is
  274.       Loc       : Source_Ptr := Sloc (N);
  275.       Racw_Type : Entity_Id  := Defining_Identifier (N);
  276.       L         : List_Id    := New_List;
  277.  
  278.    begin
  279.       --  Append read procedure spec
  280.  
  281.       Append_To (L,
  282.         Make_Subprogram_Declaration (Loc,
  283.           Specification =>
  284.             Make_Procedure_Specification (Loc,
  285.               Defining_Unit_Name => Make_Defining_Identifier (Loc, Name_Read),
  286.               Parameter_Specifications => New_List (
  287.  
  288.                 Make_Parameter_Specification (Loc,
  289.                   Defining_Identifier =>
  290.                     Make_Defining_Identifier (Loc, Stream_Name),
  291.                   Parameter_Type =>
  292.                     Make_Access_Definition (Loc,
  293.                       Subtype_Mark =>
  294.                         Make_Attribute_Reference (Loc,
  295.                           Prefix =>
  296.                             New_Reference_To (RTE (RE_Root_Stream_Type), Loc),
  297.                           Attribute_Name => Name_Class))),
  298.  
  299.                 Make_Parameter_Specification (Loc,
  300.                   Defining_Identifier =>
  301.                     Make_Defining_Identifier (Loc, Item_Name),
  302.                   Out_Present => True,
  303.                   Parameter_Type =>
  304.                     New_Reference_To (Racw_Type, Loc))))));
  305.  
  306.       --  Append read attribute representation clause
  307.  
  308.       Append_To (L,
  309.         Make_Attribute_Definition_Clause (Loc,
  310.           Name => New_Reference_To (Racw_Type, Loc),
  311.           Chars => Name_Read,
  312.           Expression => Make_Identifier (Loc, Name_Read)));
  313.  
  314.       --  Append write procedure spec
  315.  
  316.       Append_To (L,
  317.         Make_Subprogram_Declaration (Loc,
  318.           Specification =>
  319.             Make_Procedure_Specification (Loc,
  320.               Defining_Unit_Name => Make_Defining_Identifier (Loc, Name_Write),
  321.               Parameter_Specifications => New_List (
  322.  
  323.                 Make_Parameter_Specification (Loc,
  324.                   Defining_Identifier =>
  325.                     Make_Defining_Identifier (Loc, Stream_Name),
  326.                   Parameter_Type =>
  327.                     Make_Access_Definition (Loc,
  328.                       Subtype_Mark =>
  329.                         Make_Attribute_Reference (Loc,
  330.                           Prefix =>
  331.                             New_Reference_To (RTE (RE_Root_Stream_Type), Loc),
  332.                           Attribute_Name => Name_Class))),
  333.  
  334.                 Make_Parameter_Specification (Loc,
  335.                   Defining_Identifier =>
  336.                     Make_Defining_Identifier (Loc, Item_Name),
  337.                   Parameter_Type =>
  338.                     New_Reference_To (Racw_Type, Loc))))));
  339.  
  340.       --  Append write attribute representation clause
  341.  
  342.       Append_To (L,
  343.         Make_Attribute_Definition_Clause (Loc,
  344.           Name => New_Reference_To (Racw_Type, Loc),
  345.           Chars => Name_Write,
  346.           Expression => Make_Identifier (Loc, Name_Write)));
  347.  
  348.       --  Insert newly built nodes in the tree
  349.  
  350.       Insert_List_After (N, L);
  351.  
  352.    end Add_Racw_RW;
  353.  
  354.    --------------------
  355.    -- Add_Racw_Stubs --
  356.    --------------------
  357.  
  358.    procedure Add_Racw_Stubs
  359.      (Vis_Decl      : Node_Id;
  360.       Pkg_bdy_Decls : List_Id;
  361.       Last_Racw_Num : Int)
  362.    is
  363.       --  Information needed from the input declaration
  364.  
  365.       Loc                : Source_Ptr := Sloc (Vis_Decl);
  366.       Racw_Type          : Entity_Id  := Defining_Identifier (Vis_Decl);
  367.       Root_Type          : Entity_Id  := Etype (Directly_Designated_Type (
  368.                                                 Racw_Type));
  369.       Root_Type_Decl     : Node_Id := Parent (Root_Type);
  370.       Root_Pkg_Spec      : Node_Id := Parent (Root_Type_Decl);
  371.       Root_Pkg_Decl      : Node_Id := Parent (Root_Pkg_Spec);
  372.       Root_Pkg           : Node_Id := Defining_Unit_Name (Root_Pkg_Spec);
  373.       Root_Pkg_Vis_Decls : List_Id := Visible_Declarations (Root_Pkg_Spec);
  374.       Async              : Boolean := Is_Asynchronous (Racw_Type);
  375.       Decl               : Node_Id;
  376.  
  377.       --  List of local names needed
  378.  
  379.       Receiving_Stub_Name : Name_Id := Get_Name_Id ("receiving");
  380.       Param_Name          : Name_Id := New_Internal_Name ('X');
  381.       Origin_Name         : Name_Id := Get_Name_Id ("origin");
  382.       Receiver_Name       : Name_Id := Get_Name_Id ("receiver");
  383.       Addr_Name           : Name_Id := Get_Name_Id ("addr");
  384.       P_Name              : Name_Id := New_Internal_Name ('P');
  385.       F_Name              : Name_Id := New_Internal_Name ('F');
  386.       R_Name              : Name_Id := New_Internal_Name ('R');
  387.       A_Name              : Name_Id := New_Internal_Name ('A');
  388.       V_Name              : Name_Id := New_Internal_Name ('V');
  389.       Object_Stub_Name    : Name_Id
  390.         := New_External_Name (
  391.              Related_Id   => Get_Name_Id ("object_stub"),
  392.              Suffix       => 'T',
  393.              Suffix_Index => Last_Racw_Num);
  394.  
  395.       Object_Stub_Access_Name : Name_Id
  396.         := New_External_Name (
  397.              Related_Id   => Get_Name_Id ("object_stub_access"),
  398.              Suffix       => 'T',
  399.              Suffix_Index => Last_Racw_Num);
  400.  
  401.       --  Variable for object stub and access to object stub declarations
  402.  
  403.       Obj_Stub_Decl        : Node_Id;
  404.       Acc_To_Obj_Stub_Decl : Node_Id;
  405.  
  406.       --  Variable for primitive operation stubs
  407.  
  408.       Racw_CStub_Spec : Node_Id;
  409.       Racw_CStub_Body : Node_Id;
  410.       Racw_RStub_Spec : Node_Id;
  411.       Racw_RStub_Body : Node_Id;
  412.  
  413.       --  Features for the dispatching receiver
  414.  
  415.       Dispatcher_Name  : Name_Id;
  416.       Dispatcher_Spec  : Node_Id;
  417.       Dispatcher_Body  : Node_Id;
  418.       Param_Assocs     : List_Id := New_List;
  419.       Dispatcher_Decls : List_Id := New_List;
  420.       Case_Stmt_Alts   : List_Id := New_List;
  421.       Prim_Op_Num_Name : Name_Id := New_Internal_Name ('N');
  422.  
  423.       --  Number used to identify a primitive operation of Root_Type.
  424.  
  425.       Prim_Op_Num : Int := 0;
  426.  
  427.       -----------------------
  428.       -- Local Subprograms --
  429.       -----------------------
  430.  
  431.       function Build_Async_Calling_Stub_Body
  432.         (Vis_Decl : Node_Id)
  433.          return  Node_Id;
  434.       --  Builds the body of the calling stub for an asynchronous racw
  435.       --  procedure
  436.  
  437.       function Build_Async_Receiving_Stub_Body
  438.         (Vis_Decl : Node_Id)
  439.          return     Node_Id;
  440.       --  Builds the body node of the receiving stub for an asynchronous
  441.       --  Racw procedure
  442.  
  443.       function Build_Calling_Stub_Body (Vis_Decl : Node_Id) return Node_Id;
  444.       --  Builds the body of the calling stub for a primitive operation of
  445.       --  a racw type.
  446.  
  447.       function Build_Receiving_Stub_Body
  448.         (Vis_Decl : Node_Id)
  449.          return     Node_Id;
  450.       --  Builds the body node of the receiving stub for a regular Racw
  451.       --  subprogram.
  452.  
  453.       function Find_Disp_Param_Spec (L : List_Id) return Node_Id;
  454.       --  Scans the parameter specification list L and returns the first
  455.       --  parameter specification node whose parameter type is the Racw
  456.       --  type. Returns Empty if the list contains no such parameter type.
  457.  
  458.       function Has_Access_To_Root_Type (L : List_Id) return Boolean;
  459.       --  Returns true if at list one of the parameter types in the
  460.       --  parameter specification list L is an access definition to
  461.       --  Root type.
  462.  
  463.       function Is_Disp_Param_Spec (Param_Spec : Node_Id) return Boolean;
  464.       --  Returns true if the parameter specification is an access
  465.       --  definition to the root type.
  466.  
  467.       -----------------------------------
  468.       -- Build_Async_Calling_Stub_Body --
  469.       -----------------------------------
  470.  
  471.       function Build_Async_Calling_Stub_Body
  472.         (Vis_Decl : Node_Id)
  473.          return     Node_Id
  474.       is
  475.          --  Information needed from the input parameter
  476.  
  477.          Subp_Spec       : Node_Id := Specification (Vis_Decl);
  478.          Param_Specs     : List_Id := Parameter_Specifications (Subp_Spec);
  479.          Subp_Name       : Node_Id := Defining_Unit_Name (Subp_Spec);
  480.          Disp_Param_Spec : Node_Id := Find_Disp_Param_Spec (Param_Specs);
  481.          Param_Spec      : Node_Id;
  482.          Param_Type      : Node_Id;
  483.  
  484.          --  Building new entities for the local identifiers
  485.  
  486.          Stream_In   : Entity_Id;
  487.          Object_Stub : Entity_Id;
  488.          Origin      : Entity_Id;
  489.          Receiver    : Entity_Id;
  490.          Addr        : Entity_Id;
  491.  
  492.          --  Features for the stub body to create
  493.  
  494.          Stmts            : List_Id := New_List;
  495.          Write_Stmts      : List_Id := New_List;
  496.          Decls            : List_Id := New_List;
  497.          Stub_Param_Specs : List_Id := New_List;
  498.          Stub_Spec        : Node_Id;
  499.          Stub_Body        : Node_Id;
  500.          Stream_Decl      : Node_Id;
  501.  
  502.       begin
  503.          --  Initialization of the local entities
  504.  
  505.          Stream_In   :=
  506.            Make_Defining_Identifier (Loc, Stream_In_Name);
  507.  
  508.          Object_Stub :=
  509.            Make_Defining_Identifier (Loc, Object_Stub_Name);
  510.  
  511.          Origin      :=
  512.            Make_Defining_Identifier (Loc, Origin_Name);
  513.  
  514.          Receiver    :=
  515.            Make_Defining_Identifier (Loc, Receiver_Name);
  516.  
  517.          Addr        :=
  518.            Make_Defining_Identifier (Loc, Addr_Name);
  519.  
  520.          --  Build and append stream input declaration to the list of
  521.          --  declarations of the stub body
  522.  
  523.          Stream_Decl :=
  524.            Make_Object_Declaration (Loc,
  525.              Defining_Identifier => New_Reference_To (Stream_In, Loc),
  526.              Object_Definition =>
  527.                Make_Subtype_Indication (Loc,
  528.                  Subtype_Mark => SR_Params_Stream_Type (Loc),
  529.  
  530.                Constraint =>
  531.                  Make_Index_Or_Discriminant_Constraint (Loc,
  532.                    Constraints =>
  533.                      New_List (Make_Integer_Literal (Loc, Uint_0)))));
  534.  
  535.          Set_Aliased_Present (Stream_Decl);
  536.          Append (Stream_Decl, Decls);
  537.  
  538.          --  Build and append the write statement for the Receiver, to the
  539.          --  list of statements of the stub body
  540.  
  541.          Append_To (Stmts,
  542.            Make_Procedure_Call_Statement (Loc,
  543.              Name =>
  544.                Make_Attribute_Reference (Loc,
  545.                  Prefix => SR_RPC_Receiver (Loc),
  546.                  Attribute_Name => Name_Write),
  547.  
  548.              Parameter_Associations => New_List (
  549.                Make_Attribute_Reference (Loc,
  550.                  Prefix => New_Reference_To (Stream_In, Loc),
  551.                  Attribute_Name => Name_Unchecked_Access),
  552.  
  553.                Make_Selected_Component (Loc,
  554.                  Prefix =>
  555.                    Make_Identifier (Loc,
  556.                      Chars => Chars (
  557.                        Defining_Identifier (Disp_Param_Spec))),
  558.                  Selector_Name => New_Reference_To (Receiver, Loc)))));
  559.  
  560.          --  Write statement for the subprogram identifier
  561.  
  562.          Append_To (Stmts,
  563.            Make_Procedure_Call_Statement (Loc,
  564.              Name =>
  565.                Make_Attribute_Reference (Loc,
  566.                  Prefix => SRP_Subprogram_Id (Loc),
  567.                  Attribute_Name => Name_Write),
  568.  
  569.              Parameter_Associations => New_List (
  570.                Make_Attribute_Reference (Loc,
  571.                  Prefix => New_Reference_To (Stream_In, Loc),
  572.                  Attribute_Name => Name_Unchecked_Access),
  573.  
  574.                --  Type conversion necessary ???
  575.  
  576.                --  Make_Type_Conversion (Loc,
  577.                   --  SRP_Subprogram_Id (loc),
  578.  
  579.                Make_Integer_Literal (Loc, UI_From_Int (Prim_Op_Num)))));
  580.  
  581.          --  Append the write statements for the in parameters
  582.  
  583.          if Param_Specs /= No_List then
  584.             Param_Spec := First (Param_Specs);
  585.             while Present (Param_Spec) loop
  586.  
  587.                if Is_Disp_Param_Spec (Param_Spec) then
  588.  
  589.                   Append_To (Stub_Param_Specs,
  590.                     Make_Parameter_Specification (Loc,
  591.                       Defining_Identifier =>
  592.                         Make_Defining_Identifier (Loc,
  593.                           Chars =>
  594.                             Chars (Defining_Identifier (Param_Spec))),
  595.  
  596.                       Parameter_Type =>
  597.                         Make_Access_Definition (Loc,
  598.                           Subtype_Mark =>
  599.                             New_Reference_To (Object_Stub, Loc)),
  600.  
  601.                       Expression =>
  602.                         Copy_Original_Tree (Expression (Param_Spec))));
  603.  
  604.                   Append_To (Stmts,
  605.                     Make_Procedure_Call_Statement (Loc,
  606.                       Name =>
  607.                         Make_Attribute_Reference (Loc,
  608.                           Prefix =>
  609.                             Make_Selected_Component (Loc,
  610.                               Prefix => Make_Identifier (Loc, Name_System),
  611.                               Selector_Name =>
  612.                                 Make_Identifier (Loc, Name_Address)),
  613.                           Attribute_Name => Name_Write),
  614.  
  615.                       Parameter_Associations =>
  616.                         New_List (
  617.                           Make_Attribute_Reference (Loc,
  618.                             Prefix => New_Reference_To (Stream_In, Loc),
  619.                             Attribute_Name => Name_Unchecked_Access),
  620.  
  621.                           Make_Selected_Component (Loc,
  622.                             Prefix =>
  623.                               Make_Identifier (Loc,
  624.                                 Chars => Chars (
  625.                                   Defining_Identifier (Param_Spec))),
  626.  
  627.                             Selector_Name =>
  628.                               Make_Identifier (Loc, Addr_Name)))));
  629.  
  630.                else
  631.                   Append_To (Stub_Param_Specs,
  632.                     Copy_Original_Tree (Param_Spec));
  633.  
  634.                   if Has_Unknown_Size (Etype
  635.                     (Parameter_Type (Param_Spec)))
  636.                   then
  637.                      Append_To (Stmts,
  638.                        Make_Procedure_Call_Statement (Loc,
  639.                          Name =>
  640.                            Make_Attribute_Reference (Loc,
  641.                              Prefix => Parameter_Type (Param_Spec),
  642.                              Attribute_Name => Name_Output),
  643.  
  644.                          Parameter_Associations =>
  645.                            New_List (
  646.                              Make_Attribute_Reference (Loc,
  647.                                Prefix => New_Reference_To (Stream_In, Loc),
  648.                                Attribute_Name => Name_Unchecked_Access),
  649.                              Make_Identifier (Loc,
  650.                                Chars => Chars (
  651.                                  Defining_Identifier (Param_Spec))))));
  652.  
  653.                   else
  654.                      Append_To (Write_Stmts,
  655.                        Make_Procedure_Call_Statement (Loc,
  656.                          Name =>
  657.                            Make_Attribute_Reference (Loc,
  658.                              Prefix => Parameter_Type (Param_Spec),
  659.                              Attribute_Name => Name_Write),
  660.  
  661.                          Parameter_Associations =>
  662.                            New_List (
  663.                              Make_Attribute_Reference (Loc,
  664.                                Prefix => New_Reference_To (Stream_In, Loc),
  665.                                Attribute_Name => Name_Unchecked_Access),
  666.                              Make_Identifier (Loc,
  667.                                Chars => Chars (
  668.                                  Defining_Identifier (Param_Spec))))));
  669.                   end if;
  670.                end if;
  671.  
  672.                Param_Spec := Next (Param_Spec);
  673.             end loop;
  674.          end if;
  675.  
  676.          Append_List (Write_Stmts, Stmts);
  677.  
  678.          --  Append Do_Apc call to the list of statements
  679.  
  680.          Append_To (Stmts,
  681.            Make_Procedure_Call_Statement (Loc,
  682.              Name => SR_Do_Apc (Loc),
  683.              Parameter_Associations => New_List (
  684.                Make_Selected_Component (Loc,
  685.                  Prefix =>
  686.                    Make_Identifier (Loc,
  687.                      Chars => Chars (
  688.                        Defining_Identifier (Disp_Param_Spec))),
  689.                  Selector_Name => New_Reference_To (Origin, Loc)),
  690.  
  691.                Make_Attribute_Reference (Loc,
  692.                  Prefix => New_Reference_To (Stream_In, Loc),
  693.                  Attribute_Name => Name_Unchecked_Access))));
  694.  
  695.          --  Build the stub specification node
  696.  
  697.          Stub_Spec :=
  698.            Make_Procedure_Specification (Loc,
  699.              Defining_Unit_Name =>
  700.                Copy_Original_Tree (Defining_Unit_Name (Subp_Spec)),
  701.              Parameter_Specifications => Stub_Param_Specs);
  702.  
  703.          --  Build the stub body node
  704.  
  705.          Stub_Body :=
  706.            Make_Subprogram_Body (Loc,
  707.              Specification => Stub_Spec,
  708.              Declarations => Decls,
  709.              Handled_Statement_Sequence =>
  710.                Make_Handled_Sequence_Of_Statements (Loc,
  711.                  Statements => Stmts));
  712.  
  713.          return Stub_Body;
  714.  
  715.       end Build_Async_Calling_Stub_Body;
  716.  
  717.       -------------------------------------
  718.       -- Build_Async_Receiving_Stub_Body --
  719.       -------------------------------------
  720.  
  721.       function Build_Async_Receiving_Stub_Body
  722.         (Vis_Decl : Node_Id)
  723.          return     Node_Id
  724.       is
  725.          --  Information needed from the input declaration
  726.  
  727.          Subp_Spec   : Node_Id := Specification (Vis_Decl);
  728.          Param_Specs : List_Id := Parameter_Specifications (Subp_Spec);
  729.          Subp_Name   : Node_Id := Defining_Unit_Name (Subp_Spec);
  730.          Param_Spec  : Node_Id;
  731.          Param       : Entity_Id;
  732.          Param_Type  : Node_Id;
  733.  
  734.          --  New entities for the local identifiers
  735.  
  736.          Params      : Entity_Id;
  737.  
  738.          --  Features for the stub body to create
  739.  
  740.          Decls             : List_Id := New_List;
  741.          Stmts             : List_Id := New_List;
  742.          Hss               : Node_Id;
  743.          Stub_Spec         : Node_Id;
  744.          Stub_Body         : Node_Id;
  745.          Param_List        : List_Id := New_List;
  746.          Param_Read_Stmts  : List_Id := New_List;
  747.  
  748.       begin
  749.          --  Initialization of the external entities
  750.  
  751.          Params :=
  752.            Make_Defining_Identifier (Loc, Params_Name);
  753.  
  754.          --  Build the stub specification node
  755.  
  756.          Stub_Spec :=
  757.            Make_Procedure_Specification (Loc,
  758.              Defining_Unit_Name =>
  759.                Make_Identifier (Loc,
  760.                  Chars =>
  761.                    New_External_Name (
  762.                      Related_Id   => Receiving_Stub_Name,
  763.                      Suffix       => 'S',
  764.                      Suffix_Index => Prim_Op_Num)),
  765.  
  766.              Parameter_Specifications => AStub_Param_Specs (Loc));
  767.  
  768.          --  Build the stub body node
  769.  
  770.          Append_To (Decls,
  771.            Make_Object_Declaration (Loc,
  772.              Defining_Identifier => Make_Identifier (Loc, Addr_Name),
  773.              Object_Definition =>
  774.                Make_Selected_Component (Loc,
  775.                  Prefix => Make_Identifier (Loc, Name_System),
  776.                  Selector_Name => Make_Identifier (Loc, Name_Address))));
  777.  
  778.          if Param_Specs /= No_List then
  779.             Param_Spec := First (Param_Specs);
  780.             while Present (Param_Spec) loop
  781.  
  782.                Param_Type := Parameter_Type (Param_Spec);
  783.                Param :=
  784.                  Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
  785.                Append (Param, Param_List);
  786.  
  787.                if Is_Disp_Param_Spec (Param_Spec) then
  788.  
  789.                   Append_To (Decls,
  790.                     Make_Object_Declaration (Loc,
  791.                       Defining_Identifier =>
  792.                         New_Reference_To (Param, Loc),
  793.                       Object_Definition =>
  794.                         Make_Identifier (Loc, Chars (Racw_Type))));
  795.  
  796.                   Append_To (Param_Read_Stmts,
  797.                     Make_Procedure_Call_Statement (Loc,
  798.                       Name =>
  799.                         Make_Attribute_Reference (Loc,
  800.                           Prefix =>
  801.                             Make_Selected_Component (Loc,
  802.                               Prefix => Make_Identifier (Loc, Name_System),
  803.                               Selector_Name =>
  804.                                 Make_Identifier (Loc, Name_Address)),
  805.                           Attribute_Name => Name_Read),
  806.  
  807.                       Parameter_Associations =>
  808.                         New_List (
  809.                           Make_Identifier (Loc, Params_Name),
  810.                           Make_Identifier (Loc, Addr_Name))));
  811.  
  812.                   Append_To (Param_Read_Stmts,
  813.                     Make_Assignment_Statement (Loc,
  814.                       Name => Make_Identifier (Loc, Chars (Param)),
  815.                       Expression =>
  816.                         Make_Function_Call (Loc,
  817.                           Name => Make_Identifier (Loc, F_Name),
  818.                           Parameter_Associations => New_List (
  819.                             Make_Identifier (Loc, Addr_Name)))));
  820.  
  821.                elsif Has_Unknown_Size (Etype (Param_Type)) then
  822.  
  823.                   Append_To (Decls,
  824.                     Make_Object_Declaration (Loc,
  825.                       Defining_Identifier =>
  826.                         New_Reference_To (Param, Loc),
  827.                       Object_Definition => Copy_Original_Tree (Param_Type),
  828.  
  829.                       Expression =>
  830.                         Make_Function_Call (Loc,
  831.                           Name => Make_Attribute_Reference (Loc,
  832.                             Prefix => Copy_Original_Tree (Param_Type),
  833.                             Attribute_Name => Name_Input),
  834.  
  835.                           Parameter_Associations =>
  836.                             New_List (
  837.                               Make_Identifier (Loc, Params_Name)))));
  838.  
  839.                else
  840.                   Append_To (Decls,
  841.                     Make_Object_Declaration (Loc,
  842.                       Defining_Identifier =>
  843.                         New_Reference_To (Param, Loc),
  844.                       Object_Definition =>
  845.                         Copy_Original_Tree (Param_Type)));
  846.  
  847.                   Append_To (Param_Read_Stmts,
  848.                     Make_Procedure_Call_Statement (Loc,
  849.                       Name =>
  850.                         Make_Attribute_Reference (Loc,
  851.                           Prefix => Copy_Original_Tree (Param_Type),
  852.                           Attribute_Name => Name_Read),
  853.  
  854.                       Parameter_Associations =>
  855.                         New_List (
  856.                           Make_Identifier (Loc, Chars (Params)),
  857.                           Make_Identifier (Loc, Chars (Param)))));
  858.                end if;
  859.  
  860.                Param_Spec := Next (Param_Spec);
  861.             end loop;
  862.          end if;
  863.  
  864.          Stmts := Param_Read_Stmts;
  865.  
  866.          Append_To (Stmts,
  867.            Make_Procedure_Call_Statement (Loc,
  868.              Name =>
  869.                Make_Selected_Component (Loc,
  870.                  Prefix => Build_Unit_Full_Name (Root_Pkg_Decl),
  871.                  Selector_Name => Copy_Original_Tree (Subp_Name)),
  872.              Parameter_Associations => Param_List));
  873.  
  874.          Hss :=
  875.            Make_Handled_Sequence_Of_Statements (Loc,
  876.              Statements => Stmts,
  877.              Exception_Handlers => New_List (
  878.                Make_Exception_Handler (Loc,
  879.                  Exception_Choices => New_List (Make_Others_Choice (Loc)),
  880.                  Statements => New_List (Make_Null_Statement (Loc)))));
  881.  
  882.          Stub_Body :=
  883.            Make_Subprogram_Body (Loc,
  884.              Specification => Stub_Spec,
  885.              Declarations  => Decls,
  886.              Handled_Statement_Sequence => Hss);
  887.  
  888.          return Stub_Body;
  889.       end Build_Async_Receiving_Stub_Body;
  890.  
  891.       -------------------------------
  892.       -- Build_Receiving_Stub_Body --
  893.       -------------------------------
  894.  
  895.       function Build_Receiving_Stub_Body
  896.         (Vis_Decl : Node_Id)
  897.          return     Node_Id
  898.       is
  899.          --  Information needed from the input declaration
  900.  
  901.          Subp_Spec   : Node_Id := Specification (Vis_Decl);
  902.          Param_Specs : List_Id := Parameter_Specifications (Subp_Spec);
  903.          Subp_Name   : Node_Id := Defining_Unit_Name (Subp_Spec);
  904.          Param_Spec  : Node_Id;
  905.          Param       : Entity_Id;
  906.          Param_Type  : Node_Id;
  907.  
  908.          --  New entities for the local identifiers
  909.  
  910.          Params        : Entity_Id;
  911.          Result        : Entity_Id;
  912.          Returned_Val  : Entity_Id;
  913.          Except        : Entity_Id;
  914.  
  915.          --  Features for the stub body to create
  916.  
  917.          Decls             : List_Id := New_List;
  918.          Stmts             : List_Id := New_List;
  919.          Hss               : Node_Id;
  920.          Stub_Spec         : Node_Id;
  921.          Stub_Body         : Node_Id;
  922.          Param_List        : List_Id := New_List;
  923.          Param_Read_Stmts  : List_Id := New_List;
  924.          Param_Write_Stmts : List_Id := New_List;
  925.  
  926.       begin
  927.          --  Initialization of the local entities
  928.  
  929.          Params := Make_Defining_Identifier (Loc, Params_Name);
  930.          Result := Make_Defining_Identifier (Loc, Result_Name);
  931.          Returned_Val := Make_Defining_Identifier (Loc, Returned_Val_Name);
  932.          Except := Make_Defining_Identifier (Loc, Except_Name);
  933.  
  934.          --  Build the stub specification node
  935.  
  936.          Stub_Spec :=
  937.            Make_Procedure_Specification (Loc,
  938.              Defining_Unit_Name =>
  939.                Make_Identifier (Loc,
  940.                  Chars =>
  941.                    New_External_Name (
  942.                      Related_Id => Receiving_Stub_Name,
  943.                      Suffix       => 'S',
  944.                      Suffix_Index => Prim_Op_Num)),
  945.              Parameter_Specifications => NStub_Param_Specs (Loc));
  946.  
  947.          --  Build the stub body node
  948.  
  949.          Append_To (Decls,
  950.            Make_Object_Declaration (Loc,
  951.              Defining_Identifier => Make_Identifier (Loc, Addr_Name),
  952.              Object_Definition =>
  953.                Make_Selected_Component (Loc,
  954.                  Prefix => Make_Identifier (Loc, Name_System),
  955.                  Selector_Name => Make_Identifier (Loc, Name_Address))));
  956.  
  957.          if Param_Specs /= No_List then
  958.             Param_Spec := First (Param_Specs);
  959.  
  960.             while Present (Param_Spec) loop
  961.                Param :=
  962.                  Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
  963.                Param_Type := Parameter_Type (Param_Spec);
  964.  
  965.                Append (Param, Param_List);
  966.  
  967.                if Is_Disp_Param_Spec (Param_Spec) then
  968.  
  969.                   Append_To (Decls,
  970.                     Make_Object_Declaration (Loc,
  971.                       Defining_Identifier =>
  972.                         New_Reference_To (Param, Loc),
  973.                       Object_Definition   =>
  974.                         Make_Identifier (Loc, Chars (Racw_Type))));
  975.  
  976.                   Append_To (Param_Read_Stmts,
  977.                     Make_Procedure_Call_Statement (Loc,
  978.                       Name =>
  979.                         Make_Attribute_Reference (Loc,
  980.                           Prefix =>
  981.                             Make_Selected_Component (Loc,
  982.                               Prefix => Make_Identifier (Loc, Name_System),
  983.                               Selector_Name =>
  984.                                 Make_Identifier (Loc, Name_Address)),
  985.                           Attribute_Name => Name_Read),
  986.  
  987.                       Parameter_Associations =>
  988.                         New_List (
  989.                           Make_Identifier (Loc, Params_Name),
  990.                           Make_Identifier (Loc, Addr_Name))));
  991.  
  992.                   Append_To (Param_Read_Stmts,
  993.                     Make_Assignment_Statement (Loc,
  994.                       Name => Make_Identifier (Loc, Chars (Param)),
  995.                       Expression =>
  996.                         Make_Function_Call (Loc,
  997.                           Name => Make_Identifier (Loc, F_Name),
  998.                           Parameter_Associations => New_List (
  999.                             Make_Identifier (Loc, Addr_Name)))));
  1000.  
  1001.                else
  1002.                   if Has_Unknown_Size (Etype (Param_Type)) then
  1003.  
  1004.                      Append_To (Decls,
  1005.                        Make_Object_Declaration (Loc,
  1006.                          Defining_Identifier =>
  1007.                            New_Reference_To (Param, Loc),
  1008.  
  1009.                          Object_Definition =>
  1010.                            Copy_Original_Tree (Param_Type),
  1011.  
  1012.                          Expression =>
  1013.                            Make_Function_Call (Loc,
  1014.                              Name =>
  1015.                                Make_Attribute_Reference (Loc,
  1016.                                  Prefix => Copy_Original_Tree (Param_Type),
  1017.                                  Attribute_Name => Name_Input),
  1018.                              Parameter_Associations =>
  1019.                                New_List (
  1020.                                  Make_Identifier (Loc, Params_Name)))));
  1021.  
  1022.                   else
  1023.                      Append_To (Decls,
  1024.                        Make_Object_Declaration (Loc,
  1025.                          Defining_Identifier => New_Reference_To (Param, Loc),
  1026.                          Object_Definition =>
  1027.                            Copy_Original_Tree (Param_Type)));
  1028.  
  1029.                      if In_Present (Param_Spec) or else
  1030.                        not Out_Present (Param_Spec)
  1031.                      then
  1032.  
  1033.                         Append_To (Param_Read_Stmts,
  1034.                           Make_Procedure_Call_Statement (Loc,
  1035.                             Name => Make_Attribute_Reference (Loc,
  1036.                             Prefix => Copy_Original_Tree (Param_Type),
  1037.                             Attribute_Name => Name_Read),
  1038.  
  1039.                           Parameter_Associations =>
  1040.                             New_List (
  1041.                               Make_Identifier (Loc, Chars (Params)),
  1042.                               Make_Identifier (Loc, Chars (Param)))));
  1043.                      end if;
  1044.  
  1045.                   end if;
  1046.  
  1047.                   if Out_Present (Param_Spec) then
  1048.  
  1049.                      if Has_Unknown_Size (Etype (Param_Type)) then
  1050.  
  1051.                         Append_To (Param_Write_Stmts,
  1052.                           Make_Procedure_Call_Statement (Loc,
  1053.                             Name =>
  1054.                               Make_Attribute_Reference (Loc,
  1055.                                 Prefix => Copy_Original_Tree (Param_Type),
  1056.                                 Attribute_Name => Name_Output),
  1057.  
  1058.                             Parameter_Associations =>
  1059.                               New_List (
  1060.                                 Make_Identifier (Loc, Chars (Result)),
  1061.                                 Make_Identifier (Loc, Chars (Param)))));
  1062.  
  1063.                      else
  1064.                         Append_To (Param_Write_Stmts,
  1065.                           Make_Procedure_Call_Statement (Loc,
  1066.                             Name =>
  1067.                               Make_Attribute_Reference (Loc,
  1068.                                 Prefix => Copy_Original_Tree (Param_Type),
  1069.                                 Attribute_Name => Name_Write),
  1070.  
  1071.                             Parameter_Associations =>
  1072.                               New_List (
  1073.                                 Make_Identifier (Loc, Chars (Result)),
  1074.                                 Make_Identifier (Loc, Chars (Param)))));
  1075.                      end if;
  1076.                   end if;
  1077.                end if;
  1078.  
  1079.                Param_Spec := Next (Param_Spec);
  1080.             end loop;
  1081.          end if;
  1082.  
  1083.          --  Add the declaration for the value returned by a function
  1084.  
  1085.          if Nkind (Subp_Spec) = N_Function_Specification
  1086.            and then not Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec)))
  1087.          then
  1088.             Append_To (Decls,
  1089.               Make_Object_Declaration (Loc,
  1090.                 Defining_Identifier => Returned_Val,
  1091.                 Object_Definition =>
  1092.                   Copy_Original_Tree (Subtype_Mark (Subp_Spec))));
  1093.          end if;
  1094.  
  1095.          Stmts := Param_Read_Stmts;
  1096.  
  1097.          if Nkind (Subp_Spec) = N_Function_Specification then
  1098.  
  1099.             if Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec))) then
  1100.  
  1101.                Append_To (Stmts,
  1102.                  Make_Procedure_Call_Statement (Loc,
  1103.                    Name =>
  1104.                      Make_Attribute_Reference (Loc,
  1105.                        Prefix =>
  1106.                          Copy_Original_Tree (Subtype_Mark (Subp_Spec)),
  1107.                        Attribute_Name => Name_Output),
  1108.  
  1109.                    Parameter_Associations =>
  1110.                      New_List (
  1111.                        Make_Identifier (Loc, Chars (Result)),
  1112.                        Make_Function_Call (Loc,
  1113.                          Name =>
  1114.                            Make_Selected_Component (Loc,
  1115.                              Prefix =>
  1116.                                Build_Unit_Full_Name (Root_Pkg_Decl),
  1117.                              Selector_Name =>
  1118.                                Copy_Original_Tree (Subp_Name)),
  1119.                          Parameter_Associations => Param_List))));
  1120.  
  1121.             else
  1122.                Append_To (Stmts,
  1123.                  Make_Assignment_Statement (Loc,
  1124.                    Name => Make_Identifier (Loc, Chars (Returned_Val)),
  1125.                    Expression =>
  1126.                      Make_Function_Call (Loc,
  1127.                        Name =>
  1128.                          Make_Selected_Component (Loc,
  1129.                            Prefix =>
  1130.                              Build_Unit_Full_Name (Root_Pkg_Decl),
  1131.                            Selector_Name => Copy_Original_Tree (Subp_Name)),
  1132.                        Parameter_Associations => Param_List)));
  1133.             end if;
  1134.  
  1135.          else
  1136.             Append_To (Stmts,
  1137.               Make_Procedure_Call_Statement (Loc,
  1138.                 Name =>
  1139.                   Make_Selected_Component (Loc,
  1140.                     Prefix => Build_Unit_Full_Name (Root_Pkg_Decl),
  1141.                     Selector_Name => Copy_Original_Tree (Subp_Name)),
  1142.                 Parameter_Associations => Param_List));
  1143.          end if;
  1144.  
  1145.          Append_To (Stmts,
  1146.            Make_Procedure_Call_Statement (Loc,
  1147.              Name =>
  1148.                Make_Attribute_Reference (Loc,
  1149.                  Prefix => AE_Exception_Occurrence (Loc),
  1150.                  Attribute_Name => Name_Write),
  1151.  
  1152.              Parameter_Associations => New_List (
  1153.                New_Reference_To (Result, Loc),
  1154.                AE_Null_Occurrence (Loc))));
  1155.  
  1156.          Append_List (Param_Write_Stmts, Stmts);
  1157.  
  1158.          if Nkind (Subp_Spec) = N_Function_Specification
  1159.            and then not Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec)))
  1160.          then
  1161.             Append_To (Stmts,
  1162.               Make_Procedure_Call_Statement (Loc,
  1163.                 Name =>
  1164.                   Make_Attribute_Reference (Loc,
  1165.                     Prefix => Copy_Original_Tree (Subtype_Mark (Subp_Spec)),
  1166.                     Attribute_Name => Name_Write),
  1167.  
  1168.                 Parameter_Associations =>
  1169.                   New_List (
  1170.                     Make_Identifier (Loc, Chars (Result)),
  1171.                     Make_Identifier (Loc, Chars (Returned_Val)))));
  1172.          end if;
  1173.  
  1174.          Hss :=
  1175.            Make_Handled_Sequence_Of_Statements (Loc,
  1176.              Statements => Stmts,
  1177.              Exception_Handlers => New_List (
  1178.                Make_Exception_Handler (Loc,
  1179.                  Choice_Parameter => Make_Identifier (Loc, Chars (Except)),
  1180.                  Exception_Choices => New_List (Make_Others_Choice (Loc)),
  1181.  
  1182.                  Statements => New_List (
  1183.                    Make_Procedure_Call_Statement (Loc,
  1184.                      Name =>
  1185.                        Make_Attribute_Reference (Loc,
  1186.                          Prefix => AE_Exception_Occurrence (Loc),
  1187.                          Attribute_Name => Name_Write),
  1188.  
  1189.                      Parameter_Associations =>
  1190.                        New_List (
  1191.                          New_Reference_To (Result, Loc),
  1192.                          New_Reference_To (Except, Loc)))))));
  1193.  
  1194.          Stub_Body :=
  1195.            Make_Subprogram_Body (Loc,
  1196.              Specification => Copy_Original_Tree (Stub_Spec),
  1197.              Declarations => Decls,
  1198.              Handled_Statement_Sequence => Hss);
  1199.  
  1200.          return Stub_Body;
  1201.       end Build_Receiving_Stub_Body;
  1202.  
  1203.       -----------------------------
  1204.       -- Build_Calling_Stub_Body --
  1205.       -----------------------------
  1206.  
  1207.       function Build_Calling_Stub_Body
  1208.         (Vis_Decl : Node_Id)
  1209.          return     Node_Id
  1210.       is
  1211.          --  Information needed from the input parameter
  1212.  
  1213.          Subp_Spec       : Node_Id := Specification (Vis_Decl);
  1214.          Param_Specs     : List_Id := Parameter_Specifications (Subp_Spec);
  1215.          Subp_Name       : Node_Id := Defining_Unit_Name (Subp_Spec);
  1216.          Disp_Param_Spec : Node_Id := Find_Disp_Param_Spec (Param_Specs);
  1217.          Param_Spec      : Node_Id;
  1218.          Param_Type      : Node_Id;
  1219.  
  1220.          --  Building new entities for the local identifiers
  1221.  
  1222.          Stream_In            : Entity_Id;
  1223.          Stream_Out           : Entity_Id;
  1224.          Returned_Val         : Entity_Id;
  1225.          Except               : Entity_Id;
  1226.          Object_Stub          : Entity_Id;
  1227.          Origin               : Entity_Id;
  1228.          Receiver             : Entity_Id;
  1229.          Addr                 : Entity_Id;
  1230.  
  1231.          --  Features for the stub body to create
  1232.  
  1233.          Stmts            : List_Id := New_List;
  1234.          Write_Stmts      : List_Id := New_List;
  1235.          Then_Stmts       : List_Id := New_List;
  1236.          Decls            : List_Id := New_List;
  1237.          Stub_Param_Specs : List_Id := New_List;
  1238.          Stub_Spec        : Node_Id;
  1239.          Stub_Body        : Node_Id;
  1240.  
  1241.          --  Variable for the declaration node of a stream
  1242.  
  1243.          Stream_Decl   : Node_Id;
  1244.  
  1245.       begin
  1246.          --  Initialization of the external entities
  1247.  
  1248.          Stream_In              :=
  1249.            Make_Defining_Identifier (Loc, Stream_In_Name);
  1250.          Stream_Out             :=
  1251.            Make_Defining_Identifier (Loc, Stream_Out_Name);
  1252.          Returned_Val           :=
  1253.            Make_Defining_Identifier (Loc, Returned_Val_Name);
  1254.          Except                 :=
  1255.            Make_Defining_Identifier (Loc, Except_Name);
  1256.          Object_Stub            :=
  1257.            Make_Defining_Identifier (Loc, Object_Stub_Name);
  1258.          Origin                 :=
  1259.            Make_Defining_Identifier (Loc, Origin_Name);
  1260.          Receiver               :=
  1261.            Make_Defining_Identifier (Loc, Receiver_Name);
  1262.          Addr                   :=
  1263.            Make_Defining_Identifier (Loc, Addr_Name);
  1264.  
  1265.          --  Build and append stream input declaration to the list of
  1266.          --  declarations of the stub body
  1267.  
  1268.          Stream_Decl :=
  1269.            Make_Object_Declaration (Loc,
  1270.              Defining_Identifier => New_Reference_To (Stream_In, Loc),
  1271.              Object_Definition =>
  1272.                Make_Subtype_Indication (Loc,
  1273.                  Subtype_Mark => SR_Params_Stream_Type (Loc),
  1274.  
  1275.                Constraint =>
  1276.                  Make_Index_Or_Discriminant_Constraint (Loc,
  1277.                    Constraints =>
  1278.                      New_List (Make_Integer_Literal (Loc, Uint_0)))));
  1279.  
  1280.          Set_Aliased_Present (Stream_Decl);
  1281.          Append (Stream_Decl, Decls);
  1282.  
  1283.          --  Build and append stream output declaration to the list of
  1284.          --  declarations of the stub body
  1285.  
  1286.          Stream_Decl :=
  1287.            Make_Object_Declaration (Loc,
  1288.              Defining_Identifier =>
  1289.                New_Reference_To (Stream_Out, Loc),
  1290.  
  1291.              Object_Definition =>
  1292.                Make_Subtype_Indication (Loc,
  1293.                  Subtype_Mark => SR_Params_Stream_Type (Loc),
  1294.  
  1295.                  Constraint =>
  1296.                    Make_Index_Or_Discriminant_Constraint (Loc,
  1297.                      Constraints =>
  1298.                        New_List (Make_Integer_Literal (Loc, Uint_0)))));
  1299.  
  1300.          Set_Aliased_Present (Stream_Decl);
  1301.          Append (Stream_Decl, Decls);
  1302.  
  1303.          --  Append the declaration for the exeption occurrence
  1304.  
  1305.          Append_To (Decls,
  1306.            Make_Object_Declaration (Loc,
  1307.              Defining_Identifier => Except,
  1308.              Object_Definition => AE_Exception_Occurrence (Loc)));
  1309.  
  1310.          --  Append the declaration for the returned value in the
  1311.          --  case of a function
  1312.  
  1313.          if Nkind (Subp_Spec) = N_Function_Specification
  1314.            and then not Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec)))
  1315.          then
  1316.             Append_To (Decls,
  1317.               Make_Object_Declaration (Loc,
  1318.                 Defining_Identifier => Returned_Val,
  1319.                 Object_Definition =>
  1320.                   Copy_Original_Tree (Subtype_Mark (Subp_Spec))));
  1321.          end if;
  1322.  
  1323.          --  Build and append the write statement for the Receiver, to the
  1324.          --  list of statements of the stub body
  1325.  
  1326.          Append_To (Stmts,
  1327.            Make_Procedure_Call_Statement (Loc,
  1328.              Name =>
  1329.                Make_Attribute_Reference (Loc,
  1330.                  Prefix => SR_RPC_Receiver (Loc),
  1331.                  Attribute_Name => Name_Write),
  1332.  
  1333.              Parameter_Associations => New_List (
  1334.                Make_Attribute_Reference (Loc,
  1335.                  Prefix => New_Reference_To (Stream_In, Loc),
  1336.                  Attribute_Name => Name_Unchecked_Access),
  1337.  
  1338.                Make_Selected_Component (Loc,
  1339.                  Prefix =>
  1340.                    New_Reference_To (
  1341.                      Defining_Identifier (Disp_Param_Spec),
  1342.                      Loc),
  1343.                  Selector_Name =>
  1344.                    New_Reference_To (Receiver, Loc)))));
  1345.  
  1346.          --  Write statement for the subprogram identifier
  1347.  
  1348.          Append_To (Stmts,
  1349.            Make_Procedure_Call_Statement (Loc,
  1350.              Name =>
  1351.                Make_Attribute_Reference (Loc,
  1352.                  Prefix => SRP_Subprogram_Id (Loc),
  1353.                  Attribute_Name => Name_Write),
  1354.  
  1355.              Parameter_Associations => New_List (
  1356.                Make_Attribute_Reference (Loc,
  1357.                  Prefix => New_Reference_To (Stream_In, Loc),
  1358.                  Attribute_Name => Name_Unchecked_Access),
  1359.  
  1360.                --  Type conversion necessary ???
  1361.  
  1362.                --  Make_Type_Conversion (Loc,
  1363.                   --  SRP_Subprogram_Id (loc),
  1364.  
  1365.                Make_Integer_Literal (Loc, UI_From_Int (Prim_Op_Num)))));
  1366.  
  1367.          --  Append the write statements for the in parameters
  1368.          --  and the read statements for the out parameters
  1369.  
  1370.          if Param_Specs /= No_List then
  1371.  
  1372.             Param_Spec := First (Param_Specs);
  1373.  
  1374.             while Present (Param_Spec) loop
  1375.  
  1376.                if Is_Disp_Param_Spec (Param_Spec) then
  1377.  
  1378.                   Append_To (Stub_Param_Specs,
  1379.                     Make_Parameter_Specification (Loc,
  1380.                       Defining_Identifier =>
  1381.                         Make_Defining_Identifier (Loc,
  1382.                           Chars =>
  1383.                             Chars (Defining_Identifier (Param_Spec))),
  1384.  
  1385.                       Parameter_Type =>
  1386.                         Make_Access_Definition (Loc,
  1387.                           Subtype_Mark =>
  1388.                             New_Reference_To (Object_Stub, Loc)),
  1389.  
  1390.                       Expression =>
  1391.                         Copy_Original_Tree (Expression (Param_Spec))));
  1392.  
  1393.                   --  we only add write operation since mode is "in"
  1394.                   --  as we have an access definition,
  1395.  
  1396.                   Append_To (Stmts,
  1397.                     Make_Procedure_Call_Statement (Loc,
  1398.                       Name =>
  1399.                         Make_Attribute_Reference (Loc,
  1400.                           Prefix =>
  1401.                             Make_Selected_Component (Loc,
  1402.                               Prefix => Make_Identifier (Loc, Name_System),
  1403.                               Selector_Name =>
  1404.                                 Make_Identifier (Loc, Name_Address)),
  1405.  
  1406.                           Attribute_Name => Name_Write),
  1407.  
  1408.                       Parameter_Associations =>
  1409.                         New_List (
  1410.                           Make_Attribute_Reference (Loc,
  1411.                             Prefix => New_Reference_To (Stream_In, Loc),
  1412.                             Attribute_Name => Name_Unchecked_Access),
  1413.  
  1414.                           Make_Selected_Component (Loc,
  1415.                             Prefix =>
  1416.                               Make_Identifier (Loc,
  1417.                                 Chars => Chars (
  1418.                                   Defining_Identifier (Param_Spec))),
  1419.                             Selector_Name =>
  1420.                               Make_Identifier (Loc, Addr_Name)))));
  1421.  
  1422.                else
  1423.                   Append_To (Stub_Param_Specs,
  1424.                     Copy_Original_Tree (Param_Spec));
  1425.  
  1426.                   if Has_Unknown_Size (Etype
  1427.                     (Parameter_Type (Param_Spec)))
  1428.                   then
  1429.                      Append_To (Stmts,
  1430.                        Make_Procedure_Call_Statement (Loc,
  1431.                          Name =>
  1432.                            Make_Attribute_Reference (Loc,
  1433.                              Prefix => Parameter_Type (Param_Spec),
  1434.                              Attribute_Name => Name_Output),
  1435.  
  1436.                          Parameter_Associations =>
  1437.                            New_List (
  1438.                              Make_Attribute_Reference (Loc,
  1439.                                Prefix => New_Reference_To (Stream_In, Loc),
  1440.                                Attribute_Name => Name_Unchecked_Access),
  1441.  
  1442.                              Make_Identifier (Loc,
  1443.                                Chars => Chars (
  1444.                                  Defining_Identifier (Param_Spec))))));
  1445.  
  1446.                   elsif In_Present (Param_Spec)
  1447.                     or else not Out_Present (Param_Spec)
  1448.                   then
  1449.                      Append_To (Write_Stmts,
  1450.                        Make_Procedure_Call_Statement (Loc,
  1451.                          Name =>
  1452.                            Make_Attribute_Reference (Loc,
  1453.                              Prefix => Parameter_Type (Param_Spec),
  1454.                              Attribute_Name => Name_Write),
  1455.  
  1456.                          Parameter_Associations =>
  1457.                            New_List (
  1458.                              Make_Attribute_Reference (Loc,
  1459.                                Prefix => New_Reference_To (Stream_In, Loc),
  1460.                                Attribute_Name => Name_Unchecked_Access),
  1461.                              Make_Identifier (Loc,
  1462.                                Chars => Chars (
  1463.                                  Defining_Identifier (Param_Spec))))));
  1464.                   end if;
  1465.  
  1466.                   if Out_Present (Param_Spec) then
  1467.  
  1468.                      --  Read operation are within an if statement and
  1469.                      --  are thus appended to a then statement list which
  1470.                      --  will be used later to build the if statement.
  1471.  
  1472.                      if Has_Unknown_Size (Etype (
  1473.                        Parameter_Type (Param_Spec)))
  1474.                      then
  1475.                         Append_To (Then_Stmts,
  1476.                           Make_Assignment_Statement (Loc,
  1477.  
  1478.                             Name =>
  1479.                               Make_Identifier (Loc,
  1480.                                 Chars =>
  1481.                                   Chars (Defining_Identifier (Param_Spec))),
  1482.  
  1483.                             Expression =>
  1484.                               Make_Function_Call (Loc,
  1485.                                 Name =>
  1486.                                   Make_Attribute_Reference (Loc,
  1487.                                     Prefix => Parameter_Type (Param_Spec),
  1488.                                     Attribute_Name => Name_Input),
  1489.  
  1490.                                 Parameter_Associations => New_List (
  1491.                                   Make_Attribute_Reference (Loc,
  1492.                                     Prefix =>
  1493.                                       New_Reference_To (Stream_Out, Loc),
  1494.                                     Attribute_Name =>
  1495.                                       Name_Unchecked_Access)))));
  1496.  
  1497.                      else
  1498.                         Append_To (Then_Stmts,
  1499.                           Make_Procedure_Call_Statement (Loc,
  1500.                             Name =>
  1501.                               Make_Attribute_Reference (Loc,
  1502.                                 Prefix => Parameter_Type (Param_Spec),
  1503.                                 Attribute_Name => Name_Read),
  1504.  
  1505.                             Parameter_Associations =>
  1506.                               New_List (
  1507.                                 Make_Attribute_Reference (Loc,
  1508.                                   Prefix =>
  1509.                                     New_Reference_To (Stream_Out, Loc),
  1510.                                   Attribute_Name =>
  1511.                                     Name_Unchecked_Access),
  1512.  
  1513.                                 Make_Identifier (Loc,
  1514.                                   Chars => Chars (
  1515.                                     Defining_Identifier (Param_Spec))))));
  1516.                      end if;
  1517.                   end if;
  1518.                end if;
  1519.  
  1520.                Param_Spec := Next (Param_Spec);
  1521.             end loop;
  1522.          end if;
  1523.  
  1524.          --  append the write statement list to the list of statements
  1525.  
  1526.          Append_List (Write_Stmts, Stmts);
  1527.  
  1528.          --  append do_rpc call to the list of statements
  1529.  
  1530.          Append_To (Stmts,
  1531.            Make_Procedure_Call_Statement (Loc,
  1532.              Name => SR_Do_Rpc (Loc),
  1533.              Parameter_Associations => New_List (
  1534.                Make_Selected_Component (Loc,
  1535.                  Prefix =>
  1536.                    New_Reference_To (
  1537.                      Defining_Identifier (Disp_Param_Spec),
  1538.                      Loc),
  1539.  
  1540.                  Selector_Name =>
  1541.                    New_Reference_To (Origin, Loc)),
  1542.  
  1543.                Make_Attribute_Reference (Loc,
  1544.                  Prefix => New_Reference_To (Stream_In, Loc),
  1545.                  Attribute_Name => Name_Unchecked_Access),
  1546.  
  1547.                Make_Attribute_Reference (Loc,
  1548.                  Prefix => New_Reference_To (Stream_Out, Loc),
  1549.                  Attribute_Name => Name_Unchecked_Access))));
  1550.  
  1551.          --  Append the read operation for the exception occurrence
  1552.  
  1553.          Append_To (Stmts,
  1554.            Make_Procedure_Call_Statement (Loc,
  1555.              Name =>
  1556.                Make_Attribute_Reference (Loc,
  1557.                  Prefix => AE_Exception_Occurrence (Loc),
  1558.                  Attribute_Name => Name_Read),
  1559.  
  1560.              Parameter_Associations => New_List (
  1561.                Make_Attribute_Reference (Loc,
  1562.                  Prefix => New_Reference_To (Stream_Out, Loc),
  1563.                  Attribute_Name => Name_Unchecked_Access),
  1564.  
  1565.                New_Reference_To (Except, Loc))));
  1566.  
  1567.          --  Append the read statement for the returned value, and
  1568.          --  the return statement in the case of a function
  1569.  
  1570.          if Nkind (Subp_Spec) = N_Function_Specification then
  1571.  
  1572.             if Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec))) then
  1573.  
  1574.                Append_To (Then_Stmts,
  1575.                  Make_Return_Statement (Loc,
  1576.                    Expression =>
  1577.                      Make_Function_Call (Loc,
  1578.                        Name =>
  1579.                          Make_Attribute_Reference (Loc,
  1580.                            Prefix => Subtype_Mark (Subp_Spec),
  1581.                            Attribute_Name => Name_Input),
  1582.  
  1583.                        Parameter_Associations => New_List (
  1584.                          Make_Attribute_Reference (Loc,
  1585.                            Prefix => New_Reference_To (Stream_Out, Loc),
  1586.                            Attribute_Name => Name_Unchecked_Access)))));
  1587.  
  1588.             else
  1589.                Append_To (Then_Stmts,
  1590.                  Make_Procedure_Call_Statement (Loc,
  1591.                    Name =>
  1592.                      Make_Attribute_Reference (Loc,
  1593.                        Prefix =>
  1594.                          Copy_Original_Tree (Subtype_Mark (Subp_Spec)),
  1595.                        Attribute_Name => Name_Read),
  1596.  
  1597.                    Parameter_Associations => New_List (
  1598.                      Make_Attribute_Reference (Loc,
  1599.                        Prefix => New_Reference_To (Stream_Out, Loc),
  1600.                        Attribute_Name => Name_Unchecked_Access),
  1601.  
  1602.                      New_Reference_To (Returned_Val, Loc))));
  1603.  
  1604.                --  Append a return statement; the returned value is the one
  1605.                --  previously read from the stream output
  1606.  
  1607.                Append_To (Then_Stmts,
  1608.                  Make_Return_Statement (Loc,
  1609.                    Expression => New_Reference_To (Returned_Val, Loc)));
  1610.             end if;
  1611.          end if;
  1612.  
  1613.          --  Append the if statement for the out parameters and
  1614.          --  the returned value in the case of a function
  1615.  
  1616.          if not Is_Empty_List (Then_Stmts) then
  1617.             Append_To (Stmts,
  1618.               Make_If_Statement (Loc,
  1619.                 Condition =>
  1620.                   Make_Op_Eq (Loc,
  1621.                     Left_Opnd => New_Reference_To (Except, Loc),
  1622.                     Right_Opnd => AE_Null_Occurrence (Loc)),
  1623.  
  1624.                 Then_Statements => Then_Stmts,
  1625.  
  1626.                 Else_Statements => New_List (
  1627.                   Make_Procedure_Call_Statement (Loc,
  1628.                     Name => AE_Reraise_Occurrence (Loc),
  1629.                     Parameter_Associations => New_List (
  1630.                       New_Reference_To (Except, Loc))))));
  1631.  
  1632.          else
  1633.             Append_To (Stmts,
  1634.               Make_If_Statement (Loc,
  1635.                 Condition =>
  1636.                   Make_Op_Ne (Loc,
  1637.                     Left_Opnd => New_Reference_To (Except, Loc),
  1638.                     Right_Opnd => AE_Null_Occurrence (Loc)),
  1639.  
  1640.                 Then_Statements => New_List (
  1641.                   Make_Procedure_Call_Statement (Loc,
  1642.                     Name => AE_Reraise_Occurrence (Loc),
  1643.                     Parameter_Associations => New_List (
  1644.                       New_Reference_To (Except, Loc))))));
  1645.          end if;
  1646.  
  1647.          --  Build the stub specification node
  1648.  
  1649.          if Nkind (Subp_Spec) = N_Function_Specification then
  1650.             Stub_Spec :=
  1651.               Make_Function_Specification (Loc,
  1652.                 Defining_Unit_Name =>
  1653.                   Copy_Original_Tree (Defining_Unit_Name (Subp_Spec)),
  1654.                 Parameter_Specifications => Stub_Param_Specs,
  1655.                 Subtype_Mark =>
  1656.                   Copy_Original_Tree (Subtype_Mark (Subp_Spec)));
  1657.  
  1658.          else
  1659.             Stub_Spec :=
  1660.               Make_Procedure_Specification (Loc,
  1661.                 Defining_Unit_Name =>
  1662.                   Copy_Original_Tree (Defining_Unit_Name (Subp_Spec)),
  1663.                 Parameter_Specifications => Stub_Param_Specs);
  1664.          end if;
  1665.  
  1666.          --  Build the stub body node
  1667.  
  1668.          Stub_Body :=
  1669.            Make_Subprogram_Body (Loc,
  1670.               Specification => Stub_Spec,
  1671.               Declarations  => Decls,
  1672.               Handled_Statement_Sequence =>
  1673.                 Make_Handled_Sequence_Of_Statements (Loc,
  1674.                   Statements => Stmts));
  1675.  
  1676.          return Stub_Body;
  1677.  
  1678.       end Build_Calling_Stub_Body;
  1679.  
  1680.       ---------------------------
  1681.       -- Find_Disp_Param_Spec --
  1682.       ---------------------------
  1683.  
  1684.       function Find_Disp_Param_Spec (L : List_Id) return Node_Id is
  1685.          Param_Spec : Node_Id;
  1686.  
  1687.       begin
  1688.          if Present (L) then
  1689.             Param_Spec := First (L);
  1690.             while Present (Param_Spec)
  1691.               and then not Is_Disp_Param_Spec (Param_Spec)
  1692.             loop
  1693.                Param_Spec := Next (Param_Spec);
  1694.             end loop;
  1695.  
  1696.             return Param_Spec;
  1697.  
  1698.          else
  1699.             return Empty;
  1700.          end if;
  1701.       end Find_Disp_Param_Spec;
  1702.  
  1703.       -----------------------------
  1704.       -- Has_Access_To_Root_Type --
  1705.       -----------------------------
  1706.  
  1707.       function Has_Access_To_Root_Type (L : List_Id) return Boolean is
  1708.       begin
  1709.          return Present (Find_Disp_Param_Spec (L));
  1710.       end Has_Access_To_Root_Type;
  1711.  
  1712.       ------------------------
  1713.       -- Is_Disp_Param_Spec --
  1714.       ------------------------
  1715.  
  1716.       function Is_Disp_Param_Spec (Param_Spec : Node_Id) return Boolean is
  1717.       begin
  1718.          return
  1719.            Nkind (Parameter_Type (Param_Spec)) = N_Access_Definition
  1720.            and then Etype (Subtype_Mark (Parameter_Type (Param_Spec)))
  1721.            = Root_Type;
  1722.       end Is_Disp_Param_Spec;
  1723.  
  1724.    --  Start of processing for Add_Racw_Stubs
  1725.  
  1726.    begin
  1727.       --  Initialize the dispatcher name variable
  1728.  
  1729.       Append_Nat_To_String ("dispatcher_receiver", Last_Racw_Num);
  1730.       Dispatcher_Name := Name_Find;
  1731.  
  1732.       --  Build and prepend the declaration of the object stub type
  1733.  
  1734.       Obj_Stub_Decl :=
  1735.         Make_Full_Type_Declaration (Loc,
  1736.           Defining_Identifier =>
  1737.             Make_Defining_Identifier (Loc, Object_Stub_Name),
  1738.  
  1739.           Type_Definition =>
  1740.             Make_Derived_Type_Definition (Loc,
  1741.               Subtype_Indication =>
  1742.                 Make_Selected_Component (Loc,
  1743.                   Prefix => Build_Unit_Full_Name (Root_Pkg_Decl),
  1744.                   Selector_Name =>
  1745.                     Make_Identifier (Loc, Chars (Root_Type))),
  1746.  
  1747.               Record_Extension_Part =>
  1748.                 Make_Record_Definition (Loc,
  1749.                   Component_List =>
  1750.                     Make_Component_List (Loc,
  1751.                       Component_Items => New_List (
  1752.  
  1753.                         Make_Component_Declaration (Loc,
  1754.                           Defining_Identifier =>
  1755.                             Make_Defining_Identifier (Loc, Origin_Name),
  1756.                           Subtype_Indication => SR_Partition_ID (Loc)),
  1757.  
  1758.                         Make_Component_Declaration (Loc,
  1759.                           Defining_Identifier =>
  1760.                             Make_Defining_Identifier (Loc, Receiver_Name),
  1761.                           Subtype_Indication => SR_RPC_Receiver (Loc)),
  1762.  
  1763.                         Make_Component_Declaration (Loc,
  1764.                           Defining_Identifier =>
  1765.                             Make_Defining_Identifier (Loc, Addr_Name),
  1766.                           Subtype_Indication =>
  1767.                             Make_Selected_Component (Loc,
  1768.                               Prefix => Make_Identifier (Loc, Name_System),
  1769.                               Selector_Name =>
  1770.                                 Make_Identifier (Loc, Name_Address))))))));
  1771.  
  1772.       Prepend (Obj_Stub_Decl, Pkg_Bdy_Decls);
  1773.  
  1774.       --  Build and insert the declaration of the access to object_stub type
  1775.  
  1776.       Acc_To_Obj_Stub_Decl :=
  1777.         Make_Full_Type_Declaration (Loc,
  1778.           Defining_Identifier =>
  1779.             Make_Defining_Identifier (Loc, Object_Stub_Access_Name),
  1780.  
  1781.           Type_Definition =>
  1782.             Make_Access_To_Object_Definition (Loc,
  1783.               Subtype_Indication =>
  1784.                 Make_Identifier (Loc, Object_Stub_Name)));
  1785.  
  1786.       Insert_After (Obj_Stub_Decl, Acc_To_Obj_Stub_Decl);
  1787.  
  1788.       --  Build and add the body of read procedure for the racw type
  1789.  
  1790.       Append_To (Pkg_Bdy_Decls,
  1791.         Make_Subprogram_Body (Loc,
  1792.  
  1793.           Specification => Racw_Read_Spec (Loc, Racw_Type),
  1794.  
  1795.           Declarations => New_List (
  1796.             Make_Object_Declaration (Loc,
  1797.               Defining_Identifier => Make_Defining_Identifier (Loc, P_Name),
  1798.               Object_Definition => SR_Partition_ID (Loc)),
  1799.  
  1800.             Make_Object_Declaration (Loc,
  1801.               Defining_Identifier => Make_Defining_Identifier (Loc, R_Name),
  1802.               Object_Definition => SR_RPC_Receiver (Loc)),
  1803.  
  1804.             Make_Object_Declaration (Loc,
  1805.               Defining_Identifier => Make_Defining_Identifier (Loc, A_Name),
  1806.               Object_Definition =>
  1807.                 Make_Selected_Component (Loc,
  1808.                   Prefix => Make_Identifier (Loc, Name_System),
  1809.                   Selector_Name =>
  1810.                     Make_Identifier (Loc, Name_Address))),
  1811.  
  1812.             Make_Object_Declaration (Loc,
  1813.               Defining_Identifier => Make_Defining_Identifier (Loc, V_Name),
  1814.               Object_Definition =>
  1815.                 Make_Identifier (Loc, Object_Stub_Access_Name)),
  1816.  
  1817.             Make_Function_Instantiation (Loc,
  1818.               Defining_Unit_Name => Make_Identifier (Loc, F_Name),
  1819.               Name => Make_Identifier (Loc, Unchecked_Conversion_Name),
  1820.               Generic_Associations => New_List (
  1821.                 Make_Generic_Association (Loc,
  1822.                   Explicit_Generic_Actual_Parameter =>
  1823.                     Make_Selected_Component (Loc,
  1824.                       Prefix => Make_Identifier (Loc, Name_System),
  1825.                       Selector_Name =>
  1826.                         Make_Identifier (Loc, Name_Address))),
  1827.  
  1828.                 Make_Generic_Association (Loc,
  1829.                   Explicit_Generic_Actual_Parameter =>
  1830.                     New_Reference_To (Racw_Type, Loc))))),
  1831.  
  1832.           Handled_Statement_Sequence =>
  1833.             Make_Handled_Sequence_Of_Statements (Loc,
  1834.               Statements => New_List (
  1835.                 Make_Procedure_Call_Statement (Loc,
  1836.                   Name =>
  1837.                     Make_Attribute_Reference (Loc,
  1838.                       Prefix => SR_Partition_ID (Loc),
  1839.                       Attribute_Name => Name_Read),
  1840.  
  1841.                   Parameter_Associations => New_List (
  1842.                     Make_Identifier (Loc, Stream_Name),
  1843.                     Make_Identifier (Loc, P_Name))),
  1844.  
  1845.                 Make_Procedure_Call_Statement (Loc,
  1846.                   Name =>
  1847.                     Make_Attribute_Reference (Loc,
  1848.                       Prefix => SR_RPC_Receiver (Loc),
  1849.                       Attribute_Name => Name_Read),
  1850.  
  1851.                   Parameter_Associations => New_List (
  1852.                     Make_Identifier (Loc, Stream_Name),
  1853.                     Make_Identifier (Loc, R_Name))),
  1854.  
  1855.                 Make_Procedure_Call_Statement (Loc,
  1856.                   Name =>
  1857.                     Make_Attribute_Reference (Loc,
  1858.                       Prefix =>
  1859.                         Make_Selected_Component (Loc,
  1860.                           Prefix =>
  1861.                             Make_Identifier (Loc, Name_System),
  1862.                           Selector_Name =>
  1863.                             Make_Identifier (Loc, Name_Address)),
  1864.                       Attribute_Name => Name_Read),
  1865.  
  1866.                   Parameter_Associations => New_List (
  1867.                     Make_Identifier (Loc, Stream_Name),
  1868.                     Make_Identifier (Loc, A_Name))),
  1869.  
  1870.                 Make_If_Statement (Loc,
  1871.                   Condition =>
  1872.                     Make_Op_Eq (Loc,
  1873.                       Left_Opnd =>
  1874.                         Make_Function_Call (Loc,
  1875.                           Name => SRP_Get_Local_Partition_Id (Loc)),
  1876.  
  1877.                       Right_Opnd =>
  1878.                         Make_Identifier (Loc, P_Name)),
  1879.  
  1880.                   Then_Statements => New_List (
  1881.                     Make_Assignment_Statement (Loc,
  1882.                       Name => Make_Identifier (Loc, Item_Name),
  1883.                       Expression =>
  1884.                         Make_Function_Call (Loc,
  1885.                           Name => Make_Identifier (Loc, F_Name),
  1886.                           Parameter_Associations => New_List (
  1887.                             Make_Identifier (Loc, A_Name))))),
  1888.  
  1889.                   Else_Statements => New_List (
  1890.                     Make_Assignment_Statement (Loc,
  1891.                       Name => Make_Identifier (Loc, V_Name),
  1892.                       Expression =>
  1893.                         Make_Allocator (Loc,
  1894.                           Expression =>
  1895.                             Make_Identifier (Loc, Object_Stub_Name))),
  1896.  
  1897.                     Make_Assignment_Statement (Loc,
  1898.                       Name =>
  1899.                         Make_Selected_Component (Loc,
  1900.                           Prefix => Make_Identifier (Loc, V_Name),
  1901.                           Selector_Name =>
  1902.                             Make_Identifier (Loc, Origin_Name)),
  1903.  
  1904.                       Expression =>
  1905.                         Make_Identifier (Loc, P_Name)),
  1906.  
  1907.                     Make_Assignment_Statement (Loc,
  1908.                       Name =>
  1909.                         Make_Selected_Component (Loc,
  1910.                           Prefix => Make_Identifier (Loc, V_Name),
  1911.                           Selector_Name =>
  1912.                             Make_Identifier (Loc, Receiver_Name)),
  1913.  
  1914.                       Expression =>
  1915.                         Make_Identifier (Loc, R_Name)),
  1916.  
  1917.                     Make_Assignment_Statement (Loc,
  1918.                       Name =>
  1919.                         Make_Selected_Component (Loc,
  1920.                           Prefix => Make_Identifier (Loc, V_Name),
  1921.                           Selector_Name =>
  1922.                             Make_Identifier (Loc, Addr_Name)),
  1923.  
  1924.                       Expression =>
  1925.                         Make_Identifier (Loc, A_Name)),
  1926.  
  1927.                     Make_Assignment_Statement (Loc,
  1928.                       Name => Make_Identifier (Loc, Item_Name),
  1929.                       Expression =>
  1930.                         Make_Type_Conversion (Loc,
  1931.                           Subtype_Mark => New_Reference_To (Racw_Type, Loc),
  1932.                           Expression =>
  1933.                             Make_Identifier (Loc, V_Name)))))))));
  1934.  
  1935.       --  Build and add write procedure body for the racw type.
  1936.  
  1937.       Append_To (Pkg_Bdy_Decls,
  1938.  
  1939.         Make_Subprogram_Body (Loc,
  1940.  
  1941.           Specification => Racw_Write_Spec (Loc, Racw_Type),
  1942.  
  1943.           Declarations => New_List,
  1944.  
  1945.           Handled_Statement_Sequence =>
  1946.             Make_Handled_Sequence_Of_Statements (Loc,
  1947.               Statements => New_List (
  1948.                 Make_If_Statement (Loc,
  1949.                   Condition =>
  1950.                     Make_Not_In (Loc,
  1951.                       Left_Opnd =>
  1952.                         Make_Explicit_Dereference (Loc,
  1953.                           Prefix => Make_Identifier (Loc, Item_Name)),
  1954.  
  1955.                       Right_Opnd =>
  1956.                         Make_Identifier (Loc, Object_Stub_Name)),
  1957.  
  1958.                   Then_Statements => New_List (
  1959.                     Make_Procedure_Call_Statement (Loc,
  1960.                       Name =>
  1961.                         Make_Attribute_Reference (Loc,
  1962.                           Prefix => SR_Partition_ID (Loc),
  1963.                           Attribute_Name => Name_Write),
  1964.  
  1965.                       Parameter_Associations => New_List (
  1966.                         Make_Identifier (Loc, Stream_Name),
  1967.                         Make_Function_Call (Loc,
  1968.                           Name => SRP_Get_Local_Partition_Id (Loc)))),
  1969.  
  1970.                     Make_Procedure_Call_Statement (Loc,
  1971.                       Name =>
  1972.                         Make_Attribute_Reference (Loc,
  1973.                           Prefix => SR_RPC_Receiver (Loc),
  1974.                           Attribute_Name => Name_Write),
  1975.  
  1976.                       Parameter_Associations => New_List (
  1977.                         Make_Identifier (Loc, Stream_Name),
  1978.                         Make_Attribute_Reference (Loc,
  1979.                           Prefix =>
  1980.                             Make_Identifier (Loc, Dispatcher_Name),
  1981.                           Attribute_Name => Name_Unrestricted_Access))),
  1982.  
  1983.                     Make_Procedure_Call_Statement (Loc,
  1984.                       Name =>
  1985.                         Make_Attribute_Reference (Loc,
  1986.                           Prefix =>
  1987.                             Make_Selected_Component (Loc,
  1988.                               Prefix =>
  1989.                                 Make_Identifier (Loc, Name_System),
  1990.                               Selector_Name =>
  1991.                                 Make_Identifier (Loc, Name_Address)),
  1992.  
  1993.                           Attribute_Name => Name_Write),
  1994.  
  1995.                       Parameter_Associations => New_List (
  1996.                         Make_Identifier (Loc, Stream_Name),
  1997.                         Make_Attribute_Reference (Loc,
  1998.                           Prefix =>
  1999.                             Make_Identifier (Loc, Item_Name),
  2000.                           Attribute_Name => Name_Address)))),
  2001.  
  2002.                    Else_Statements => New_List (
  2003.                      Make_Procedure_Call_Statement (Loc,
  2004.                        Name =>
  2005.                          Make_Attribute_Reference (Loc,
  2006.                            Prefix => SR_Partition_ID (Loc),
  2007.                            Attribute_Name => Name_Write),
  2008.  
  2009.                        Parameter_Associations => New_List (
  2010.                          Make_Identifier (Loc, Stream_Name),
  2011.                          Make_Selected_Component (Loc,
  2012.                            Prefix =>
  2013.                              Make_Type_Conversion (Loc,
  2014.                                Subtype_Mark =>
  2015.                                  Make_Identifier (Loc, Object_Stub_Name),
  2016.                                Expression =>
  2017.                                  Make_Explicit_Dereference (Loc,
  2018.                                    Prefix =>
  2019.                                      Make_Identifier (Loc, Item_Name))),
  2020.                            Selector_Name =>
  2021.                              Make_Identifier (Loc, Origin_Name)))),
  2022.  
  2023.                      Make_Procedure_Call_Statement (Loc,
  2024.                        Name =>
  2025.                          Make_Attribute_Reference (Loc,
  2026.                            Prefix => SR_RPC_Receiver (Loc),
  2027.                            Attribute_Name => Name_Write),
  2028.  
  2029.                        Parameter_Associations => New_List (
  2030.                          Make_Identifier (Loc, Stream_Name),
  2031.                          Make_Selected_Component (Loc,
  2032.                            Prefix =>
  2033.                              Make_Type_Conversion (Loc,
  2034.                                Subtype_Mark =>
  2035.                                  Make_Identifier (Loc, Object_Stub_Name),
  2036.                                Expression =>
  2037.                                  Make_Explicit_Dereference (Loc,
  2038.                                    Prefix =>
  2039.                                      Make_Identifier (Loc, Item_Name))),
  2040.  
  2041.                            Selector_Name =>
  2042.                              Make_Identifier (Loc, Receiver_Name)))),
  2043.  
  2044.                      Make_Procedure_Call_Statement (Loc,
  2045.                        Name =>
  2046.                          Make_Attribute_Reference (Loc,
  2047.                            Prefix =>
  2048.                              Make_Selected_Component (Loc,
  2049.                                Prefix => Make_Identifier (Loc, Name_System),
  2050.                                Selector_Name =>
  2051.                                  Make_Identifier (Loc, Name_Address)),
  2052.  
  2053.                            Attribute_Name => Name_Write),
  2054.  
  2055.                        Parameter_Associations => New_List (
  2056.                          Make_Identifier (Loc, Stream_Name),
  2057.                          Make_Selected_Component (Loc,
  2058.                            Prefix =>
  2059.                              Make_Type_Conversion (Loc,
  2060.                                Subtype_Mark =>
  2061.                                  Make_Identifier (Loc, Object_Stub_Name),
  2062.                                Expression =>
  2063.                                  Make_Explicit_Dereference (Loc,
  2064.                                    Prefix =>
  2065.                                      Make_Identifier (Loc, Item_Name))),
  2066.                            Selector_Name =>
  2067.                              Make_Identifier (Loc, Addr_Name))))))))));
  2068.  
  2069.       --  Build the calling stubs
  2070.  
  2071.       if Present (Root_Pkg_Vis_Decls) then
  2072.          Decl := First (Root_Pkg_Vis_Decls);
  2073.          while Present (Decl) loop
  2074.  
  2075.             --  Build and append primitive operation calling stubs
  2076.  
  2077.             if Nkind (Decl) = N_Abstract_Subprogram_Declaration
  2078.               and then Has_Access_To_Root_Type (Parameter_Specifications
  2079.                 (Specification (Decl)))
  2080.             then
  2081.                Prim_Op_Num := Prim_Op_Num + 1;
  2082.  
  2083.                --  Generate regular or asynchronous stubs if pragma
  2084.                --  asynchronous applies to the racw type
  2085.  
  2086.                if Async and then
  2087.                  Nkind (Specification (Decl)) = N_Procedure_Specification
  2088.                then
  2089.                   Racw_CStub_Body := Build_Async_Calling_Stub_Body (Decl);
  2090.                   Racw_RStub_Body := Build_Async_Receiving_Stub_Body (Decl);
  2091.                   Param_Assocs :=
  2092.                     New_List (Make_Identifier (Loc, Params_Name));
  2093.  
  2094.                else
  2095.                   Racw_CStub_Body := Build_Calling_Stub_Body (Decl);
  2096.                   Racw_RStub_Body := Build_Receiving_Stub_Body (Decl);
  2097.                   Param_Assocs :=
  2098.                     New_List (
  2099.                       Make_Identifier (Loc, Params_Name),
  2100.                       Make_Identifier (Loc, Result_Name));
  2101.                end if;
  2102.  
  2103.                Racw_CStub_Spec := Specification (Racw_CStub_Body);
  2104.                Racw_RStub_Spec := Specification (Racw_RStub_Body);
  2105.  
  2106.                --  Insert the declaration of the calling stub after the
  2107.                --  declaration of the access to object stub
  2108.  
  2109.                Insert_After (Acc_To_Obj_Stub_Decl,
  2110.                  Make_Subprogram_Declaration (Loc,
  2111.                    Specification => Copy_Separate_Tree (Racw_CStub_Spec)));
  2112.  
  2113.                --  Append the calling stub body to the package body
  2114.                --  declarations
  2115.  
  2116.                Append (Racw_CStub_Body, Pkg_Bdy_Decls);
  2117.  
  2118.                --  Append the receiving stub body to the dispatching
  2119.                --  receiver declarations
  2120.  
  2121.                Append (Racw_RStub_Body, Dispatcher_Decls);
  2122.  
  2123.                --  Append a case statement alternative for the
  2124.                --  primitive operation.
  2125.  
  2126.                Append_To (Case_Stmt_Alts,
  2127.                  Make_Case_Statement_Alternative (Loc,
  2128.                    Discrete_Choices => New_List (
  2129.                      Make_Integer_Literal (Loc, UI_From_Int (Prim_Op_Num))),
  2130.  
  2131.                    Statements => New_List (
  2132.                      Make_Procedure_Call_Statement (Loc,
  2133.                        Name => Copy_Original_Tree (
  2134.                          Defining_Unit_Name (Racw_RStub_Spec)),
  2135.                        Parameter_Associations => Param_Assocs))));
  2136.             end if;
  2137.  
  2138.             Decl := Next (Decl);
  2139.          end loop;
  2140.       end if;
  2141.  
  2142.       --  Complete dispatching receiver building
  2143.  
  2144.       Prepend_To (Dispatcher_Decls,
  2145.         Make_Function_Instantiation (Loc,
  2146.           Defining_Unit_Name => Make_Identifier (Loc, F_Name),
  2147.           Name => Make_Identifier (Loc, Unchecked_Conversion_Name),
  2148.           Generic_Associations => New_List (
  2149.             Make_Generic_Association (Loc,
  2150.               Explicit_Generic_Actual_Parameter =>
  2151.                 Make_Selected_Component (Loc,
  2152.                   Prefix => Make_Identifier (Loc, Name_System),
  2153.                   Selector_Name =>
  2154.                     Make_Identifier (Loc, Name_Address))),
  2155.  
  2156.             Make_Generic_Association (Loc,
  2157.               Explicit_Generic_Actual_Parameter =>
  2158.                 New_Reference_To (Racw_Type, Loc)))));
  2159.  
  2160.       Append_To (Case_Stmt_Alts,
  2161.         Make_Case_Statement_Alternative (Loc,
  2162.           Discrete_Choices => New_List (Make_Others_Choice (Loc)),
  2163.           Statements => New_List (Make_Null_Statement (Loc))));
  2164.  
  2165.       Dispatcher_Spec :=
  2166.         Make_Procedure_Specification (Loc,
  2167.           Defining_Unit_Name =>
  2168.             Make_Identifier (Loc, Dispatcher_Name),
  2169.           Parameter_Specifications => NStub_Param_Specs (Loc));
  2170.  
  2171.       Append_To (Dispatcher_Decls,
  2172.         Make_Object_Declaration (Loc,
  2173.           Defining_Identifier =>
  2174.             Make_Defining_Identifier (Loc, Prim_Op_Num_Name),
  2175.           Object_Definition => SRP_Subprogram_Id (Loc)));
  2176.  
  2177.       Dispatcher_Body :=
  2178.         Make_Subprogram_Body (Loc,
  2179.           Specification => Dispatcher_Spec,
  2180.  
  2181.           Declarations  => Dispatcher_Decls,
  2182.  
  2183.           Handled_Statement_Sequence =>
  2184.             Make_Handled_Sequence_Of_Statements (Loc,
  2185.               Statements => New_List (
  2186.                 Make_Procedure_Call_Statement (Loc,
  2187.                   Name =>
  2188.                     Make_Attribute_Reference (Loc,
  2189.                       Prefix => SRP_Subprogram_Id (Loc),
  2190.                       Attribute_Name => Name_Read),
  2191.  
  2192.                   Parameter_Associations => New_List (
  2193.                     Make_Identifier (Loc, Params_Name),
  2194.                     Make_Identifier (Loc, Prim_Op_Num_Name))),
  2195.                     Make_Case_Statement (Loc,
  2196.                       Expression =>
  2197.                         Make_Identifier (Loc, Prim_Op_Num_Name),
  2198.                       Alternatives => Case_Stmt_Alts))));
  2199.  
  2200.       Prepend (Dispatcher_Body, Pkg_Bdy_Decls);
  2201.  
  2202.    end Add_Racw_Stubs;
  2203.  
  2204.    ---------------------
  2205.    -- Add_With_Clause --
  2206.    ---------------------
  2207.  
  2208.    procedure Add_With_Clause
  2209.      (Nam    : in Node_Id;
  2210.       CItems : in out List_Id)
  2211.    is
  2212.       Loc            : Source_Ptr := Sloc (Nam);
  2213.       Withed         : Boolean := False;
  2214.       Context        : Node_Id;
  2215.  
  2216.    begin
  2217.       if CItems /= No_List then
  2218.          Context := First (CItems);
  2219.  
  2220.          --  Check if Nam is already in the with clause
  2221.  
  2222.          while Present (Context) and not Withed loop
  2223.             if Nkind (Context) = N_With_Clause then
  2224.                Withed := Designate_Same_Unit (Name (Context), Nam);
  2225.             end if;
  2226.  
  2227.             Context := Next (Context);
  2228.          end loop;
  2229.  
  2230.          --  Add to the context clause list if not withed
  2231.  
  2232.          if not Withed then
  2233.             Prepend (Make_With_Clause (Loc, Nam), CItems);
  2234.          end if;
  2235.       else
  2236.  
  2237.          --  Build a new context item list
  2238.  
  2239.          CItems := New_List (
  2240.            Make_With_Clause (Loc, Nam));
  2241.       end if;
  2242.    end Add_With_Clause;
  2243.  
  2244.    --------------------------
  2245.    -- Append_Nat_To_String --
  2246.    --------------------------
  2247.  
  2248.    procedure Append_Nat_To_String (S : String; V : Nat) is
  2249.  
  2250.       -----------------------
  2251.       -- Local subprograms --
  2252.       -----------------------
  2253.  
  2254.       procedure Add_Nat_To_Name_Buffer (V : Nat);
  2255.       --  Add decimal representation of given value to the end of the string
  2256.       --  currently stored in Name_Buffer, incrementing Name_Len as required.
  2257.  
  2258.       ----------------------------
  2259.       -- Add_Nat_To_Name_Buffer --
  2260.       ----------------------------
  2261.  
  2262.       procedure Add_Nat_To_Name_Buffer (V : Nat) is
  2263.       begin
  2264.          if V >= 10 then
  2265.             Add_Nat_To_Name_Buffer (V / 10);
  2266.          end if;
  2267.  
  2268.          Name_Len := Name_Len + 1;
  2269.          Name_Buffer (Name_Len) :=
  2270.            Character'Val (Character'Pos ('0') + V rem 10);
  2271.       end Add_Nat_To_Name_Buffer;
  2272.  
  2273.       --  Start of processing for Append_Nat_To_String
  2274.  
  2275.    begin
  2276.       Name_Len := S'Length;
  2277.       Name_Buffer (1 .. Name_Len) := S;
  2278.       Add_Nat_To_Name_Buffer (V);
  2279.  
  2280.    end Append_Nat_To_String;
  2281.  
  2282.    --------------------
  2283.    -- Add_System_Rpc --
  2284.    --------------------
  2285.  
  2286.    procedure Add_System_Rpc (C_Unit : Node_Id) is
  2287.       Contexts   : List_Id := Context_Items (C_Unit);
  2288.       Lib_Unit   : Node_Id;
  2289.       Withn      : Node_Id;
  2290.       Use_Clause : Node_Id := Empty;
  2291.       Uname      : Unit_Name_Type;
  2292.       Unum       : Unit_Number_Type;
  2293.       UEntity    : Entity_Id;
  2294.       Withed     : Boolean := False;
  2295.       Context    : Node_Id;
  2296.       Name_Node  : Node_Id;
  2297.  
  2298.       procedure Failure (S : String);
  2299.       --  Internal procedure called if an error occurs. The parameter
  2300.       --  is a detailed error message that is to be given
  2301.  
  2302.       procedure Failure (S : String) is
  2303.       begin
  2304.          Set_Standard_Error;
  2305.  
  2306.          Write_Str ("fatal error: runtime library configuration error");
  2307.          Write_Eol;
  2308.          Write_Char ('"');
  2309.          Write_Name (Get_File_Name (Uname));
  2310.          Write_Str (""" (");
  2311.          Write_Str (S);
  2312.          Write_Char (')');
  2313.          Write_Eol;
  2314.          Set_Standard_Output;
  2315.          raise Unrecoverable_Error;
  2316.       end Failure;
  2317.  
  2318.    --  Start of processing for Add_System_Rpc
  2319.  
  2320.    begin
  2321.       Name_Buffer (1 .. 12) := "system.rpc%s";
  2322.       Name_Len := 12;
  2323.       Uname := Name_Find;
  2324.       Unum := Load_Unit (Uname, False, Empty);
  2325.  
  2326.       if Unum = No_Unit then
  2327.          Failure ("unit not found");
  2328.       elsif Fatal_Error (Unum) then
  2329.          Failure ("parser errors");
  2330.       end if;
  2331.  
  2332.       --  Make sure that the unit is analyzed
  2333.  
  2334.       if not Analyzed (Cunit (Unum)) then
  2335.          Semantics (Cunit (Unum));
  2336.  
  2337.          if Fatal_Error (Unum) then
  2338.             Failure ("semantic errors");
  2339.          end if;
  2340.       end if;
  2341.  
  2342.       Lib_Unit := Unit (Cunit (Unum));
  2343.       UEntity := Defining_Unit_Simple_Name (Specification (Lib_Unit));
  2344.       Name_Node := Defining_Unit_Name (Specification (Lib_Unit));
  2345.  
  2346.       --  Add to the context clause
  2347.  
  2348.       Withn :=
  2349.         Make_With_Clause (Standard_Location,
  2350.           Name => New_Reference_To (UEntity, Standard_Location));
  2351.       Set_Library_Unit          (Withn, Cunit (Unum));
  2352.       Set_Corresponding_Spec    (Withn, UEntity);
  2353.       Set_First_Name            (Withn, True);
  2354.       Set_Implicit_With         (Withn, True);
  2355.       Mark_Rewrite_Insertion (Withn);
  2356.  
  2357.       if No (Contexts) then
  2358.          Set_Context_Items (C_Unit,
  2359.            New_List (
  2360.              Withn,
  2361.              Make_Use_Package_Clause (Standard_Location,
  2362.                Names => New_List (
  2363.                  New_Reference_To (UEntity, Standard_Location)))));
  2364.  
  2365.       else
  2366.          --  Do a search for the Use_Clause
  2367.  
  2368.          Context := First (Contexts);
  2369.          while Present (Context) and Use_Clause = Empty loop
  2370.             if Nkind (Context) = N_Use_Package_Clause then
  2371.                Use_Clause := Context;
  2372.  
  2373.             else
  2374.                Context := Next (Context);
  2375.             end if;
  2376.          end loop;
  2377.  
  2378.          Prepend (Withn, Contexts);
  2379.  
  2380.          if Present (Use_Clause) then
  2381.  
  2382.             if Present (Names (Use_Clause)) then
  2383.                Append_To (Names (Use_Clause),
  2384.                  New_Reference_To (UEntity, Standard_Location));
  2385.             else
  2386.                Set_Names (Use_Clause,
  2387.                  New_List (New_Reference_To (UEntity, Standard_Location)));
  2388.             end if;
  2389.  
  2390.          else
  2391.             Append_To (Contexts,
  2392.               Make_Use_Package_Clause (Standard_Location,
  2393.                 New_List (New_Reference_To (UEntity, Standard_Location))));
  2394.          end if;
  2395.       end if;
  2396.    end Add_System_Rpc;
  2397.  
  2398.    -------------------------------
  2399.    -- Remove_Categor_And_Import --
  2400.    -------------------------------
  2401.  
  2402.    procedure Remove_Categor_And_Import (From : List_Id) is
  2403.       Elmt         : Node_Id;
  2404.       To_Remove    : Node_Id;
  2405.       Next_Elmt    : Node_Id;
  2406.       Subp_Name_Id : Name_Id;
  2407.  
  2408.    begin
  2409.       if Present (From) then
  2410.          Elmt := First (From);
  2411.          while Present (Elmt) loop
  2412.             if Nkind (Elmt) = N_Pragma
  2413.               and then
  2414.               (Chars (Elmt) = Name_Remote_Call_Interface or else
  2415.                Chars (Elmt) = Name_Remote_Call_Interface or else
  2416.                Chars (Elmt) = Name_All_Calls_Remote or else
  2417.                Chars (Elmt) = Name_Pure or else
  2418.                Chars (Elmt) = Name_Remote_Types)
  2419.             then
  2420.                To_Remove := Elmt;
  2421.                Elmt := Next (Elmt);
  2422.                Remove (To_Remove);
  2423.  
  2424.             elsif Nkind (Elmt) = N_Subprogram_Declaration then
  2425.                Subp_Name_Id :=
  2426.                  Chars (Defining_Unit_Name (Specification (Elmt)));
  2427.  
  2428.                Next_Elmt  := Next (Elmt);
  2429.                while Present (Next_Elmt) loop
  2430.                   if Nkind (Next_Elmt) = N_Pragma
  2431.                     and then
  2432.                      (((Chars (Next_Elmt)  = Name_Asynchronous or else
  2433.                         Chars (Next_Elmt)  = Name_Interface_Name)
  2434.                        and then
  2435.                         Subp_Name_Id = Chars (Expression (First
  2436.                          (Pragma_Argument_Associations (Next_Elmt)))))
  2437.                        or else
  2438.                       ((Chars (Next_Elmt) = Name_Import or else
  2439.                         Chars (Next_Elmt) = Name_Interface)
  2440.                           and then
  2441.                         Subp_Name_Id = Chars (Expression (Next (First
  2442.                          (Pragma_Argument_Associations (Next_Elmt)))))))
  2443.                   then
  2444.                      To_Remove := Next_Elmt;
  2445.                      Next_Elmt := Next (Next_Elmt);
  2446.                      Remove (To_Remove);
  2447.  
  2448.                   else
  2449.                      Next_Elmt := Next (Next_Elmt);
  2450.                   end if;
  2451.                end loop;
  2452.  
  2453.                Elmt := Next (Elmt);
  2454.  
  2455.             elsif Nkind (Elmt) = N_Package_Declaration then
  2456.                Remove_Categor_And_Import
  2457.                  (Visible_Declarations (Specification (Elmt)));
  2458.                Elmt := Next (Elmt);
  2459.  
  2460.             else
  2461.                Elmt := Next (Elmt);
  2462.             end if;
  2463.  
  2464.          end loop;
  2465.       end if;
  2466.    end Remove_Categor_And_Import;
  2467.  
  2468.    ----------------------------
  2469.    -- Remove_Categorizations --
  2470.    ----------------------------
  2471.  
  2472.    procedure Remove_Categorizations (From : List_Id) is
  2473.       Elmt         : Node_Id;
  2474.       To_Remove    : Node_Id;
  2475.       Next_Elmt    : Node_Id;
  2476.       Subp_Name_Id : Name_Id;
  2477.  
  2478.    begin
  2479.       if Present (From) then
  2480.          Elmt := First (From);
  2481.          while Present (Elmt) loop
  2482.             if Nkind (Elmt) = N_Pragma
  2483.               and then
  2484.                (Chars (Elmt) = Name_Remote_Call_Interface or else
  2485.                 Chars (Elmt) = Name_Remote_Call_Interface or else
  2486.                 Chars (Elmt) = Name_All_Calls_Remote      or else
  2487.                 Chars (Elmt) = Name_Pure                  or else
  2488.                 Chars (Elmt) = Name_Remote_Types)
  2489.             then
  2490.                To_Remove := Elmt;
  2491.                Elmt := Next (Elmt);
  2492.                Remove (To_Remove);
  2493.  
  2494.             elsif Nkind (Elmt) = N_Subprogram_Declaration then
  2495.                Subp_Name_Id :=
  2496.                  Chars (Defining_Unit_Name (Specification (Elmt)));
  2497.  
  2498.                Next_Elmt  := Next (Elmt);
  2499.                while Present (Next_Elmt) loop
  2500.                   if Nkind (Next_Elmt) = N_Pragma
  2501.                     and then Chars (Next_Elmt)  = Name_Asynchronous
  2502.                     and then Subp_Name_Id = Chars (Expression (First
  2503.                       (Pragma_Argument_Associations (Next_Elmt))))
  2504.                   then
  2505.                      To_Remove := Next_Elmt;
  2506.                      Next_Elmt := Next (Next_Elmt);
  2507.                      Remove (To_Remove);
  2508.  
  2509.                   else
  2510.                      Next_Elmt := Next (Next_Elmt);
  2511.                   end if;
  2512.                end loop;
  2513.  
  2514.                Elmt := Next (Elmt);
  2515.  
  2516.             elsif Nkind (Elmt) = N_Package_Declaration then
  2517.  
  2518.                Remove_Categorizations
  2519.                  (Visible_Declarations (Specification (Elmt)));
  2520.  
  2521.                Elmt := Next (Elmt);
  2522.             else
  2523.                Elmt := Next (Elmt);
  2524.             end if;
  2525.          end loop;
  2526.       end if;
  2527.    end Remove_Categorizations;
  2528.  
  2529.    -----------------------
  2530.    -- Remove_Pragma_RCI --
  2531.    -----------------------
  2532.  
  2533.    procedure Remove_Pragma_RCI (From : List_Id) is
  2534.       Elmt : Node_Id;
  2535.  
  2536.    begin
  2537.       if Present (From) then
  2538.          Elmt := First (From);
  2539.          while Present (Elmt)
  2540.            and then (Nkind (Elmt) /= N_Pragma
  2541.                       or else Chars (Elmt) /= Name_Remote_Call_Interface)
  2542.          loop
  2543.             Elmt := Next (Elmt);
  2544.          end loop;
  2545.  
  2546.          if Present (Elmt) then
  2547.             Remove (Elmt);
  2548.          end if;
  2549.       end if;
  2550.    end Remove_Pragma_RCI;
  2551.  
  2552.    -----------------
  2553.    -- Ada_Streams --
  2554.    -----------------
  2555.  
  2556.    function Ada_Streams (Loc : Source_Ptr) return Node_Id is
  2557.    begin
  2558.       return
  2559.         Make_Selected_Component (Loc,
  2560.           Prefix => Make_Identifier (Loc, Name_Ada),
  2561.           Selector_Name => Make_Identifier (Loc, Name_Streams));
  2562.    end Ada_Streams;
  2563.  
  2564.    --------------------
  2565.    -- Ada_Exceptions --
  2566.    --------------------
  2567.  
  2568.    function Ada_Exceptions (Loc : Source_Ptr) return Node_Id is
  2569.    begin
  2570.       return
  2571.         Make_Selected_Component (Loc,
  2572.           Prefix => Make_Identifier (Loc, Name_Ada),
  2573.           Selector_Name => Make_Identifier (Loc, Exceptions_Name));
  2574.    end Ada_Exceptions;
  2575.  
  2576.    ----------------
  2577.    -- System_Rpc --
  2578.    ----------------
  2579.  
  2580.    function System_Rpc (Loc : Source_Ptr) return Node_Id is
  2581.    begin
  2582.       return
  2583.         Make_Selected_Component (Loc,
  2584.           Prefix => Make_Identifier (Loc, Name_System),
  2585.           Selector_Name => Make_Identifier (Loc, Name_Rpc));
  2586.    end System_Rpc;
  2587.  
  2588.    ---------------------------
  2589.    -- System_Rpc_PInterface --
  2590.    ---------------------------
  2591.  
  2592.    function System_Rpc_PInterface (Loc : Source_Ptr) return Node_Id is
  2593.    begin
  2594.       return
  2595.         Make_Selected_Component (Loc,
  2596.           Prefix => System_Rpc (Loc),
  2597.           Selector_Name => Make_Identifier (Loc, Partition_Interface_Name));
  2598.    end System_Rpc_PInterface;
  2599.  
  2600.    ---------------------
  2601.    -- SR_Partition_ID --
  2602.    ---------------------
  2603.  
  2604.    function SR_Partition_ID (Loc : Source_Ptr) return Node_Id is
  2605.    begin
  2606.       return
  2607.         Make_Selected_Component (Loc,
  2608.           Prefix => System_Rpc (Loc),
  2609.           Selector_Name => Make_Identifier (Loc, Name_Partition_ID));
  2610.    end SR_Partition_ID;
  2611.  
  2612.    ---------------------
  2613.    -- SR_RPC_Receiver --
  2614.    ---------------------
  2615.  
  2616.    function SR_RPC_Receiver (Loc : Source_Ptr) return Node_Id is
  2617.    begin
  2618.       return
  2619.         Make_Selected_Component (Loc,
  2620.           Prefix => System_Rpc (Loc),
  2621.           Selector_Name => Make_Identifier (Loc, RPC_Receiver_Name));
  2622.    end SR_RPC_Receiver;
  2623.  
  2624.    ---------------------------
  2625.    -- SR_Params_Stream_Type --
  2626.    ---------------------------
  2627.  
  2628.    function SR_Params_Stream_Type (Loc : Source_Ptr) return Node_Id is
  2629.    begin
  2630.       return
  2631.         Make_Selected_Component (Loc,
  2632.           Prefix => System_Rpc (Loc),
  2633.           Selector_Name => Make_Identifier (Loc, Params_Stream_Type_Name));
  2634.    end SR_Params_Stream_Type;
  2635.  
  2636.    ---------------
  2637.    -- SR_Do_Rpc --
  2638.    ---------------
  2639.  
  2640.    function SR_Do_Rpc (Loc : Source_Ptr) return Node_Id is
  2641.    begin
  2642.       return
  2643.         Make_Selected_Component (Loc,
  2644.           Prefix => System_Rpc (Loc),
  2645.           Selector_Name => Make_Identifier (Loc, Do_Rpc_Name));
  2646.    end SR_Do_Rpc;
  2647.  
  2648.    ---------------
  2649.    -- SR_Do_Apc --
  2650.    ---------------
  2651.  
  2652.    function SR_Do_Apc (Loc : Source_Ptr) return Node_Id is
  2653.    begin
  2654.       return
  2655.         Make_Selected_Component (Loc,
  2656.           Prefix => System_Rpc (Loc),
  2657.           Selector_Name => Make_Identifier (Loc, Do_Apc_Name));
  2658.    end SR_Do_Apc;
  2659.  
  2660.    -----------------------------
  2661.    -- AE_Exception_Occurrence --
  2662.    -----------------------------
  2663.  
  2664.    function AE_Exception_Occurrence (Loc : Source_Ptr) return Node_Id is
  2665.    begin
  2666.       return
  2667.         Make_Selected_Component (Loc,
  2668.           Prefix => Ada_Exceptions (Loc),
  2669.           Selector_Name => Make_Identifier (Loc, Exception_Occurrence_Name));
  2670.    end AE_Exception_Occurrence;
  2671.  
  2672.    ------------------------
  2673.    -- AE_Null_Occurrence --
  2674.    ------------------------
  2675.  
  2676.    function AE_Null_Occurrence (Loc : Source_Ptr) return Node_Id is
  2677.    begin
  2678.       return
  2679.         Make_Selected_Component (Loc,
  2680.           Prefix => Ada_Exceptions (Loc),
  2681.           Selector_Name => Make_Identifier (Loc, Null_Occurrence_Name));
  2682.    end AE_Null_Occurrence;
  2683.  
  2684.    ---------------------------
  2685.    -- AE_Reraise_Occurrence --
  2686.    ---------------------------
  2687.  
  2688.    function AE_Reraise_Occurrence (Loc : Source_Ptr) return Node_Id is
  2689.    begin
  2690.       return
  2691.         Make_Selected_Component (Loc,
  2692.           Prefix => Ada_Exceptions (Loc),
  2693.           Selector_Name => Make_Identifier (Loc, Reraise_Occurrence_Name));
  2694.    end AE_Reraise_Occurrence;
  2695.  
  2696.    -------------------------
  2697.    -- AS_Root_Stream_Type --
  2698.    -------------------------
  2699.  
  2700.    function AS_Root_Stream_Type (Loc : Source_Ptr) return Node_Id is
  2701.    begin
  2702.       return
  2703.          Make_Selected_Component (Loc,
  2704.            Prefix => Ada_Streams (Loc),
  2705.            Selector_Name => Make_Identifier (Loc, Root_Stream_Type_Name));
  2706.    end AS_Root_Stream_Type;
  2707.  
  2708.    -----------------------
  2709.    -- SRP_Subprogram_id --
  2710.    -----------------------
  2711.  
  2712.    function SRP_Subprogram_Id (Loc : Source_Ptr) return Node_Id is
  2713.    begin
  2714.       return
  2715.         Make_Selected_Component (Loc,
  2716.           Prefix => System_Rpc_PInterface (Loc),
  2717.           Selector_Name => Make_Identifier (Loc, Subprogram_Id_Name));
  2718.    end SRP_Subprogram_Id;
  2719.  
  2720.    --------------------------------
  2721.    -- SRP_Get_Local_Partition_Id --
  2722.    --------------------------------
  2723.  
  2724.    function SRP_Get_Local_Partition_Id (Loc : Source_Ptr) return Node_Id is
  2725.    begin
  2726.       return
  2727.         Make_Selected_Component (Loc,
  2728.           Prefix => System_Rpc_PInterface (Loc),
  2729.           Selector_Name => Make_Identifier (Loc, Get_Local_Partition_Id_Name));
  2730.    end SRP_Get_Local_Partition_Id;
  2731.  
  2732.    ---------------------------------
  2733.    -- SRP_Get_Active_Partition_Id --
  2734.    ---------------------------------
  2735.  
  2736.    function SRP_Get_Active_Partition_Id (Loc : Source_Ptr) return Node_Id is
  2737.    begin
  2738.       return
  2739.         Make_Selected_Component (Loc,
  2740.           Prefix => System_Rpc_PInterface (Loc),
  2741.           Selector_Name =>
  2742.             Make_Identifier (Loc, Get_Active_Partition_Id_Name));
  2743.    end SRP_Get_Active_Partition_Id;
  2744.  
  2745.    ----------------------------------
  2746.    -- SRP_Get_RCI_Package_Receiver --
  2747.    ----------------------------------
  2748.  
  2749.    function SRP_Get_RCI_Package_Receiver (Loc : Source_Ptr) return Node_Id is
  2750.    begin
  2751.       return
  2752.         Make_Selected_Component (Loc,
  2753.           Prefix => System_Rpc_PInterface (Loc),
  2754.           Selector_Name =>
  2755.             Make_Identifier (Loc, Get_RCI_Package_Receiver_Name));
  2756.    end SRP_Get_RCI_Package_Receiver;
  2757.  
  2758.    ---------------------------------------
  2759.    -- SRP_Register_Receiver_Elaboration --
  2760.    ---------------------------------------
  2761.  
  2762.    function SRP_Register_Receiver_Elaboration
  2763.      (Loc  : Source_Ptr)
  2764.       return Node_Id
  2765.    is
  2766.    begin
  2767.       return
  2768.         Make_Selected_Component (Loc,
  2769.           Prefix => System_Rpc_PInterface (Loc),
  2770.           Selector_Name =>
  2771.             Make_Identifier (Loc, Register_Receiver_Elaboration_Name));
  2772.    end SRP_Register_Receiver_Elaboration;
  2773.  
  2774.    -----------------------
  2775.    -- AStub_Param_Specs --
  2776.    -----------------------
  2777.  
  2778.    function AStub_Param_Specs (Loc : Source_Ptr) return List_Id is
  2779.    begin
  2780.       return
  2781.         New_List (
  2782.           Make_Parameter_Specification (Loc,
  2783.             Defining_Identifier => Make_Defining_Identifier (Loc, Params_Name),
  2784.             Parameter_Type =>
  2785.               Make_Access_Definition (Loc,
  2786.                 Subtype_Mark => SR_Params_Stream_Type (Loc))));
  2787.    end AStub_Param_Specs;
  2788.  
  2789.    -----------------------
  2790.    -- NStub_Param_Specs --
  2791.    -----------------------
  2792.  
  2793.    function NStub_Param_Specs (Loc : Source_Ptr) return List_Id is
  2794.    begin
  2795.       return
  2796.         New_List (
  2797.           Make_Parameter_Specification (Loc,
  2798.             Defining_Identifier => Make_Defining_Identifier (Loc, Params_Name),
  2799.             Parameter_Type =>
  2800.               Make_Access_Definition (Loc,
  2801.                 Subtype_Mark => SR_Params_Stream_Type (Loc))),
  2802.  
  2803.           Make_Parameter_Specification (Loc,
  2804.             Defining_Identifier => Make_Defining_Identifier (Loc, Result_Name),
  2805.             Parameter_Type =>
  2806.               Make_Access_Definition (Loc,
  2807.                 Subtype_Mark => SR_Params_Stream_Type (Loc))));
  2808.    end NStub_Param_Specs;
  2809.  
  2810.    ----------------------------
  2811.    -- Build_Parent_Full_Name --
  2812.    ----------------------------
  2813.  
  2814.    function Build_Parent_Full_Name (P : Node_Id) return Node_Id is
  2815.       Loc   : Source_Ptr := Sloc (P);
  2816.       P_Ref : Node_Id := New_Reference_To (Find_Lib_Unit_Entity (P), Loc);
  2817.  
  2818.    begin
  2819.       if No (Parent_Spec (P)) then
  2820.          return P_Ref;
  2821.       else
  2822.          return
  2823.            Make_Selected_Component (Loc,
  2824.              Prefix => Build_Parent_Full_Name (Unit (Parent_Spec (P))),
  2825.              Selector_Name => P_Ref);
  2826.       end if;
  2827.    end Build_Parent_Full_Name;
  2828.  
  2829.    --------------------------
  2830.    -- Build_Unit_Full_Name --
  2831.    --------------------------
  2832.  
  2833.    function Build_Unit_Full_Name (U : Node_Id) return Node_Id is
  2834.       Loc    : Source_Ptr := Sloc (U);
  2835.       U_Name : Entity_Id := Find_Lib_Unit_Entity (U);
  2836.       Result : Node_Id;
  2837.  
  2838.    begin
  2839.       if No (Parent_Spec (U)) then
  2840.          return New_Reference_To (U_Name, Loc);
  2841.  
  2842.       else
  2843.          Result :=
  2844.            Make_Expanded_Name (Loc,
  2845.              Chars  => Chars (U_Name),
  2846.              Prefix => Build_Parent_Full_Name (Unit (Parent_Spec (U))),
  2847.              Selector_Name => New_Reference_To (U_Name, Loc));
  2848.  
  2849.          Set_Entity (Result, U_Name);
  2850.          return Result;
  2851.       end if;
  2852.    end Build_Unit_Full_Name;
  2853.  
  2854.    ---------------------------------
  2855.    -- New_List_Copy_Original_Tree --
  2856.    ---------------------------------
  2857.  
  2858.    function New_List_Copy_Original_Tree (L : List_Id) return List_Id is
  2859.       NL   : List_Id;
  2860.       Elmt : Node_Id;
  2861.  
  2862.    begin
  2863.       if L = No_List then
  2864.          return No_List;
  2865.  
  2866.       else
  2867.          NL   := New_List;
  2868.          Elmt := First (L);
  2869.  
  2870.          while Present (Elmt) loop
  2871.             Append (Copy_Original_Tree (Elmt), NL);
  2872.             Elmt := Next (Elmt);
  2873.          end loop;
  2874.  
  2875.          return NL;
  2876.       end if;
  2877.  
  2878.    end New_List_Copy_Original_Tree;
  2879.  
  2880.    --------------------------
  2881.    -- Find_Lib_Unit_Entity --
  2882.    --------------------------
  2883.  
  2884.    function Find_Lib_Unit_Entity (Lib_Unit : Node_Id) return Entity_Id is
  2885.    begin
  2886.       if Nkind (Lib_Unit) in N_Generic_Instantiation
  2887.         or else Nkind (Lib_Unit)  = N_Package_Renaming_Declaration
  2888.         or else Nkind (Lib_Unit) in N_Generic_Renaming_Declaration
  2889.       then
  2890.          return Defining_Unit_Simple_Name (Lib_Unit);
  2891.  
  2892.       else
  2893.          return Defining_Unit_Simple_Name (Specification (Lib_Unit));
  2894.       end if;
  2895.    end Find_Lib_Unit_Entity;
  2896.  
  2897.    -----------------
  2898.    -- Get_Name_Id --
  2899.    -----------------
  2900.  
  2901.    function Get_Name_Id (Name : String) return Name_Id is
  2902.    begin
  2903.       Name_Len := Name'Length;
  2904.       Name_Buffer (1 .. Name_Len) := Name;
  2905.       return Name_Find;
  2906.    end Get_Name_Id;
  2907.  
  2908.    ----------------------------
  2909.    -- Get_Pkg_Name_string_id --
  2910.    ----------------------------
  2911.  
  2912.    function Get_Pkg_Name_String_Id (Decl_Node : Node_Id) return String_Id is
  2913.       Unit_Name_Id : Unit_Name_Type := Get_Unit_Name (Decl_Node);
  2914.  
  2915.    begin
  2916.       Get_Unit_Name_String (Unit_Name_Id);
  2917.  
  2918.       --  Remove seven last character ("(spec)" or " (body)").
  2919.  
  2920.       Name_Len := Name_Len - 7;
  2921.       return Get_String_Id (Name_Buffer (1 .. Name_Len));
  2922.    end Get_Pkg_Name_String_Id;
  2923.  
  2924.    -------------------
  2925.    -- Get_String_Id --
  2926.    -------------------
  2927.  
  2928.    function Get_String_Id (Val : String) return String_Id is
  2929.    begin
  2930.       Start_String;
  2931.       Store_String_Chars (Val);
  2932.       return End_String;
  2933.    end Get_String_Id;
  2934.  
  2935.    --------------------
  2936.    -- Has_Pragma_RCI --
  2937.    --------------------
  2938.  
  2939.    function Has_Pragma_RCI (L : List_Id) return Boolean is
  2940.       Decl : Node_Id;
  2941.  
  2942.    begin
  2943.       if Present (L) then
  2944.          Decl := First (L);
  2945.          while Present (Decl)
  2946.            and then (Nkind (Decl) /= N_Pragma
  2947.                       or else Chars (Decl) /= Name_Remote_Call_Interface)
  2948.          loop
  2949.             Decl := Next (Decl);
  2950.          end loop;
  2951.  
  2952.          if Present (Decl) then
  2953.             return True;
  2954.          end if;
  2955.       end if;
  2956.  
  2957.       return False;
  2958.    end Has_Pragma_RCI;
  2959.  
  2960.    ----------------------
  2961.    -- Has_Unknown_Size --
  2962.    ----------------------
  2963.  
  2964.    function Has_Unknown_Size (E : Entity_Id) return Boolean is
  2965.    begin
  2966.       return Has_Unknown_Discriminants (E) or else
  2967.         ((Is_Array_Type (E) or Is_Record_Type (E) or Is_String_Type (E))
  2968.          and then not Is_Constrained (E));
  2969.    end Has_Unknown_Size;
  2970.  
  2971.    ---------------------------------
  2972.    -- Is_ACW_Limited_Private_Type --
  2973.    ---------------------------------
  2974.  
  2975.    function Is_ACWLP_Type (E : Entity_Id) return Boolean is
  2976.       DD : Node_Id;
  2977.       ED : Node_Id;
  2978.       EE : Entity_Id;
  2979.    begin
  2980.       if Ekind (E) = E_General_Access_Type then
  2981.          DD := Directly_Designated_Type (E);
  2982.          ED := Parent (Etype (DD));
  2983.  
  2984.          if Nkind (ED) = N_Private_Type_Declaration
  2985.            and then Limited_Present (ED)
  2986.            and then Ekind (DD) = E_Class_Wide_Type
  2987.          then
  2988.             return True;
  2989.          end if;
  2990.       end if;
  2991.  
  2992.       return False;
  2993.    end Is_ACWLP_Type;
  2994.  
  2995.    ---------------------------
  2996.    -- Is_RCI_Pkg_Decl_Cunit --
  2997.    ---------------------------
  2998.  
  2999.    function Is_RCI_Pkg_Decl_Cunit (Cunit : Node_Id) return Boolean is
  3000.       The_Unit : constant Node_Id := Unit (Cunit);
  3001.  
  3002.    begin
  3003.       return
  3004.          Nkind (The_Unit) = N_Package_Declaration
  3005.            and then
  3006.             (Has_Pragma_RCI (Visible_Declarations (Specification (The_Unit)))
  3007.                or else Has_Pragma_RCI (Following_Pragmas (Cunit)));
  3008.    end Is_RCI_Pkg_Decl_Cunit;
  3009.  
  3010.    -----------------------------
  3011.    -- Is_RCI_Pkg_Spec_Or_Body --
  3012.    -----------------------------
  3013.  
  3014.    function Is_RCI_Pkg_Spec_Or_Body (Cunit : Node_Id) return Boolean is
  3015.    begin
  3016.       return Is_RCI_Pkg_Decl_Cunit (Cunit)
  3017.         or else
  3018.          (Nkind (Unit (Cunit)) = N_Package_Body
  3019.            and then Is_RCI_Pkg_Decl_Cunit (Library_Unit (Cunit)));
  3020.    end Is_RCI_Pkg_Spec_Or_Body;
  3021.  
  3022.    -------------------------------------
  3023.    -- Build_Calling_Stubs_Bodies_Cunit --
  3024.    -------------------------------------
  3025.  
  3026.    function Build_Calling_Stubs_Bodies_Cunit
  3027.      (RCI_Cunit : Node_Id)
  3028.       return      Node_Id
  3029.    is
  3030.       --  Features needed from the input compilation unit
  3031.  
  3032.       Loc                 : Source_Ptr := Sloc (RCI_Cunit);
  3033.       RCI_Decl            : Node_Id    := Unit (RCI_Cunit);
  3034.       RCI_Spec            : Node_Id    := Specification (RCI_Decl);
  3035.       RCI_Pkg_Name        : Node_Id    := Defining_Unit_Name (RCI_Spec);
  3036.       RCI_Pkg_Name_String : String_Id  := Get_Pkg_Name_String_Id (RCI_Decl);
  3037.  
  3038.       --  Features for the stub package body to create
  3039.  
  3040.       Package_Body        : Node_Id;
  3041.       Package_Body_CItems : List_Id := New_List;
  3042.       Package_Body_Decls  : List_Id := New_List;
  3043.  
  3044.       --  List of local names needed
  3045.  
  3046.       When_Elaborated_Name  : Name_Id := Get_Name_Id ("when_elaborated");
  3047.       Receiver_Name         : Name_Id := Get_Name_Id ("receiver");
  3048.       Partition_Name        : Name_Id := Get_Name_Id ("partition");
  3049.       Done_Name             : Name_Id := Get_Name_Id ("done");
  3050.       Boolean_Name          : Name_Id := Get_Name_Id ("boolean");
  3051.       True_Name             : Name_Id := Get_Name_Id ("true");
  3052.       False_Name            : Name_Id := Get_Name_Id ("false");
  3053.       Get_Rci_Data_Name     : Name_Id := Get_Name_Id ("get_rci_data");
  3054.       Set_Rci_Data_Name     : Name_Id := Get_Name_Id ("set_rci_data");
  3055.       Elaborated_Name       : Name_Id := Get_Name_Id ("elaborated");
  3056.       In_Progress_Name      : Name_Id := Get_Name_Id ("in_progress");
  3057.       Active_Partition_Name : Name_Id := Get_Name_Id ("active_partition");
  3058.       Package_Receiver_Name : Name_Id := Get_Name_Id ("package_receiver");
  3059.  
  3060.       --  A number is given to each subprogram which is callable remotely;
  3061.       --  it will be used together with the Package Id to compute the
  3062.       --  corresponding Service_ID.
  3063.  
  3064.       Subp_Num : Int := 0;
  3065.       Racw_Num : Int := 0;
  3066.  
  3067.    --  Start of processing for Build_Calling_Stubs_Cunits
  3068.  
  3069.    begin
  3070.       --  Build the stub subprogram bodies
  3071.  
  3072.       Build_Calling_Stubs_Pkg_Body
  3073.         (RCI_Decl, Subp_Num, Racw_Num, Package_Body);
  3074.  
  3075.       Package_Body_Decls := Declarations (Package_Body);
  3076.  
  3077.       --  Prepend the declaration of Get_Active_Partition_Id and
  3078.       --  Get_RCI_Package_Receiver to the declarations
  3079.  
  3080.       Prepend_To (Package_Body_Decls,
  3081.         Make_Subprogram_Declaration (Loc,
  3082.           Specification =>
  3083.             Make_Function_Specification (Loc,
  3084.               Defining_Unit_Name =>
  3085.                 Make_Defining_Identifier (Loc, Get_Active_Partition_Id_Name),
  3086.               Subtype_Mark => SR_Partition_ID (Loc))));
  3087.  
  3088.       Prepend_To (Package_Body_Decls,
  3089.         Make_Subprogram_Declaration (Loc,
  3090.           Specification =>
  3091.             Make_Function_Specification (Loc,
  3092.               Defining_Unit_Name =>
  3093.                 Make_Defining_Identifier (Loc, Get_RCI_Package_Receiver_Name),
  3094.               Subtype_Mark => SR_RPC_Receiver (Loc))));
  3095.  
  3096.       --  Build and prepend the declaration of the protected object used for
  3097.       --  elaboration control
  3098.  
  3099.       Prepend_To (Package_Body_Decls,
  3100.         Make_Single_Protected_Declaration (Loc,
  3101.           Defining_Identifier =>
  3102.             Make_Defining_Identifier (Loc, When_Elaborated_Name),
  3103.           Protected_Definition =>
  3104.             Make_Protected_Definition (Loc,
  3105.  
  3106.               Visible_Declarations => New_List (
  3107.                 Make_Entry_Declaration (Loc,
  3108.                   Defining_Identifier =>
  3109.                     Make_Defining_Identifier (Loc, Get_Rci_Data_Name),
  3110.                   Parameter_Specifications => New_List (
  3111.  
  3112.                     Make_Parameter_Specification (Loc,
  3113.                       Defining_Identifier =>
  3114.                         Make_Defining_Identifier (Loc, Receiver_Name),
  3115.                       Out_Present => True,
  3116.                       Parameter_Type => SR_RPC_Receiver (Loc)),
  3117.  
  3118.                     Make_Parameter_Specification (Loc,
  3119.                       Defining_Identifier =>
  3120.                         Make_Defining_Identifier (Loc, Partition_Name),
  3121.                       Out_Present => True,
  3122.                       Parameter_Type => SR_Partition_ID (Loc)),
  3123.  
  3124.                     Make_Parameter_Specification (Loc,
  3125.                       Defining_Identifier =>
  3126.                         Make_Defining_Identifier (Loc, Done_Name),
  3127.                       Out_Present => True,
  3128.                       Parameter_Type => Make_Identifier (Loc, Boolean_Name)))),
  3129.  
  3130.                 Make_Subprogram_Declaration (Loc,
  3131.                   Specification =>
  3132.                     Make_Procedure_Specification (Loc,
  3133.                       Defining_Unit_Name =>
  3134.                         Make_Defining_Identifier (Loc, Set_Rci_Data_Name),
  3135.  
  3136.                       Parameter_Specifications => New_List (
  3137.                         Make_Parameter_Specification (Loc,
  3138.                           Defining_Identifier =>
  3139.                             Make_Defining_Identifier (Loc, Receiver_Name),
  3140.                           Parameter_Type => SR_RPC_Receiver (Loc)),
  3141.  
  3142.                         Make_Parameter_Specification (Loc,
  3143.                           Defining_Identifier =>
  3144.                             Make_Defining_Identifier (Loc, Partition_Name),
  3145.                           Parameter_Type => SR_Partition_ID (Loc)))))),
  3146.  
  3147.               Private_Declarations => New_List (
  3148.                 Make_Object_Declaration (Loc,
  3149.                   Defining_Identifier =>
  3150.                     Make_Defining_Identifier (Loc, Elaborated_Name),
  3151.                   Object_Definition => Make_Identifier (Loc, Boolean_Name),
  3152.                   Expression => Make_Identifier (Loc, False_Name)),
  3153.  
  3154.                 Make_Object_Declaration (Loc,
  3155.                   Defining_Identifier =>
  3156.                     Make_Defining_Identifier (Loc, In_Progress_Name),
  3157.                   Object_Definition => Make_Identifier (Loc, Boolean_Name),
  3158.                   Expression => Make_Identifier (Loc, False_Name)),
  3159.  
  3160.                 Make_Object_Declaration (Loc,
  3161.                   Defining_Identifier =>
  3162.                     Make_Defining_Identifier (Loc, Active_Partition_Name),
  3163.                   Object_Definition => SR_Partition_ID (Loc)),
  3164.  
  3165.                 Make_Object_Declaration (Loc,
  3166.                   Defining_Identifier =>
  3167.                     Make_Defining_Identifier (Loc, Package_Receiver_Name),
  3168.                   Object_Definition => SR_RPC_Receiver (Loc))))));
  3169.  
  3170.       --  append the body of the protected object
  3171.  
  3172.       Append_To (Package_Body_Decls,
  3173.         Make_Protected_Body (Loc,
  3174.           Defining_Identifier =>
  3175.             Make_Defining_Identifier (Loc, When_Elaborated_Name),
  3176.  
  3177.           Declarations => New_List (
  3178.             Make_Entry_Body (Loc,
  3179.               Defining_Identifier =>
  3180.                 Make_Defining_Identifier (Loc, Get_Rci_Data_Name),
  3181.               Entry_Body_Formal_Part =>
  3182.  
  3183.                 Make_Entry_Body_Formal_Part (Loc,
  3184.                   Parameter_Specifications => New_List (
  3185.                     Make_Parameter_Specification (Loc,
  3186.                       Defining_Identifier =>
  3187.                         Make_Defining_Identifier (Loc, Receiver_Name),
  3188.                       Out_Present => True,
  3189.                       Parameter_Type => SR_RPC_Receiver (Loc)),
  3190.  
  3191.                     Make_Parameter_Specification (Loc,
  3192.                       Defining_Identifier =>
  3193.                         Make_Defining_Identifier (Loc, Partition_Name),
  3194.                       Out_Present => True,
  3195.                       Parameter_Type => SR_Partition_ID (Loc)),
  3196.  
  3197.                     Make_Parameter_Specification (Loc,
  3198.                       Defining_Identifier =>
  3199.                         Make_Defining_Identifier (Loc, Done_Name),
  3200.                       Out_Present => True,
  3201.                       Parameter_Type => Make_Identifier (Loc, Boolean_Name))),
  3202.  
  3203.                   Condition =>
  3204.                     Make_Or_Else (Loc,
  3205.                       Left_Opnd => Make_Identifier (Loc, Elaborated_Name),
  3206.                       Right_Opnd =>
  3207.                         Make_Op_Not (Loc,
  3208.                           Right_Opnd =>
  3209.                             Make_Identifier (Loc, In_Progress_Name)))),
  3210.  
  3211.               Declarations => New_List,
  3212.  
  3213.               Handled_Statement_Sequence =>
  3214.                 Make_Handled_Sequence_Of_Statements (Loc,
  3215.                   Statements => New_List (
  3216.                     Make_If_Statement (Loc,
  3217.                       Condition => Make_Identifier (Loc, Elaborated_Name),
  3218.                       Then_Statements => New_List (
  3219.  
  3220.                         Make_Assignment_Statement (Loc,
  3221.                           Name => Make_Identifier (Loc, Receiver_Name),
  3222.                           Expression =>
  3223.                             Make_Identifier (Loc, Package_Receiver_Name)),
  3224.  
  3225.                         Make_Assignment_Statement (Loc,
  3226.                           Name => Make_Identifier (Loc, Partition_Name),
  3227.                           Expression =>
  3228.                             Make_Identifier (Loc, Active_Partition_Name)),
  3229.  
  3230.                         Make_Assignment_Statement (Loc,
  3231.                           Name => Make_Identifier (Loc, Done_Name),
  3232.                           Expression => Make_Identifier (Loc, True_Name))),
  3233.  
  3234.                       Else_Statements => New_List (
  3235.                         Make_Assignment_Statement (Loc,
  3236.                           Name => Make_Identifier (Loc, In_Progress_Name),
  3237.                           Expression => Make_Identifier (Loc, True_Name)),
  3238.  
  3239.                         Make_Assignment_Statement (Loc,
  3240.                           Name => Make_Identifier (Loc, Done_Name),
  3241.                           Expression =>
  3242.                             Make_Identifier (Loc, False_Name))))))),
  3243.  
  3244.             Make_Subprogram_Body (Loc,
  3245.               Specification =>
  3246.                 Make_Procedure_Specification (Loc,
  3247.                   Defining_Unit_Name =>
  3248.                     Make_Defining_Identifier (Loc, Set_Rci_Data_Name),
  3249.  
  3250.                   Parameter_Specifications => New_List (
  3251.                     Make_Parameter_Specification (Loc,
  3252.                       Defining_Identifier =>
  3253.                         Make_Defining_Identifier (Loc, Receiver_Name),
  3254.                       Parameter_Type => SR_RPC_Receiver (Loc)),
  3255.  
  3256.                     Make_Parameter_Specification (Loc,
  3257.                       Defining_Identifier =>
  3258.                         Make_Defining_Identifier (Loc, Partition_Name),
  3259.                       Parameter_Type => SR_Partition_ID (Loc)))),
  3260.  
  3261.               Declarations => New_List,
  3262.  
  3263.               Handled_Statement_Sequence =>
  3264.                 Make_Handled_Sequence_Of_Statements (Loc,
  3265.                   Statements => New_List (
  3266.                     Make_Assignment_Statement (Loc,
  3267.                       Name => Make_Identifier (Loc, Package_Receiver_Name),
  3268.                       Expression => Make_Identifier (Loc, Receiver_Name)),
  3269.  
  3270.                     Make_Assignment_Statement (Loc,
  3271.                       Name => Make_Identifier (Loc, Active_Partition_Name),
  3272.                       Expression => Make_Identifier (Loc, Partition_Name)),
  3273.  
  3274.                     Make_Assignment_Statement (Loc,
  3275.                       Name => Make_Identifier (Loc, Elaborated_Name),
  3276.                       Expression => Make_Identifier (Loc, True_Name))))))));
  3277.  
  3278.  
  3279.       --  Append the body of Get_Active_Partition_Id
  3280.  
  3281.       Append_To (Package_Body_Decls,
  3282.  
  3283.         Make_Subprogram_Body (Loc,
  3284.  
  3285.           Specification =>
  3286.             Make_Function_Specification (Loc,
  3287.               Defining_Unit_Name =>
  3288.                 Make_Identifier (Loc, Get_Active_Partition_Id_Name),
  3289.               Subtype_Mark => SR_Partition_ID (Loc)),
  3290.  
  3291.           Declarations => New_List (
  3292.             Make_Object_Declaration (Loc,
  3293.               Defining_Identifier =>
  3294.                 Make_Defining_Identifier (Loc, Receiver_Name),
  3295.               Object_Definition => SR_RPC_Receiver (Loc)),
  3296.  
  3297.             Make_Object_Declaration (Loc,
  3298.               Defining_Identifier =>
  3299.                 Make_Defining_Identifier (Loc, Partition_Name),
  3300.               Object_Definition => SR_Partition_ID (Loc)),
  3301.  
  3302.             Make_Object_Declaration (Loc,
  3303.               Defining_Identifier =>
  3304.                 Make_Defining_Identifier (Loc, Done_Name),
  3305.               Object_Definition => Make_Identifier (Loc, Boolean_Name))),
  3306.  
  3307.           Handled_Statement_Sequence =>
  3308.             Make_Handled_Sequence_Of_Statements (Loc,
  3309.               Statements => New_List (
  3310.  
  3311.                 Make_Entry_Call_Statement (Loc,
  3312.                   Name =>
  3313.                     Make_Selected_Component (Loc,
  3314.                       Prefix => Make_Identifier (Loc, When_Elaborated_Name),
  3315.                       Selector_Name =>
  3316.                         Make_Identifier (Loc, Get_Rci_Data_Name)),
  3317.  
  3318.                   Parameter_Associations => New_List (
  3319.                     Make_Identifier (Loc, Receiver_Name),
  3320.                     Make_Identifier (Loc, Partition_Name),
  3321.                     Make_Identifier (Loc, Done_Name))),
  3322.  
  3323.                 Make_If_Statement (Loc,
  3324.                   Condition => Make_Identifier (Loc, Done_Name),
  3325.                   Then_Statements => New_List (
  3326.                     Make_Return_Statement (Loc,
  3327.                       Expression => Make_Identifier (Loc, Partition_Name))),
  3328.                   Else_Statements => New_List (
  3329.  
  3330.                     Make_Assignment_Statement (Loc,
  3331.                       Name => Make_Identifier (Loc, Partition_Name),
  3332.                       Expression =>
  3333.                         Make_Function_Call (Loc,
  3334.                           Name => SRP_Get_Active_Partition_Id (Loc),
  3335.                           Parameter_Associations => New_List (
  3336.                             Make_String_Literal (Loc, RCI_Pkg_Name_String)))),
  3337.  
  3338.                     Make_Assignment_Statement (Loc,
  3339.                       Name => Make_Identifier (Loc, Receiver_Name),
  3340.                       Expression =>
  3341.                         Make_Function_Call (Loc,
  3342.                           Name => SRP_Get_RCI_Package_Receiver (Loc),
  3343.                           Parameter_Associations => New_List (
  3344.                             Make_String_Literal (Loc, RCI_Pkg_Name_String)))),
  3345.  
  3346.                     Make_Entry_Call_Statement (Loc,
  3347.                       Name =>
  3348.                         Make_Selected_Component (Loc,
  3349.                           Prefix =>
  3350.                             Make_Identifier (Loc, When_Elaborated_Name),
  3351.                           Selector_Name =>
  3352.                             Make_Identifier (Loc, Set_Rci_Data_Name)),
  3353.  
  3354.                       Parameter_Associations => New_List (
  3355.                         Make_Identifier (Loc, Receiver_Name),
  3356.                         Make_Identifier (Loc, Partition_Name))),
  3357.  
  3358.                     Make_Return_Statement (Loc,
  3359.                       Expression =>
  3360.                         Make_Identifier (Loc, Partition_Name))))))));
  3361.  
  3362.       --  Append the body of Get_Rci_Package_Receiver
  3363.  
  3364.       Append_To (Package_Body_Decls,
  3365.  
  3366.         Make_Subprogram_Body (Loc,
  3367.  
  3368.           Specification =>
  3369.             Make_Function_Specification (Loc,
  3370.               Defining_Unit_Name =>
  3371.                 Make_Identifier (Loc, Get_RCI_Package_Receiver_Name),
  3372.               Subtype_Mark => SR_RPC_Receiver (Loc)),
  3373.  
  3374.           Declarations => New_List (
  3375.             Make_Object_Declaration (Loc,
  3376.               Defining_Identifier =>
  3377.                 Make_Defining_Identifier (Loc, Receiver_Name),
  3378.               Object_Definition => SR_RPC_Receiver (Loc)),
  3379.  
  3380.             Make_Object_Declaration (Loc,
  3381.               Defining_Identifier =>
  3382.                 Make_Defining_Identifier (Loc, Partition_Name),
  3383.               Object_Definition => SR_Partition_ID (Loc)),
  3384.  
  3385.             Make_Object_Declaration (Loc,
  3386.               Defining_Identifier =>
  3387.                 Make_Defining_Identifier (Loc, Done_Name),
  3388.               Object_Definition => Make_Identifier (Loc, Boolean_Name))),
  3389.  
  3390.           Handled_Statement_Sequence =>
  3391.             Make_Handled_Sequence_Of_Statements (Loc,
  3392.               Statements => New_List (
  3393.  
  3394.                 Make_Entry_Call_Statement (Loc,
  3395.                   Name =>
  3396.                     Make_Selected_Component (Loc,
  3397.                       Prefix => Make_Identifier (Loc, When_Elaborated_Name),
  3398.                       Selector_Name =>
  3399.                         Make_Identifier (Loc, Get_Rci_Data_Name)),
  3400.  
  3401.                   Parameter_Associations => New_List (
  3402.                     Make_Identifier (Loc, Receiver_Name),
  3403.                     Make_Identifier (Loc, Partition_Name),
  3404.                     Make_Identifier (Loc, Done_Name))),
  3405.  
  3406.                 Make_If_Statement (Loc,
  3407.                   Condition => Make_Identifier (Loc, Done_Name),
  3408.                   Then_Statements => New_List (
  3409.                     Make_Return_Statement (Loc,
  3410.                       Expression => Make_Identifier (Loc, Receiver_Name))),
  3411.                   Else_Statements => New_List (
  3412.  
  3413.                     Make_Assignment_Statement (Loc,
  3414.                       Name => Make_Identifier (Loc, Partition_Name),
  3415.                       Expression =>
  3416.                         Make_Function_Call (Loc,
  3417.                           Name => SRP_Get_Active_Partition_Id (Loc),
  3418.                           Parameter_Associations => New_List (
  3419.                             Make_String_Literal (Loc, RCI_Pkg_Name_String)))),
  3420.  
  3421.                     Make_Assignment_Statement (Loc,
  3422.                       Name => Make_Identifier (Loc, Receiver_Name),
  3423.                       Expression =>
  3424.                         Make_Function_Call (Loc,
  3425.                           Name => SRP_Get_RCI_Package_Receiver (Loc),
  3426.                           Parameter_Associations => New_List (
  3427.                             Make_String_Literal (Loc, RCI_Pkg_Name_String)))),
  3428.  
  3429.                     Make_Entry_Call_Statement (Loc,
  3430.                       Name =>
  3431.                         Make_Selected_Component (Loc,
  3432.                           Prefix =>
  3433.                             Make_Identifier (Loc, When_Elaborated_Name),
  3434.                           Selector_Name =>
  3435.                             Make_Identifier (Loc, Set_Rci_Data_Name)),
  3436.  
  3437.                       Parameter_Associations => New_List (
  3438.                         Make_Identifier (Loc, Receiver_Name),
  3439.                         Make_Identifier (Loc, Partition_Name))),
  3440.  
  3441.                     Make_Return_Statement (Loc,
  3442.                       Expression =>
  3443.                         Make_Identifier (Loc, Receiver_Name))))))));
  3444.  
  3445.       --  Build the context items
  3446.  
  3447.       Package_Body_CItems := New_List (
  3448.         Make_With_Clause (Loc, Ada_Streams (Loc)),
  3449.         Make_With_Clause (Loc, Ada_Exceptions (Loc)),
  3450.         Make_With_Clause (Loc, System_Rpc_PInterface (Loc)));
  3451.  
  3452.       --  Add unchecked_conversion to the context clause
  3453.  
  3454.       if Racw_Num /= 0 then
  3455.          Append_To (Package_Body_CItems,
  3456.            Make_With_Clause (Loc,
  3457.              Name => Make_Identifier (Loc, Unchecked_Conversion_Name)));
  3458.       end if;
  3459.  
  3460.       --  Build the compilation unit for the calling stubs package body
  3461.  
  3462.       return
  3463.         Make_Compilation_Unit (Loc,
  3464.           Context_Items => Package_Body_CItems,
  3465.           Unit => Package_Body);
  3466.  
  3467.    end Build_Calling_Stubs_Bodies_Cunit;
  3468.  
  3469.    ----------------------------------
  3470.    -- To_Calling_Stubs_Decls_Cunit --
  3471.    ----------------------------------
  3472.  
  3473.    procedure To_Calling_Stubs_Decls_Cunit (RCI_Decl_Cunit : Node_Id) is
  3474.  
  3475.       --  Features needed from the input compilation unit
  3476.  
  3477.       Contexts     : List_Id    := Context_Items (RCI_Decl_Cunit);
  3478.       RCI_Decl     : Node_Id    := Unit (RCI_Decl_Cunit);
  3479.       RCI_Spec     : Node_Id    := Specification (RCI_Decl);
  3480.       Vis_Decls    : List_Id    := Visible_Declarations (RCI_Spec);
  3481.  
  3482.    begin
  3483.       --  Initialization of names
  3484.  
  3485.       Init_Names;
  3486.  
  3487.       --  Remove categorizations
  3488.  
  3489.       Remove_Categorizations (Contexts);
  3490.       Remove_Categor_And_Import (Vis_Decls);
  3491.  
  3492.       --  If the unit is a child spec, then the parent spec must also be
  3493.       --  transformed into the corresponding calling stubs package spec.
  3494.  
  3495.       if Present (Parent_Spec (RCI_Decl)) then
  3496.          To_Calling_Stubs_Decls_Cunit (Parent_Spec (RCI_Decl));
  3497.       end if;
  3498.    end To_Calling_Stubs_Decls_Cunit;
  3499.  
  3500.    ----------------------------------
  3501.    -- Build_Calling_Stubs_Pkg_Body --
  3502.    ----------------------------------
  3503.  
  3504.    procedure Build_Calling_Stubs_Pkg_Body
  3505.      (Pkg_Decl            : in Node_Id;
  3506.       Last_Stub_Num       : in out Int;
  3507.       Last_Racw_Num       : in out Int;
  3508.       Stubs_Pkg_Body      : out Node_Id)
  3509.    is
  3510.       --  Features needed from the input declaration
  3511.  
  3512.       Loc       : Source_Ptr := Sloc (Pkg_Decl);
  3513.       Spec      : Node_Id    := Specification (Pkg_Decl);
  3514.       Vis_Decls : List_Id    := Visible_Declarations (Spec);
  3515.       Pkg_Name  : Node_Id    := Defining_Unit_Name (Spec);
  3516.       Vis_Decl  : Node_Id;
  3517.  
  3518.       --  Features for the stub package body to create
  3519.  
  3520.       Package_Body_Decls   : List_Id := New_List;
  3521.       Package_Body         : Node_Id;
  3522.       Inner_Stubs_Pkg_Body : Node_Id;
  3523.  
  3524.       -----------------------
  3525.       -- Local Subprograms --
  3526.       -----------------------
  3527.  
  3528.       function Build_Async_Calling_Stub_Body
  3529.         (Vis_Decl : Node_Id)
  3530.          return     Node_Id;
  3531.       --  Builds the body of the calling stub for an asynchronous remote call
  3532.       --  interface subprogram. The input parameter is supposed to be the
  3533.       --  non-empty declaration node of the subprogram.
  3534.  
  3535.       function Build_Calling_Stub_Body (Vis_Decl : Node_Id) return Node_Id;
  3536.       --  Builds the body of the calling stub for a non-asynchronous remote
  3537.       --  call interface subprogram. The input parameter is supposed to be
  3538.       --  the non-empty declaration node of the subprogram.
  3539.  
  3540.       -----------------------------------
  3541.       -- Build_Async_Calling_Stub_Body --
  3542.       -----------------------------------
  3543.  
  3544.       function Build_Async_Calling_Stub_Body (Vis_Decl : Node_Id)
  3545.         return Node_Id
  3546.       is
  3547.          --  Information needed from the input parameter
  3548.  
  3549.          Subp_Spec   : Node_Id := Specification (Vis_Decl);
  3550.          Param_Specs : List_Id := Parameter_Specifications (Subp_Spec);
  3551.          Subp_Name   : Node_Id := Defining_Unit_Name (Subp_Spec);
  3552.          Param_Spec  : Node_Id;
  3553.  
  3554.          --  Building new entities for the local identifiers
  3555.  
  3556.          Stream_In              : Entity_Id;
  3557.  
  3558.          --  Features for the stub body to create
  3559.  
  3560.          Stmts       : List_Id := New_List;
  3561.          Write_Stmts : List_Id := New_List;
  3562.          Decls       : List_Id := New_List;
  3563.          Stub_Body   : Node_Id;
  3564.  
  3565.          Stream_Decl   : Node_Id;
  3566.          --  Variable for the declaration node of a stream
  3567.  
  3568.       begin
  3569.          --  Initialization of the local entities
  3570.  
  3571.          Stream_In :=
  3572.            Make_Defining_Identifier (Loc, Stream_In_Name);
  3573.  
  3574.          --  Build and append stream input declaration to the list of
  3575.          --  declarations of the stub body
  3576.  
  3577.          Stream_Decl :=
  3578.            Make_Object_Declaration (Loc,
  3579.              Defining_Identifier => New_Reference_To (Stream_In, Loc),
  3580.              Object_Definition =>
  3581.                Make_Subtype_Indication (Loc,
  3582.                  Subtype_Mark => SR_Params_Stream_Type (Loc),
  3583.  
  3584.                Constraint =>
  3585.                  Make_Index_Or_Discriminant_Constraint (Loc,
  3586.                    Constraints =>
  3587.                      New_List (Make_Integer_Literal (Loc, Uint_0)))));
  3588.  
  3589.          Set_Aliased_Present (Stream_Decl);
  3590.          Append (Stream_Decl, Decls);
  3591.  
  3592.          --  Build and append the write statement for the Package_Receiver, to
  3593.          --  the list of statements of the stub body
  3594.  
  3595.          Append_To (Stmts,
  3596.            Make_Procedure_Call_Statement (Loc,
  3597.              Name =>
  3598.                Make_Attribute_Reference (Loc,
  3599.                  Prefix => SR_RPC_Receiver (Loc),
  3600.                  Attribute_Name => Name_Write),
  3601.  
  3602.              Parameter_Associations => New_List (
  3603.  
  3604.                Make_Attribute_Reference (Loc,
  3605.                  Prefix => New_Reference_To (Stream_In, Loc),
  3606.                  Attribute_Name => Name_Unchecked_Access),
  3607.  
  3608.                Make_Function_Call (Loc,
  3609.                  Name =>
  3610.                    Make_Identifier (Loc, Get_RCI_Package_Receiver_Name)))));
  3611.  
  3612.          --  Write statement for the subprogram identifier
  3613.  
  3614.          Append_To (Stmts,
  3615.            Make_Procedure_Call_Statement (Loc,
  3616.              Name =>
  3617.                Make_Attribute_Reference (Loc,
  3618.                  Prefix => SRP_Subprogram_Id (Loc),
  3619.                  Attribute_Name => Name_Write),
  3620.  
  3621.              Parameter_Associations => New_List (
  3622.                Make_Attribute_Reference (Loc,
  3623.                  Prefix => New_Reference_To (Stream_In, Loc),
  3624.                  Attribute_Name => Name_Unchecked_Access),
  3625.  
  3626.                --  Type conversion necessary ???
  3627.  
  3628.                --  Make_Type_Conversion (Loc,
  3629.                   --  SRP_Subprogram_Id (Loc),
  3630.  
  3631.                Make_Integer_Literal (Loc, UI_From_Int (Last_Stub_Num)))));
  3632.  
  3633.          --  Append the write statements for the in parameters
  3634.  
  3635.          if Param_Specs /= No_List then
  3636.             Param_Spec := First (Param_Specs);
  3637.             while Present (Param_Spec) loop
  3638.  
  3639.                if Has_Unknown_Size (Etype (Parameter_Type (Param_Spec))) then
  3640.  
  3641.                   Append_To (Stmts,
  3642.                     Make_Procedure_Call_Statement (Loc,
  3643.                       Name =>
  3644.                         Make_Attribute_Reference (Loc,
  3645.                           Prefix => Parameter_Type (Param_Spec),
  3646.                           Attribute_Name => Name_Output),
  3647.  
  3648.                       Parameter_Associations =>
  3649.                         New_List (
  3650.                           Make_Attribute_Reference (Loc,
  3651.                             Prefix => New_Reference_To (Stream_In, Loc),
  3652.                             Attribute_Name => Name_Unchecked_Access),
  3653.  
  3654.                           Make_Identifier (Loc,
  3655.                             Chars =>
  3656.                               Chars (Defining_Identifier (Param_Spec))))));
  3657.  
  3658.                else
  3659.                   Append_To (Write_Stmts,
  3660.                     Make_Procedure_Call_Statement (Loc,
  3661.                       Name =>
  3662.                         Make_Attribute_Reference (Loc,
  3663.                           Prefix => Parameter_Type (Param_Spec),
  3664.                           Attribute_Name => Name_Write),
  3665.  
  3666.                       Parameter_Associations =>
  3667.                         New_List (
  3668.                           Make_Attribute_Reference (Loc,
  3669.                             Prefix => New_Reference_To (Stream_In, Loc),
  3670.                             Attribute_Name => Name_Unchecked_Access),
  3671.  
  3672.                           Make_Identifier (Loc,
  3673.                             Chars =>
  3674.                               Chars (Defining_Identifier (Param_Spec))))));
  3675.                end if;
  3676.  
  3677.                Param_Spec := Next (Param_Spec);
  3678.             end loop;
  3679.          end if;
  3680.  
  3681.          Append_List (Write_Stmts, Stmts);
  3682.  
  3683.          --  append do_apc call to the list of statements
  3684.  
  3685.          Append_To (Stmts,
  3686.            Make_Procedure_Call_Statement (Loc,
  3687.              Name => SR_Do_Apc (Loc),
  3688.              Parameter_Associations => New_List (
  3689.                Make_Function_Call (Loc,
  3690.                  Name =>
  3691.                    Make_Identifier (Loc, Get_Active_Partition_Id_Name)),
  3692.  
  3693.                Make_Attribute_Reference (Loc,
  3694.                  Prefix => New_Reference_To (Stream_In, Loc),
  3695.                  Attribute_Name => Name_Unchecked_Access))));
  3696.  
  3697.          --  Build the stub body node
  3698.  
  3699.          Stub_Body :=
  3700.            Make_Subprogram_Body (Loc,
  3701.              Specification => Copy_Original_Tree (Subp_Spec),
  3702.              Declarations => Decls,
  3703.              Handled_Statement_Sequence =>
  3704.                Make_Handled_Sequence_Of_Statements (Loc,
  3705.                  Statements => Stmts));
  3706.  
  3707.          return Stub_Body;
  3708.  
  3709.       end Build_Async_Calling_Stub_Body;
  3710.  
  3711.       ----------------------------
  3712.       -- Build_Calling_Stub_Body --
  3713.       ----------------------------
  3714.  
  3715.       function Build_Calling_Stub_Body (Vis_Decl : Node_Id) return Node_Id is
  3716.  
  3717.          --  Information needed from the input parameter
  3718.  
  3719.          Subp_Spec   : Node_Id := Specification (Vis_Decl);
  3720.          Param_Specs : List_Id := Parameter_Specifications (Subp_Spec);
  3721.          Subp_Name   : Node_Id := Defining_Unit_Name (Subp_Spec);
  3722.          Param_Spec  : Node_Id;
  3723.          Param_Type  : Node_Id;
  3724.  
  3725.          --  Building new entities for the local identifiers
  3726.  
  3727.          Stream_In              : Entity_Id;
  3728.          Stream_Out             : Entity_Id;
  3729.          Returned_Val           : Entity_Id;
  3730.          Except                 : Entity_Id;
  3731.  
  3732.          --  Features for the stub body to create
  3733.  
  3734.          Stmts       : List_Id := New_List;
  3735.          Write_Stmts : List_Id := New_List;
  3736.          Then_Stmts  : List_Id := New_List;
  3737.          Decls       : List_Id := New_List;
  3738.          Stub_Body   : Node_Id;
  3739.  
  3740.          --  Variable for the declaration node of a stream
  3741.  
  3742.          Stream_Decl   : Node_Id;
  3743.  
  3744.       begin
  3745.          --  Initialization of the local entities
  3746.  
  3747.          Stream_In    :=
  3748.            Make_Defining_Identifier (Loc, Stream_In_Name);
  3749.  
  3750.          Stream_Out   :=
  3751.            Make_Defining_Identifier (Loc, Stream_Out_Name);
  3752.  
  3753.          Returned_Val :=
  3754.            Make_Defining_Identifier (Loc, Returned_Val_Name);
  3755.  
  3756.          Except       :=
  3757.            Make_Defining_Identifier (Loc, Except_Name);
  3758.  
  3759.          --  Build and append stream input declaration to the list of
  3760.          --  declarations of the stub body
  3761.  
  3762.          Stream_Decl :=
  3763.             Make_Object_Declaration (Loc,
  3764.               Defining_Identifier => New_Reference_To (Stream_In, Loc),
  3765.               Object_Definition =>
  3766.                 Make_Subtype_Indication (Loc,
  3767.                   Subtype_Mark => SR_Params_Stream_Type (Loc),
  3768.  
  3769.                 Constraint =>
  3770.                   Make_Index_Or_Discriminant_Constraint (Loc,
  3771.                     Constraints =>
  3772.                       New_List (Make_Integer_Literal (Loc, Uint_0)))));
  3773.  
  3774.          Set_Aliased_Present (Stream_Decl);
  3775.          Append (Stream_Decl, Decls);
  3776.  
  3777.          --  Build and append stream output declaration to the list of
  3778.          --  declarations of the stub body
  3779.  
  3780.          Stream_Decl :=
  3781.            Make_Object_Declaration (Loc,
  3782.              Defining_Identifier =>
  3783.                New_Reference_To (Stream_Out, Loc),
  3784.  
  3785.              Object_Definition =>
  3786.                Make_Subtype_Indication (Loc,
  3787.                  Subtype_Mark => SR_Params_Stream_Type (Loc),
  3788.  
  3789.                  Constraint =>
  3790.                    Make_Index_Or_Discriminant_Constraint (Loc,
  3791.                      Constraints =>
  3792.                        New_List (Make_Integer_Literal (Loc, Uint_0)))));
  3793.  
  3794.          Set_Aliased_Present (Stream_Decl);
  3795.          Append (Stream_Decl, Decls);
  3796.  
  3797.          --  Append the declaration for the exeption occurrence
  3798.  
  3799.          Append_To (Decls,
  3800.             Make_Object_Declaration (Loc,
  3801.               Defining_Identifier => Except,
  3802.               Object_Definition => AE_Exception_Occurrence (Loc)));
  3803.  
  3804.          --  Append the declaration for the returned value in the
  3805.          --  case of a function
  3806.  
  3807.          if Nkind (Subp_Spec) = N_Function_Specification
  3808.            and then not Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec)))
  3809.          then
  3810.             Append_To (Decls,
  3811.               Make_Object_Declaration (Loc,
  3812.                 Defining_Identifier => Returned_Val,
  3813.                 Object_Definition =>
  3814.                   Copy_Original_Tree (Subtype_Mark (Subp_Spec))));
  3815.          end if;
  3816.  
  3817.          --  Build and append the write statement for the Package_Receiver, to
  3818.          --  the list of statements of the stub body
  3819.  
  3820.          Append_To (Stmts,
  3821.            Make_Procedure_Call_Statement (Loc,
  3822.              Name =>
  3823.                Make_Attribute_Reference (Loc,
  3824.                  Prefix => SR_RPC_Receiver (Loc),
  3825.                  Attribute_Name => Name_Write),
  3826.  
  3827.              Parameter_Associations => New_List (
  3828.                Make_Attribute_Reference (Loc,
  3829.                  Prefix => New_Reference_To (Stream_In, Loc),
  3830.                  Attribute_Name => Name_Unchecked_Access),
  3831.  
  3832.                Make_Function_Call (Loc,
  3833.                  Name =>
  3834.                    Make_Identifier (Loc, Get_RCI_Package_Receiver_Name)))));
  3835.  
  3836.          --  Write statement for the subprogram identifier
  3837.  
  3838.          Append_To (Stmts,
  3839.            Make_Procedure_Call_Statement (Loc,
  3840.              Name =>
  3841.                Make_Attribute_Reference (Loc,
  3842.                  Prefix => SRP_Subprogram_Id (Loc),
  3843.                  Attribute_Name => Name_Write),
  3844.  
  3845.              Parameter_Associations => New_List (
  3846.                Make_Attribute_Reference (Loc,
  3847.                  Prefix => New_Reference_To (Stream_In, Loc),
  3848.                  Attribute_Name => Name_Unchecked_Access),
  3849.  
  3850.                --  Type conversion necessary ???
  3851.  
  3852.                --  Make_Type_Conversion (Loc,
  3853.                   --  SRP_Subprogram_Id (Loc),
  3854.  
  3855.                Make_Integer_Literal (Loc, UI_From_Int (Last_Stub_Num)))));
  3856.  
  3857.          --  Append the write statements for the in parameters
  3858.          --  and the read statements for the out parameters
  3859.  
  3860.          if Param_Specs /= No_List then
  3861.  
  3862.             Param_Spec := First (Param_Specs);
  3863.  
  3864.             while Present (Param_Spec) loop
  3865.  
  3866.                if Has_Unknown_Size (Etype
  3867.                  (Parameter_Type (Param_Spec)))
  3868.                then
  3869.  
  3870.                   Append_To (Stmts,
  3871.                     Make_Procedure_Call_Statement (Loc,
  3872.                       Name =>
  3873.                         Make_Attribute_Reference (Loc,
  3874.                           Prefix => Parameter_Type (Param_Spec),
  3875.                           Attribute_Name => Name_Output),
  3876.  
  3877.                       Parameter_Associations =>
  3878.                         New_List (
  3879.                           Make_Attribute_Reference (Loc,
  3880.                             Prefix => New_Reference_To (Stream_In, Loc),
  3881.                             Attribute_Name => Name_Unchecked_Access),
  3882.  
  3883.                           Make_Identifier (Loc,
  3884.                             Chars =>
  3885.                               Chars (Defining_Identifier (Param_Spec))))));
  3886.  
  3887.                elsif In_Present (Param_Spec)
  3888.                  or else not Out_Present (Param_Spec)
  3889.                then
  3890.                   Append_To (Write_Stmts,
  3891.                     Make_Procedure_Call_Statement (Loc,
  3892.                       Name =>
  3893.                         Make_Attribute_Reference (Loc,
  3894.                           Prefix => Parameter_Type (Param_Spec),
  3895.                           Attribute_Name => Name_Write),
  3896.  
  3897.                       Parameter_Associations =>
  3898.                         New_List (
  3899.                           Make_Attribute_Reference (Loc,
  3900.                             Prefix => New_Reference_To (Stream_In, Loc),
  3901.                             Attribute_Name => Name_Unchecked_Access),
  3902.                           Make_Identifier (Loc,
  3903.                             Chars =>
  3904.                               Chars (Defining_Identifier (Param_Spec))))));
  3905.                end if;
  3906.  
  3907.                if Out_Present (Param_Spec) then
  3908.  
  3909.                   --  Read operation are within an if statement and
  3910.                   --  are thus appended to a then statement list which
  3911.                   --  will be used later to build the if statement.
  3912.  
  3913.                   if Has_Unknown_Size (Etype (
  3914.                     Parameter_Type (Param_Spec)))
  3915.                   then
  3916.                      Append_To (Then_Stmts,
  3917.                        Make_Assignment_Statement (Loc,
  3918.  
  3919.                          Name =>
  3920.                            Make_Identifier (Loc,
  3921.                              Chars =>
  3922.                                Chars (Defining_Identifier (Param_Spec))),
  3923.  
  3924.                          Expression =>
  3925.                            Make_Function_Call (Loc,
  3926.                              Name =>
  3927.                                Make_Attribute_Reference (Loc,
  3928.                                  Prefix => Parameter_Type (Param_Spec),
  3929.                                  Attribute_Name => Name_Input),
  3930.  
  3931.                              Parameter_Associations => New_List (
  3932.                                Make_Attribute_Reference (Loc,
  3933.                                  Prefix =>
  3934.                                    New_Reference_To (Stream_Out, Loc),
  3935.                                  Attribute_Name =>
  3936.                                    Name_Unchecked_Access)))));
  3937.  
  3938.                   else
  3939.                      Append_To (Then_Stmts,
  3940.                        Make_Procedure_Call_Statement (Loc,
  3941.                          Name =>
  3942.                            Make_Attribute_Reference (Loc,
  3943.                              Prefix => Parameter_Type (Param_Spec),
  3944.                              Attribute_Name => Name_Read),
  3945.  
  3946.                          Parameter_Associations =>
  3947.                            New_List (
  3948.                              Make_Attribute_Reference (Loc,
  3949.                                Prefix => New_Reference_To (Stream_Out, Loc),
  3950.                                Attribute_Name => Name_Unchecked_Access),
  3951.  
  3952.                              Make_Identifier (Loc,
  3953.                                Chars =>
  3954.                                  Chars (Defining_Identifier (Param_Spec))))));
  3955.                   end if;
  3956.                end if;
  3957.  
  3958.                Param_Spec := Next (Param_Spec);
  3959.             end loop;
  3960.          end if;
  3961.  
  3962.          --  Append the write statement list to the list of statements
  3963.  
  3964.          Append_List (Write_Stmts, Stmts);
  3965.  
  3966.          --  Append Do_Rpc call to the list of statements
  3967.  
  3968.          Append_To (Stmts,
  3969.            Make_Procedure_Call_Statement (Loc,
  3970.              Name => SR_Do_Rpc (Loc),
  3971.              Parameter_Associations => New_List (
  3972.  
  3973.                Make_Function_Call (Loc,
  3974.                  Name => Make_Identifier (Loc, Get_Active_Partition_Id_Name)),
  3975.  
  3976.                Make_Attribute_Reference (Loc,
  3977.                  Prefix => New_Reference_To (Stream_In, Loc),
  3978.                  Attribute_Name => Name_Unchecked_Access),
  3979.  
  3980.                Make_Attribute_Reference (Loc,
  3981.                  Prefix => New_Reference_To (Stream_Out, Loc),
  3982.                  Attribute_Name => Name_Unchecked_Access))));
  3983.  
  3984.          --  Append the read operation for the exception occurrence
  3985.  
  3986.          Append_To (Stmts,
  3987.            Make_Procedure_Call_Statement (Loc,
  3988.              Name =>
  3989.                Make_Attribute_Reference (Loc,
  3990.                  Prefix => AE_Exception_Occurrence (Loc),
  3991.                  Attribute_Name => Name_Read),
  3992.  
  3993.              Parameter_Associations => New_List (
  3994.                Make_Attribute_Reference (Loc,
  3995.                  Prefix => New_Reference_To (Stream_Out, Loc),
  3996.                  Attribute_Name => Name_Unchecked_Access),
  3997.  
  3998.                New_Reference_To (Except, Loc))));
  3999.  
  4000.          --  Append the read statement for the returned value, and
  4001.          --  the return statement in the case of a function
  4002.  
  4003.          if Nkind (Subp_Spec) = N_Function_Specification then
  4004.  
  4005.             if Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec))) then
  4006.  
  4007.                Append_To (Then_Stmts,
  4008.                  Make_Return_Statement (Loc,
  4009.                    Expression =>
  4010.                      Make_Function_Call (Loc,
  4011.                        Name =>
  4012.                          Make_Attribute_Reference (Loc,
  4013.                            Prefix => Subtype_Mark (Subp_Spec),
  4014.                            Attribute_Name => Name_Input),
  4015.  
  4016.                        Parameter_Associations => New_List (
  4017.                          Make_Attribute_Reference (Loc,
  4018.                            Prefix => New_Reference_To (Stream_Out, Loc),
  4019.                            Attribute_Name => Name_Unchecked_Access)))));
  4020.  
  4021.             else
  4022.                Append_To (Then_Stmts,
  4023.                  Make_Procedure_Call_Statement (Loc,
  4024.                    Name =>
  4025.                      Make_Attribute_Reference (Loc,
  4026.                        Prefix => Copy_Original_Tree (Subtype_Mark (Subp_Spec)),
  4027.                        Attribute_Name => Name_Read),
  4028.  
  4029.                    Parameter_Associations => New_List (
  4030.                      Make_Attribute_Reference (Loc,
  4031.                        Prefix => New_Reference_To (Stream_Out, Loc),
  4032.                        Attribute_Name => Name_Unchecked_Access),
  4033.  
  4034.                      New_Reference_To (Returned_Val, Loc))));
  4035.  
  4036.                --  Append a return statement; the returned value is the one
  4037.                --  previously read from the stream output
  4038.  
  4039.                Append_To (Then_Stmts,
  4040.                  Make_Return_Statement (Loc,
  4041.                    Expression => New_Reference_To (Returned_Val, Loc)));
  4042.             end if;
  4043.          end if;
  4044.  
  4045.          --  Append the if statement for the out parameters and
  4046.          --  the returned value in the case of a function
  4047.  
  4048.          if not Is_Empty_List (Then_Stmts) then
  4049.             Append_To (Stmts,
  4050.               Make_If_Statement (Loc,
  4051.                 Condition =>
  4052.                   Make_Op_Eq (Loc,
  4053.                     Left_Opnd => New_Reference_To (Except, Loc),
  4054.                     Right_Opnd => AE_Null_Occurrence (Loc)),
  4055.  
  4056.                 Then_Statements => Then_Stmts,
  4057.  
  4058.                 Else_Statements => New_List (
  4059.                   Make_Procedure_Call_Statement (Loc,
  4060.                     Name => AE_Reraise_Occurrence (Loc),
  4061.                     Parameter_Associations => New_List (
  4062.                       New_Reference_To (Except, Loc))))));
  4063.  
  4064.          else
  4065.             Append_To (Stmts,
  4066.               Make_If_Statement (Loc,
  4067.                 Condition =>
  4068.                   Make_Op_Ne (Loc,
  4069.                     Left_Opnd => New_Reference_To (Except, Loc),
  4070.                     Right_Opnd => AE_Null_Occurrence (Loc)),
  4071.  
  4072.                 Then_Statements => New_List (
  4073.                   Make_Procedure_Call_Statement (Loc,
  4074.                     Name => AE_Reraise_Occurrence (Loc),
  4075.                     Parameter_Associations => New_List (
  4076.                       New_Reference_To (Except, Loc))))));
  4077.          end if;
  4078.  
  4079.          --  Build the stub body node
  4080.  
  4081.          Stub_Body :=
  4082.             Make_Subprogram_Body (Loc,
  4083.               Specification => Copy_Original_Tree (Subp_Spec),
  4084.               Declarations  => Decls,
  4085.               Handled_Statement_Sequence =>
  4086.                 Make_Handled_Sequence_Of_Statements (Loc,
  4087.                   Statements => Stmts));
  4088.  
  4089.          return Stub_Body;
  4090.  
  4091.       end Build_Calling_Stub_Body;
  4092.  
  4093.    --  Start of processing for Build_Calling_Stubs
  4094.  
  4095.    begin
  4096.       --  Build the stub subprogram bodies
  4097.  
  4098.       if Vis_Decls /= No_List then
  4099.          Vis_Decl := First (Vis_Decls);
  4100.  
  4101.          while Present (Vis_Decl) loop
  4102.             if Comes_From_Source (Vis_Decl) then
  4103.                if Nkind (Vis_Decl) = N_Subprogram_Declaration then
  4104.                   Last_Stub_Num := Last_Stub_Num + 1;
  4105.  
  4106.                   if Nkind (Specification (Vis_Decl)) =
  4107.                     N_Procedure_Specification
  4108.                     and then Is_Asynchronous (Defining_Unit_Simple_Name (
  4109.                     Specification (Vis_Decl)))
  4110.                   then
  4111.                      Append_To (Package_Body_Decls,
  4112.                        Build_Async_Calling_Stub_Body (Vis_Decl));
  4113.  
  4114.                   else
  4115.                      Append_To (Package_Body_Decls,
  4116.                        Build_Calling_Stub_Body (Vis_Decl));
  4117.                   end if;
  4118.  
  4119.                elsif Nkind (Vis_Decl) = N_Package_Declaration then
  4120.  
  4121.                   Build_Calling_Stubs_Pkg_Body
  4122.                     (Vis_Decl,
  4123.                      Last_Stub_Num,
  4124.                      Last_Racw_Num,
  4125.                      Inner_Stubs_Pkg_Body);
  4126.  
  4127.                   Append (Inner_Stubs_Pkg_Body, Package_Body_Decls);
  4128.  
  4129.                elsif Nkind (Vis_Decl) = N_Full_Type_Declaration
  4130.                  and then Is_Remote_Access_To_Class_Wide_Type
  4131.                  (Defining_Identifier (Vis_Decl))
  4132.                then
  4133.                   Last_Racw_Num := Last_Racw_Num + 1;
  4134.                   Add_Racw_Stubs (Vis_Decl, Package_Body_Decls, Last_Racw_Num);
  4135.  
  4136.                else
  4137.                   --  See all the other features which are used
  4138.                   --  (types appearing directly or through a with, etc.)
  4139.  
  4140.                   null;
  4141.                end if;
  4142.             end if;
  4143.  
  4144.             Vis_Decl := Next (Vis_Decl);
  4145.          end loop;
  4146.       end if;
  4147.  
  4148.       --  Build the package body node
  4149.  
  4150.       Stubs_Pkg_Body :=
  4151.         Make_Package_Body (Loc,
  4152.           Defining_Unit_Name => Copy_Original_Tree (Pkg_Name),
  4153.           Declarations => Package_Body_Decls);
  4154.  
  4155.    end Build_Calling_Stubs_Pkg_Body;
  4156.  
  4157.    ----------------
  4158.    -- Init_Names --
  4159.    ----------------
  4160.  
  4161.    procedure Init_Names is
  4162.    begin
  4163.  
  4164.       --  External names
  4165.  
  4166.       Stream_Name
  4167.         := Get_Name_Id ("stream");
  4168.       Item_Name
  4169.         := Get_Name_Id ("item");
  4170.       Params_Name
  4171.         := Get_Name_Id ("params");
  4172.       Result_Name
  4173.         := Get_Name_Id ("result");
  4174.       RPC_Receiver_Name
  4175.         := Get_Name_Id ("rpc_receiver");
  4176.       Params_Stream_Type_Name
  4177.         := Get_Name_Id ("params_stream_type");
  4178.       Do_Rpc_Name
  4179.         := Get_Name_Id ("do_rpc");
  4180.       Do_Apc_Name
  4181.         := Get_Name_Id ("do_apc");
  4182.       Exceptions_Name
  4183.         := Get_Name_Id ("exceptions");
  4184.       Exception_Occurrence_Name
  4185.         := Get_Name_Id ("exception_occurrence");
  4186.       Null_Occurrence_Name
  4187.         := Get_Name_Id ("null_occurrence");
  4188.       Reraise_Occurrence_Name
  4189.         := Get_Name_Id ("reraise_occurrence");
  4190.       Subprogram_Id_Name
  4191.         := Get_Name_Id ("subprogram_id");
  4192.       Get_Local_Partition_Id_Name
  4193.         := Get_Name_Id ("get_local_partition_id");
  4194.       Get_Active_Partition_Id_Name
  4195.         := Get_Name_Id ("get_active_partition_id");
  4196.       Root_Stream_Type_Name
  4197.         := Get_Name_Id ("root_stream_type");
  4198.       Stream_Element_Count_Name
  4199.         := Get_Name_Id ("stream_element_count");
  4200.       Partition_Interface_Name
  4201.         := Get_Name_Id ("partition_interface");
  4202.       Get_Passive_Partition_Id_Name
  4203.         := Get_Name_Id ("get_passive_partition_id");
  4204.       Get_RCI_Package_Receiver_Name
  4205.         := Get_Name_Id ("get_rci_package_receiver");
  4206.       Register_Receiver_Elaboration_Name
  4207.         := Get_Name_Id ("register_server_elaboration");
  4208.       Unchecked_Conversion_Name
  4209.         := Get_Name_Id ("unchecked_conversion");
  4210.  
  4211.       --  Internal names
  4212.  
  4213.       Stream_In_Name    := New_Internal_Name ('S');
  4214.       Stream_Out_Name   := New_Internal_Name ('S');
  4215.       Returned_Val_Name := New_Internal_Name ('R');
  4216.       Except_Name       := New_Internal_Name ('E');
  4217.  
  4218.    end Init_Names;
  4219.  
  4220.    ------------------------------------
  4221.    -- To_Receiving_Stubs_Decls_Cunit --
  4222.    ------------------------------------
  4223.  
  4224.    procedure To_Receiving_Stubs_Decls_Cunit (RCI_Decl_Cunit : Node_Id) is
  4225.       Pkg_Decl  : constant Node_Id    := Unit (RCI_Decl_Cunit);
  4226.       Pkg_Spec  : constant Node_Id    := Specification (Pkg_Decl);
  4227.       Vis_Decls : constant List_Id    := Visible_Declarations (Pkg_Spec);
  4228.       Contexts  : constant List_Id    := Context_Items (RCI_Decl_Cunit);
  4229.  
  4230.    begin
  4231.       --  Initialization of names
  4232.  
  4233.       Init_Names;
  4234.  
  4235.       Remove_Categorizations (Contexts);
  4236.       Remove_Categorizations (Vis_Decls);
  4237.  
  4238.       --  If the unit is a child spec, then the parent spec must also be
  4239.       --  transformed into the corresponding receiving stubs package spec.
  4240.  
  4241.       if Present (Parent_Spec (Pkg_Decl)) then
  4242.          To_Receiving_Stubs_Decls_Cunit (Parent_Spec (Pkg_Decl));
  4243.  
  4244.       end if;
  4245.  
  4246.    end To_Receiving_Stubs_Decls_Cunit;
  4247.  
  4248.    ----------------------------------------
  4249.    -- Build_Receiving_Stubs_Bodies_Cunit --
  4250.    ----------------------------------------
  4251.  
  4252.    function Build_Receiving_Stubs_Bodies_Cunit
  4253.     (RCI_Cunit : Node_Id)
  4254.      return      Node_Id
  4255.    is
  4256.       Loc       : constant Source_Ptr := Sloc (RCI_Cunit);
  4257.       Unit_Node : constant Node_Id    := Unit (RCI_Cunit);
  4258.  
  4259.       --  Features for the compilation unit to create
  4260.  
  4261.       Pkg_Body_CItems : List_Id := No_List;
  4262.       Pkg_Body        : Node_Id;
  4263.       Stubs_Cunit     : Node_Id;
  4264.       Racw_Num        : Int := 0;
  4265.  
  4266.    --  Start of processing for Build_Receiving_Stubs_Bodies_Cunit
  4267.  
  4268.    begin
  4269.       --  Build context items for the package body
  4270.  
  4271.       if Nkind (Unit_Node) = N_Package_Body then
  4272.          Pkg_Body_CItems :=
  4273.            New_List_Copy_Original_Tree (Context_Items (RCI_Cunit));
  4274.       end if;
  4275.  
  4276.       --  Add Ada.Exceptions and System.Rpc.partition_interface to the withed
  4277.       --  and used list of the stub bodies package
  4278.  
  4279.       Add_With_Clause (Ada_Exceptions (Loc), Pkg_Body_CItems);
  4280.       Add_With_Clause (System_Rpc_PInterface (Loc), Pkg_Body_CItems);
  4281.  
  4282.       --  Build the package body
  4283.  
  4284.       Build_Receiving_Stubs_Pkg_Body (Unit_Node, Racw_Num, Pkg_Body);
  4285.  
  4286.       --  Add unchecked_conversion to the context clause
  4287.  
  4288.       if Racw_Num /= 0 then
  4289.          Append_To (Pkg_Body_CItems,
  4290.            Make_With_Clause (Loc,
  4291.              Name => Make_Identifier (Loc, Unchecked_Conversion_Name)));
  4292.       end if;
  4293.  
  4294.       --  Build the compilation unit for the receiving stubs package spec
  4295.  
  4296.       Stubs_Cunit :=
  4297.         Make_Compilation_Unit (Loc,
  4298.           Context_Items => Pkg_Body_CItems,
  4299.           Unit => Pkg_Body);
  4300.  
  4301.       return Stubs_Cunit;
  4302.    end Build_Receiving_Stubs_Bodies_Cunit;
  4303.  
  4304.    ------------------------------------
  4305.    -- Build_Receiving_Stubs_Pkg_Body --
  4306.    ------------------------------------
  4307.  
  4308.    procedure Build_Receiving_Stubs_Pkg_Body
  4309.      (Unit_Node      : in Node_Id;
  4310.       Last_Racw_Num  : in out Int;
  4311.       Stubs_Pkg_Body : out Node_Id)
  4312.    is
  4313.       --  Features needed from the input body
  4314.  
  4315.       Loc        : Source_Ptr := Sloc (Unit_Node);
  4316.       Body_Decls : List_Id;
  4317.       Body_Hss   : Node_Id;
  4318.       Spec       : Node_Id;
  4319.  
  4320.       --  Features needed from the corresponding specification
  4321.  
  4322.       Pkg_Decl   : Node_Id;
  4323.       Pkg_Name   : Node_Id;
  4324.       Vis_Decls  : List_Id;
  4325.       Priv_Decls : List_Id;
  4326.       Vis_Decl   : Node_Id;
  4327.  
  4328.       --  Features for the receiving stubs package body to create
  4329.  
  4330.       Pkg_Body_Decls  : List_Id := New_List;
  4331.       Pkg_Body_Ss     : List_Id := No_List;
  4332.       Pkg_Body_Ehs    : List_Id := No_List;
  4333.       Elab_Stmt       : Node_Id;
  4334.       Stub_Body       : Node_Id;
  4335.       Param_Assocs    : List_Id;
  4336.       Pkg_Name_String : String_Id;
  4337.  
  4338.       --  This is used to build the local receiver procedure
  4339.  
  4340.       Receiver_Spec   : Node_Id;
  4341.       Receiver_Body   : Node_Id;
  4342.       Receiver_Decls  : List_Id := New_List;
  4343.       Case_Stmt_Alts  : List_Id := New_List;
  4344.  
  4345.       --  List of local names needed
  4346.  
  4347.       Receiving_Stub_Name         : Name_Id;
  4348.       Package_Rpc_Receiver_Name   : Name_Id;
  4349.       Subp_Num_Name : Name_Id := New_Internal_Name ('N');
  4350.       --  Name of the variable used to get the subprogram
  4351.       --  identifier from the stream output
  4352.  
  4353.       Subp_Num      : Int := 0;
  4354.       --  A number  is  given to  each subprogram which  is callable remotely;
  4355.       --  it will be used together with the  Package Id to compute the
  4356.       --  corresponding Service_ID.
  4357.  
  4358.       function Build_Async_Receiving_Stub_Body
  4359.         (Vis_Decl : Node_Id; Prefix : Node_Id)
  4360.          return Node_Id;
  4361.       --  Builds the body node of the receiving stub for an asynchronous
  4362.       --  procedure
  4363.  
  4364.       function Build_Receiving_Stub_Body (Vis_Decl : Node_Id; Prefix : Node_Id)
  4365.         return Node_Id;
  4366.       --  Builds the body node of the receiving stub for a regular subprogram.
  4367.  
  4368.       procedure Build_Receiving_Stubs
  4369.         (Pkg_Decl : Node_Id;
  4370.          Pkg_Body : Node_Id;
  4371.          Prefix   : Node_Id);
  4372.       --  Builds the receiving stubs for the subprograms of the specified list
  4373.  
  4374.       -------------------------------------
  4375.       -- Build_Async_Receiving_Stub_Body --
  4376.       -------------------------------------
  4377.  
  4378.       function Build_Async_Receiving_Stub_Body
  4379.         (Vis_Decl : Node_Id; Prefix : Node_Id)
  4380.          return Node_Id
  4381.       is
  4382.          --  Information needed from the input declaration
  4383.  
  4384.          Subp_Spec   : Node_Id := Specification (Vis_Decl);
  4385.          Param_Specs : List_Id := Parameter_Specifications (Subp_Spec);
  4386.          Subp_Name   : Node_Id := Defining_Unit_Name (Subp_Spec);
  4387.          Param_Spec  : Node_Id;
  4388.          Param       : Entity_Id;
  4389.          Param_Type  : Node_Id;
  4390.  
  4391.          --  New entities for the local identifiers
  4392.  
  4393.          Params      : Entity_Id;
  4394.  
  4395.          --  Features for the stub body to create
  4396.  
  4397.          Decls             : List_Id := New_List;
  4398.          Stmts             : List_Id := New_List;
  4399.          Hss               : Node_Id;
  4400.          Stub_Spec         : Node_Id;
  4401.          Stub_Body         : Node_Id;
  4402.          Param_List        : List_Id := New_List;
  4403.          Param_Read_Stmts  : List_Id := New_List;
  4404.  
  4405.       begin
  4406.          --  Initialization of the external entities
  4407.  
  4408.          Params :=
  4409.            Make_Defining_Identifier (Loc, Params_Name);
  4410.  
  4411.          --  Build the stub specification node
  4412.  
  4413.          Stub_Spec :=
  4414.            Make_Procedure_Specification (Loc,
  4415.              Defining_Unit_Name =>
  4416.                Make_Identifier (Loc,
  4417.                  Chars =>
  4418.                    New_External_Name (
  4419.                      Related_Id   => Receiving_Stub_Name,
  4420.                      Suffix       => 'S',
  4421.                      Suffix_Index => Subp_Num)),
  4422.              Parameter_Specifications => AStub_Param_Specs (Loc));
  4423.  
  4424.          --  Build the stub body node
  4425.  
  4426.          if Param_Specs /= No_List then
  4427.             Param_Spec := First (Param_Specs);
  4428.             while Present (Param_Spec) loop
  4429.  
  4430.                Param_Type := Parameter_Type (Param_Spec);
  4431.                Param :=
  4432.                  Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
  4433.                Append (Param, Param_List);
  4434.  
  4435.                --  For the moment we suppose that we have
  4436.                --  no access definition as parameter type ???
  4437.  
  4438.                if Has_Unknown_Size (Etype (Param_Type)) then
  4439.  
  4440.                   Append_To (Decls,
  4441.                     Make_Object_Declaration (Loc,
  4442.                       Defining_Identifier =>
  4443.                         New_Reference_To (Param, Loc),
  4444.                       Object_Definition => Copy_Original_Tree (Param_Type),
  4445.  
  4446.                       Expression =>
  4447.                         Make_Function_Call (Loc,
  4448.                           Name => Make_Attribute_Reference (Loc,
  4449.                             Prefix => Copy_Original_Tree (Param_Type),
  4450.                             Attribute_Name => Name_Input),
  4451.  
  4452.                           Parameter_Associations =>
  4453.                             New_List (
  4454.                               Make_Identifier (Loc, Chars (Params))))));
  4455.  
  4456.                else
  4457.                   Append_To (Decls,
  4458.                     Make_Object_Declaration (Loc,
  4459.                       Defining_Identifier =>
  4460.                         New_Reference_To (Param, Loc),
  4461.                       Object_Definition => Copy_Original_Tree (Param_Type)));
  4462.  
  4463.                   Append_To (Param_Read_Stmts,
  4464.                     Make_Procedure_Call_Statement (Loc,
  4465.                       Name => Make_Attribute_Reference (Loc,
  4466.                         Prefix => Copy_Original_Tree (Param_Type),
  4467.                         Attribute_Name => Name_Read),
  4468.  
  4469.                       Parameter_Associations =>
  4470.                         New_List (
  4471.                           Make_Identifier (Loc, Chars (Params)),
  4472.                           Make_Identifier (Loc, Chars (Param)))));
  4473.                end if;
  4474.  
  4475.                Param_Spec := Next (Param_Spec);
  4476.             end loop;
  4477.          end if;
  4478.  
  4479.          Stmts := Param_Read_Stmts;
  4480.  
  4481.          if Prefix /= Empty then
  4482.             Subp_Name :=
  4483.                Make_Selected_Component (Loc,
  4484.                   Prefix => Prefix,
  4485.                   Selector_Name => Subp_Name);
  4486.          end if;
  4487.  
  4488.          Append_To (Stmts,
  4489.            Make_Procedure_Call_Statement (Loc,
  4490.              Name => Copy_Original_Tree (Subp_Name),
  4491.              Parameter_Associations => Param_List));
  4492.  
  4493.          Hss :=
  4494.            Make_Handled_Sequence_Of_Statements (Loc,
  4495.              Statements => Stmts,
  4496.              Exception_Handlers => New_List (
  4497.                Make_Exception_Handler (Loc,
  4498.                  Exception_Choices => New_List (Make_Others_Choice (Loc)),
  4499.                  Statements => New_List (Make_Null_Statement (Loc)))));
  4500.  
  4501.          Stub_Body :=
  4502.            Make_Subprogram_Body (Loc,
  4503.              Specification => Copy_Original_Tree (Stub_Spec),
  4504.              Declarations => Decls,
  4505.              Handled_Statement_Sequence => Hss);
  4506.  
  4507.          return Stub_Body;
  4508.       end Build_Async_Receiving_Stub_Body;
  4509.  
  4510.       -------------------------------
  4511.       -- Build_Receiving_Stub_Body --
  4512.       -------------------------------
  4513.  
  4514.       function Build_Receiving_Stub_Body (Vis_Decl : Node_Id; Prefix : Node_Id)
  4515.         return Node_Id
  4516.       is
  4517.          --  Information needed from the input declaration
  4518.  
  4519.          Subp_Spec   : Node_Id := Specification (Vis_Decl);
  4520.          Param_Specs : List_Id := Parameter_Specifications (Subp_Spec);
  4521.          Subp_Name   : Node_Id := Defining_Unit_Name (Subp_Spec);
  4522.          Param_Spec  : Node_Id;
  4523.          Param       : Entity_Id;
  4524.          Param_Type  : Node_Id;
  4525.  
  4526.          --  New entities for the local identifiers
  4527.  
  4528.          Params        : Entity_Id;
  4529.          Result        : Entity_Id;
  4530.          Returned_Val  : Entity_Id;
  4531.          Except        : Entity_Id;
  4532.  
  4533.          --  Features for the stub body to create
  4534.  
  4535.          Decls             : List_Id := New_List;
  4536.          Stmts             : List_Id := New_List;
  4537.          Hss               : Node_Id;
  4538.          Stub_Spec         : Node_Id;
  4539.          Stub_Body         : Node_Id;
  4540.          Param_List        : List_Id := New_List;
  4541.          Param_Read_Stmts  : List_Id := New_List;
  4542.          Param_Write_Stmts : List_Id := New_List;
  4543.  
  4544.       begin
  4545.          --  Initialization of the local entities
  4546.  
  4547.          Params :=
  4548.            Make_Defining_Identifier (Loc, Params_Name);
  4549.  
  4550.          Result :=
  4551.            Make_Defining_Identifier (Loc, Result_Name);
  4552.  
  4553.          Returned_Val :=
  4554.            Make_Defining_Identifier (Loc, Returned_Val_Name);
  4555.  
  4556.          Except :=
  4557.            Make_Defining_Identifier (Loc, Except_Name);
  4558.  
  4559.          --  Build the stub specification node
  4560.  
  4561.          Stub_Spec :=
  4562.            Make_Procedure_Specification (Loc,
  4563.              Defining_Unit_Name =>
  4564.                Make_Identifier (Loc,
  4565.                  Chars =>
  4566.                    New_External_Name (
  4567.                      Related_Id => Receiving_Stub_Name,
  4568.                      Suffix       => 'S',
  4569.                      Suffix_Index => Subp_Num)),
  4570.              Parameter_Specifications => NStub_Param_Specs (Loc));
  4571.  
  4572.          --  Build the stub body node
  4573.  
  4574.          if Param_Specs /= No_List then
  4575.             Param_Spec := First (Param_Specs);
  4576.             while Present (Param_Spec) loop
  4577.                Param :=
  4578.                  Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
  4579.                Param_Type := Parameter_Type (Param_Spec);
  4580.  
  4581.                --  For the moment we suppose that we have
  4582.                --  no access definition as parameter type ???
  4583.  
  4584.                Append (Param, Param_List);
  4585.  
  4586.                if Has_Unknown_Size (Etype (Param_Type)) then
  4587.  
  4588.                   Append_To (Decls,
  4589.                     Make_Object_Declaration (Loc,
  4590.                       Defining_Identifier =>
  4591.                         New_Reference_To (Param, Loc),
  4592.  
  4593.                       Object_Definition =>
  4594.                         Copy_Original_Tree (Param_Type),
  4595.  
  4596.                       Expression =>
  4597.                         Make_Function_Call (Loc,
  4598.                           Name =>
  4599.                             Make_Attribute_Reference (Loc,
  4600.                               Prefix => Copy_Original_Tree (Param_Type),
  4601.                               Attribute_Name => Name_Input),
  4602.                           Parameter_Associations =>
  4603.                             New_List (
  4604.                               Make_Identifier (Loc, Chars (Params))))));
  4605.  
  4606.                else
  4607.                   Append_To (Decls,
  4608.                     Make_Object_Declaration (Loc,
  4609.                       Defining_Identifier =>
  4610.                         New_Reference_To (Param, Loc),
  4611.                       Object_Definition => Copy_Original_Tree (Param_Type)));
  4612.  
  4613.                   if In_Present (Param_Spec) or else
  4614.                      not Out_Present (Param_Spec)
  4615.                   then
  4616.  
  4617.                      Append_To (Param_Read_Stmts,
  4618.                        Make_Procedure_Call_Statement (Loc,
  4619.                          Name => Make_Attribute_Reference (Loc,
  4620.                            Prefix => Copy_Original_Tree (Param_Type),
  4621.                            Attribute_Name => Name_Read),
  4622.  
  4623.                          Parameter_Associations =>
  4624.                            New_List (
  4625.                              Make_Identifier (Loc, Chars (Params)),
  4626.                              Make_Identifier (Loc, Chars (Param)))));
  4627.                   end if;
  4628.                end if;
  4629.  
  4630.                if Out_Present (Param_Spec) then
  4631.  
  4632.                   if Has_Unknown_Size (Etype (Param_Type)) then
  4633.  
  4634.                      Append_To (Param_Write_Stmts,
  4635.                        Make_Procedure_Call_Statement (Loc,
  4636.                          Name =>
  4637.                            Make_Attribute_Reference (Loc,
  4638.                              Prefix => Copy_Original_Tree (Param_Type),
  4639.                              Attribute_Name => Name_Output),
  4640.  
  4641.                          Parameter_Associations =>
  4642.                            New_List (
  4643.                              Make_Identifier (Loc, Chars (Result)),
  4644.                              Make_Identifier (Loc, Chars (Param)))));
  4645.  
  4646.                   else
  4647.                      Append_To (Param_Write_Stmts,
  4648.                        Make_Procedure_Call_Statement (Loc,
  4649.                          Name =>
  4650.                            Make_Attribute_Reference (Loc,
  4651.                              Prefix => Copy_Original_Tree (Param_Type),
  4652.                              Attribute_Name => Name_Write),
  4653.  
  4654.                          Parameter_Associations =>
  4655.                            New_List (
  4656.                              Make_Identifier (Loc, Chars (Result)),
  4657.                              Make_Identifier (Loc, Chars (Param)))));
  4658.                   end if;
  4659.                end if;
  4660.  
  4661.                Param_Spec := Next (Param_Spec);
  4662.             end loop;
  4663.          end if;
  4664.  
  4665.          --  Add the declaration for the value returned by a function
  4666.  
  4667.          if Nkind (Subp_Spec) = N_Function_Specification
  4668.            and then not Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec)))
  4669.          then
  4670.             Append_To (Decls,
  4671.               Make_Object_Declaration (Loc,
  4672.                 Defining_Identifier => Returned_Val,
  4673.                 Object_Definition =>
  4674.                   Copy_Original_Tree (Subtype_Mark (Subp_Spec))));
  4675.          end if;
  4676.  
  4677.          Stmts := Param_Read_Stmts;
  4678.  
  4679.          if Prefix /= Empty then
  4680.             Subp_Name :=
  4681.                Make_Selected_Component (Loc,
  4682.                   Prefix => Prefix,
  4683.                   Selector_Name => Subp_Name);
  4684.          end if;
  4685.  
  4686.          if Nkind (Subp_Spec) = N_Function_Specification then
  4687.  
  4688.             if Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec))) then
  4689.  
  4690.                Append_To (Stmts,
  4691.                  Make_Procedure_Call_Statement (Loc,
  4692.                    Name =>
  4693.                      Make_Attribute_Reference (Loc,
  4694.                        Prefix => Copy_Original_Tree (Subtype_Mark (Subp_Spec)),
  4695.                        Attribute_Name => Name_Output),
  4696.  
  4697.                    Parameter_Associations =>
  4698.                      New_List (
  4699.                        Make_Identifier (Loc, Chars (Result)),
  4700.                        Make_Function_Call (Loc,
  4701.                          Name => Copy_Original_Tree (Subp_Name),
  4702.                          Parameter_Associations => Param_List))));
  4703.  
  4704.             else
  4705.                Append_To (Stmts,
  4706.                  Make_Assignment_Statement (Loc,
  4707.                    Name => Make_Identifier (Loc, Chars (Returned_Val)),
  4708.                    Expression =>
  4709.                      Make_Function_Call (Loc,
  4710.                        Name => Copy_Original_Tree (Subp_Name),
  4711.                        Parameter_Associations => Param_List)));
  4712.             end if;
  4713.  
  4714.          else
  4715.             Append_To (Stmts,
  4716.               Make_Procedure_Call_Statement (Loc,
  4717.                 Name => Copy_Original_Tree (Subp_Name),
  4718.                 Parameter_Associations => Param_List));
  4719.          end if;
  4720.  
  4721.          Append_To (Stmts,
  4722.            Make_Procedure_Call_Statement (Loc,
  4723.              Name =>
  4724.                Make_Attribute_Reference (Loc,
  4725.                  Prefix => AE_Exception_Occurrence (Loc),
  4726.                  Attribute_Name => Name_Write),
  4727.  
  4728.              Parameter_Associations => New_List (
  4729.                New_Reference_To (Result, Loc),
  4730.                AE_Null_Occurrence (Loc))));
  4731.  
  4732.          Append_List (Param_Write_Stmts, Stmts);
  4733.  
  4734.          if Nkind (Subp_Spec) = N_Function_Specification
  4735.            and then not Has_Unknown_Size (Etype (Subtype_Mark (Subp_Spec)))
  4736.          then
  4737.             Append_To (Stmts,
  4738.               Make_Procedure_Call_Statement (Loc,
  4739.                 Name =>
  4740.                   Make_Attribute_Reference (Loc,
  4741.                     Prefix => Copy_Original_Tree (Subtype_Mark (Subp_Spec)),
  4742.                     Attribute_Name => Name_Write),
  4743.  
  4744.                 Parameter_Associations =>
  4745.                   New_List (
  4746.                     Make_Identifier (Loc, Chars (Result)),
  4747.                     Make_Identifier (Loc, Chars (Returned_Val)))));
  4748.          end if;
  4749.  
  4750.          Hss :=
  4751.            Make_Handled_Sequence_Of_Statements (Loc,
  4752.              Statements => Stmts,
  4753.              Exception_Handlers => New_List (
  4754.                Make_Exception_Handler (Loc,
  4755.                  Choice_Parameter => Make_Identifier (Loc, Chars (Except)),
  4756.                  Exception_Choices => New_List (Make_Others_Choice (Loc)),
  4757.                  Statements => New_List (
  4758.                    Make_Procedure_Call_Statement (Loc,
  4759.                      Name =>
  4760.                        Make_Attribute_Reference (Loc,
  4761.                          Prefix => AE_Exception_Occurrence (Loc),
  4762.                          Attribute_Name => Name_Write),
  4763.  
  4764.                      Parameter_Associations =>
  4765.                        New_List (
  4766.                          New_Reference_To (Result, Loc),
  4767.                          New_Reference_To (Except, Loc)))))));
  4768.  
  4769.          Stub_Body :=
  4770.            Make_Subprogram_Body (Loc,
  4771.              Specification => Copy_Original_Tree (Stub_Spec),
  4772.              Declarations => Decls,
  4773.              Handled_Statement_Sequence => Hss);
  4774.  
  4775.          return Stub_Body;
  4776.       end Build_Receiving_Stub_Body;
  4777.  
  4778.       ---------------------------
  4779.       -- Build_Receiving_Stubs --
  4780.       ---------------------------
  4781.  
  4782.       procedure Build_Receiving_Stubs
  4783.         (Pkg_Decl : Node_Id;
  4784.          Pkg_Body : Node_Id;
  4785.          Prefix   : Node_Id)
  4786.       is
  4787.          Specif          : Node_Id := Specification (Pkg_Decl);
  4788.          Decls           : List_Id := Visible_Declarations (Specif);
  4789.          Subpackage_Body : Node_Id;
  4790.          Decl            : Node_Id;
  4791.          Spec            : Node_Id;
  4792.          New_Prefix      : Node_Id;
  4793.  
  4794.       begin
  4795.          if Decls /= No_List then
  4796.             Decl := First (Decls);
  4797.  
  4798.             while Present (Decl) loop
  4799.                if Comes_From_Source (Decl) then
  4800.                   if Nkind (Decl) = N_Subprogram_Declaration then
  4801.                      Subp_Num := Subp_Num + 1;
  4802.  
  4803.                      if Nkind (Specification (Decl)) =
  4804.                        N_Procedure_Specification and then
  4805.                        Is_Asynchronous (Defining_Unit_Simple_Name (
  4806.                        Specification (Decl)))
  4807.                      then
  4808.                         Stub_Body :=
  4809.                           Build_Async_Receiving_Stub_Body (Decl, Prefix);
  4810.                         Append (Stub_Body, Receiver_Decls);
  4811.                         Param_Assocs :=
  4812.                           New_List (Make_Identifier (Loc, Params_Name));
  4813.  
  4814.                      else
  4815.                         Stub_Body := Build_Receiving_Stub_Body (Decl, Prefix);
  4816.                         Append (Stub_Body, Receiver_Decls);
  4817.                         Param_Assocs :=
  4818.                           New_List (
  4819.                             Make_Identifier (Loc, Params_Name),
  4820.                             Make_Identifier (Loc, Result_Name));
  4821.                      end if;
  4822.  
  4823.                      Append_To (Case_Stmt_Alts,
  4824.                        Make_Case_Statement_Alternative (Loc,
  4825.                          Discrete_Choices => New_List (
  4826.                            Make_Integer_Literal (Loc, UI_From_Int (Subp_Num))),
  4827.  
  4828.                          Statements => New_List (
  4829.                            Make_Procedure_Call_Statement (Loc,
  4830.                              Name => Copy_Original_Tree (Defining_Unit_Name
  4831.                                (Specification (Stub_Body))),
  4832.                              Parameter_Associations => Param_Assocs))));
  4833.  
  4834.                   elsif Nkind (Decl) = N_Package_Declaration then
  4835.  
  4836.                      Spec := Specification (Decl);
  4837.  
  4838.                      if Prefix /= Empty then
  4839.                         New_Prefix :=
  4840.                           Make_Selected_Component (Loc,
  4841.                             Prefix => Prefix,
  4842.                               Selector_Name =>
  4843.                                 Copy_Original_Tree (
  4844.                                   Defining_Unit_Name (Spec)));
  4845.                      else
  4846.                         New_Prefix := Defining_Unit_Name (Spec);
  4847.                      end if;
  4848.  
  4849.                      if not Present (Corresponding_Body (Decl)) then
  4850.                         Subpackage_Body :=
  4851.                           Make_Package_Body (Loc,
  4852.                             Defining_Unit_Name =>
  4853.                               Copy_Original_Tree (Defining_Unit_Name (Specif)),
  4854.                             Declarations => New_List);
  4855.                         Append (Subpackage_Body, Declarations (Pkg_Body));
  4856.                      end if;
  4857.  
  4858.                      Build_Receiving_Stubs (Decl, Subpackage_Body, New_Prefix);
  4859.  
  4860.                   elsif Nkind (Decl) = N_Full_Type_Declaration and then
  4861.                     Is_Remote_Access_To_Class_Wide_Type (
  4862.                     Defining_Identifier (Decl))
  4863.                   then
  4864.                      Last_Racw_Num := Last_Racw_Num + 1;
  4865.                      Add_Racw_Stubs
  4866.                        (Decl,
  4867.                         Declarations (Pkg_Body),
  4868.                         Last_Racw_Num);
  4869.  
  4870.                   else
  4871.                      --  All the other cases will be seen later
  4872.  
  4873.                      null;
  4874.                   end if;
  4875.                end if;
  4876.  
  4877.                Decl := Next (Decl);
  4878.             end loop;
  4879.          end if;
  4880.  
  4881.       end Build_Receiving_Stubs;
  4882.  
  4883.    --  Start of processing for Build_Receiving_Stubs_Pkg_Body
  4884.  
  4885.    begin
  4886.       if Nkind (Unit_Node) = N_Package_Body then
  4887.          Pkg_Decl := Get_Declaration_Node (Corresponding_Spec (Unit_Node));
  4888.          Spec     := Specification (Pkg_Decl);
  4889.       else
  4890.          --  In this case we have a spec for which no body is required
  4891.  
  4892.          Pkg_Decl := Unit_Node;
  4893.          Spec := Specification (Unit_Node);
  4894.       end if;
  4895.  
  4896.       --  Initialization of features needed from the specification
  4897.  
  4898.       Loc         := Sloc (Spec);
  4899.       Vis_Decls   := Visible_Declarations (Spec);
  4900.       Priv_Decls  := Private_Declarations (Spec);
  4901.       Pkg_Name    := Defining_Unit_Name (Spec);
  4902.  
  4903.       --  Initialization of names
  4904.  
  4905.       Package_Rpc_Receiver_Name := Get_Name_Id ("package_rpc_receiver");
  4906.       Receiving_Stub_Name       := Get_Name_Id ("receiving");
  4907.       Pkg_Name_String           := Get_Pkg_Name_String_Id (Unit_Node);
  4908.  
  4909.       --  Initialize the declarative part of the package body to build
  4910.       --  using the original body declarative part.
  4911.  
  4912.       if Nkind (Unit_Node) = N_Package_Body then
  4913.          Stubs_Pkg_Body := Unit_Node;
  4914.       else
  4915.          Stubs_Pkg_Body :=
  4916.            Make_Package_Body (Loc,
  4917.              Defining_Unit_Name => Copy_Original_Tree (Pkg_Name),
  4918.              Declarations => New_List);
  4919.       end if;
  4920.  
  4921.       --  Build and append the receiving stub body to the stubs package body
  4922.  
  4923.       Build_Receiving_Stubs (Pkg_Decl, Stubs_Pkg_Body, Empty);
  4924.  
  4925.       Append_To (Case_Stmt_Alts,
  4926.         Make_Case_Statement_Alternative (Loc,
  4927.           Discrete_Choices => New_List (Make_Others_Choice (Loc)),
  4928.           Statements => New_List (Make_Null_Statement (Loc))));
  4929.  
  4930.       Receiver_Spec :=
  4931.         Make_Procedure_Specification (Loc,
  4932.           Defining_Unit_Name =>
  4933.             Make_Identifier (Loc, Package_Rpc_Receiver_Name),
  4934.           Parameter_Specifications => NStub_Param_Specs (Loc));
  4935.  
  4936.       Append_To (Receiver_Decls,
  4937.          Make_Object_Declaration (Loc,
  4938.            Defining_Identifier =>
  4939.              Make_Defining_Identifier (Loc, Subp_Num_Name),
  4940.            Object_Definition => SRP_Subprogram_Id (Loc)));
  4941.  
  4942.       Receiver_Body :=
  4943.         Make_Subprogram_Body (Loc,
  4944.           Specification => Receiver_Spec,
  4945.  
  4946.           Declarations  => Receiver_Decls,
  4947.  
  4948.           Handled_Statement_Sequence =>
  4949.             Make_Handled_Sequence_Of_Statements (Loc,
  4950.               Statements => New_List (
  4951.                 Make_Procedure_Call_Statement (Loc,
  4952.                   Name =>
  4953.                     Make_Attribute_Reference (Loc,
  4954.                       Prefix => SRP_Subprogram_Id (Loc),
  4955.                       Attribute_Name => Name_Read),
  4956.  
  4957.                   Parameter_Associations => New_List (
  4958.                     Make_Identifier (Loc, Params_Name),
  4959.                     Make_Identifier (Loc, Subp_Num_Name))),
  4960.                     Make_Case_Statement (Loc,
  4961.                       Expression =>
  4962.                         Make_Identifier (Loc, Subp_Num_Name),
  4963.                       Alternatives => Case_Stmt_Alts))));
  4964.  
  4965.       Append (Receiver_Body, Declarations (Stubs_Pkg_Body));
  4966.  
  4967.       --  Build the package body node
  4968.  
  4969.       Elab_Stmt :=
  4970.         Make_Procedure_Call_Statement (Loc,
  4971.            Name => SRP_Register_Receiver_Elaboration (Loc),
  4972.            Parameter_Associations => New_List (
  4973.              Make_String_Literal (Loc, Pkg_Name_String),
  4974.              Make_Attribute_Reference (Loc,
  4975.                Prefix => Make_Identifier (Loc, Package_Rpc_Receiver_Name),
  4976.                Attribute_Name => Name_Unrestricted_Access)));
  4977.  
  4978.       Body_Hss := Handled_Statement_Sequence (Stubs_Pkg_Body);
  4979.  
  4980.       if  Present (Body_Hss) then
  4981.          if Present (Statements (Body_Hss)) then
  4982.             Append (Elab_Stmt, Statements (Body_Hss));
  4983.          else
  4984.             Set_Statements (Body_Hss, New_List (Elab_Stmt));
  4985.          end if;
  4986.       else
  4987.          Set_Handled_Statement_Sequence (Stubs_Pkg_Body,
  4988.            Make_Handled_Sequence_Of_Statements (Loc,
  4989.              Statements => New_List (Elab_Stmt)));
  4990.       end if;
  4991.  
  4992.    end Build_Receiving_Stubs_Pkg_Body;
  4993.  
  4994.    --------------------
  4995.    -- Racw_Read_Spec --
  4996.    --------------------
  4997.  
  4998.    function Racw_Read_Spec
  4999.      (Loc       : Source_Ptr;
  5000.       Racw_Type : Entity_Id)
  5001.       return      Node_Id
  5002.    is
  5003.    begin
  5004.       return
  5005.         Make_Procedure_Specification (Loc,
  5006.           Defining_Unit_Name => Make_Defining_Identifier (Loc, Name_Read),
  5007.           Parameter_Specifications => New_List (
  5008.  
  5009.             Make_Parameter_Specification (Loc,
  5010.               Defining_Identifier =>
  5011.                 Make_Defining_Identifier (Loc, Stream_Name),
  5012.               Parameter_Type =>
  5013.                 Make_Access_Definition (Loc,
  5014.                   Subtype_Mark =>
  5015.                     Make_Attribute_Reference (Loc,
  5016.                       Prefix => AS_Root_Stream_Type (Loc),
  5017.                       Attribute_Name => Name_Class))),
  5018.  
  5019.             Make_Parameter_Specification (Loc,
  5020.               Defining_Identifier =>
  5021.                 Make_Defining_Identifier (Loc, Item_Name),
  5022.               Out_Present => True,
  5023.               Parameter_Type =>
  5024.                 New_Reference_To (Racw_Type, Loc))));
  5025.    end Racw_Read_Spec;
  5026.  
  5027.    ---------------------
  5028.    -- Racw_Write_Spec --
  5029.    ---------------------
  5030.  
  5031.    function Racw_Write_Spec
  5032.      (Loc       : Source_Ptr;
  5033.       Racw_Type : Entity_Id)
  5034.       return      Node_Id
  5035.    is
  5036.    begin
  5037.       return
  5038.         Make_Procedure_Specification (Loc,
  5039.           Defining_Unit_Name => Make_Defining_Identifier (Loc, Name_Write),
  5040.           Parameter_Specifications => New_List (
  5041.  
  5042.             Make_Parameter_Specification (Loc,
  5043.               Defining_Identifier =>
  5044.                 Make_Defining_Identifier (Loc, Stream_Name),
  5045.  
  5046.               Parameter_Type =>
  5047.                 Make_Access_Definition (Loc,
  5048.                   Subtype_Mark =>
  5049.                     Make_Attribute_Reference (Loc,
  5050.                       Prefix => AS_Root_Stream_Type (Loc),
  5051.                       Attribute_Name => Name_Class))),
  5052.  
  5053.             Make_Parameter_Specification (Loc,
  5054.               Defining_Identifier =>
  5055.                 Make_Defining_Identifier (Loc, Item_Name),
  5056.               Parameter_Type =>
  5057.                 New_Reference_To (Racw_Type, Loc))));
  5058.    end Racw_Write_Spec;
  5059.  
  5060. end Exp_Dist;
  5061.