exp_dist.adb (Build_General_Calling_Stubs): New formal parameter RACW_Type, used…

exp_dist.adb (Build_General_Calling_Stubs): New formal parameter RACW_Type, used in the PolyORB version.

2004-10-26  Thomas Quinot  <quinot@act-europe.fr>

	* exp_dist.adb (Build_General_Calling_Stubs): New formal parameter
	RACW_Type, used in the PolyORB version.
	Rename RCI_Info to RCI_Locator, for consistency between the PolyORB
	version and the GARLIC version.

	* snames.ads, snames.adb, s-parint.ads, s-parint.adb:
	Rename RCI_Info to RCI_Locator for better consistency between the
	GARLIC and PolyORB versions of the distributed systems annex.
	(DSA_Implementation_Name): This enumeration lists the possible
	implementations of the Partition Communication Subsystem for the
	Distributed Systems Annex (DSA). The three available implementations
	are the dummy stub implementation (No_DSA), and two versions based on
	two different distribution runtime libraries: GARLIC and PolyORB. Both
	the GARLIC PCS and the PolyORB PCS are part of the GLADE distribution
	technology.
	Change the literal GLADE_DSA to GARLIC_DSA to accurately describe
	that organization.

	* rtsfind.ads: Rename RCI_Info to RCI_Locator for better consistency
	between the GARLIC and PolyORB versions of the distributed systems
	annex.
	Remove RE_Unbounded_Reclaim_Pool since it is unused.

From-SVN: r89652

gcc/ada/exp_dist.adb

@@ -132,6 +132,7 @@ package body Exp_Dist is
       Is_Function               : Boolean;
       Spec                      : Node_Id;
       Stub_Type                 : Entity_Id := Empty;
+      RACW_Type                 : Entity_Id := Empty;
       Nod                       : Node_Id);
    --  Build calling stubs for general purpose. The parameters are:
    --    Decls             : a place to put declarations
@@ -159,6 +160,7 @@ package body Exp_Dist is
       Asynchronous             : Boolean;
       Dynamically_Asynchronous : Boolean   := False;
       Stub_Type                : Entity_Id := Empty;
+      RACW_Type                : Entity_Id := Empty;
       Locator                  : Entity_Id := Empty;
       New_Name                 : Name_Id   := No_Name) return Node_Id;
    --  Build the calling stub for a given subprogram with the subprogram ID
@@ -220,10 +222,9 @@ package body Exp_Dist is
    --  Return True if nothing prevents the program whose specification is
    --  given to be asynchronous (i.e. no out parameter).
 
-   function Get_Pkg_Name_String_Id (Decl_Node : Node_Id) return String_Id;
-   function Get_String_Id (Val : String) return String_Id;
-   --  Ugly functions used to retrieve a package name. Inherited from the
-   --  old exp_dist.adb and not rewritten yet ???
+   procedure Get_Pkg_Name_String (Decl_Node : Node_Id);
+   --  Retrieve the fully expanded name of the library unit declared by decl
+   --  into the name buffer.
 
    function Pack_Entity_Into_Stream_Access
      (Loc    : Source_Ptr;
@@ -308,7 +309,7 @@ package body Exp_Dist is
                          Hash       => Hash,
                          Equal      => "=");
    --  Mapping between a RCI package on which All_Calls_Remote applies and
-   --  the generic instantiation of RCI_Info for this package.
+   --  the generic instantiation of RCI_Locator for this package.
 
    package RCI_Calling_Stubs_Table is
       new Simple_HTable (Header_Num => Hash_Index,
@@ -369,7 +370,7 @@ package body Exp_Dist is
    function RCI_Package_Locator
      (Loc          : Source_Ptr;
       Package_Spec : Node_Id) return Node_Id;
-   --  Instantiate the generic package RCI_Info in order to locate the
+   --  Instantiate the generic package RCI_Locator in order to locate the
    --  RCI package whose spec is given as argument.
 
    function Make_Tag_Check (Loc : Source_Ptr; N : Node_Id) return Node_Id;
@@ -429,7 +430,7 @@ package body Exp_Dist is
 
    begin
       --  The first thing added is an instantiation of the generic package
-      --  System.Partition_interface.RCI_Info with the name of the (current)
+      --  System.Partition_interface.RCI_Locator with the name of this
       --  remote package. This will act as an interface with the name server
       --  to determine the Partition_ID and the RPC_Receiver for the
       --  receiver of this package.
@@ -1935,6 +1936,8 @@ package body Exp_Dist is
 
       Subp_Info_List : constant List_Id := New_List;
 
+      Register_Pkg_Actuals : constant List_Id := New_List;
+
       Dummy_Register_Name : Name_Id;
       Dummy_Register_Spec : Node_Id;
       Dummy_Register_Decl : Node_Id;
@@ -2277,10 +2280,47 @@ package body Exp_Dist is
         Make_Package_Declaration (Loc,
           Specification => Dummy_Register_Spec);
 
-      Append_To (Decls,
-        Dummy_Register_Decl);
+      Append_To (Decls, Dummy_Register_Decl);
       Analyze (Dummy_Register_Decl);
 
+      Get_Pkg_Name_String (Pkg_Spec);
+      Append_To (Register_Pkg_Actuals,
+         --  Name
+        Make_String_Literal (Loc,
+          Strval => String_From_Name_Buffer));
+
+      Append_To (Register_Pkg_Actuals,
+         --  Receiver
+        Make_Attribute_Reference (Loc,
+          Prefix         =>
+            New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
+          Attribute_Name =>
+            Name_Unrestricted_Access));
+
+      Append_To (Register_Pkg_Actuals,
+         --  Version
+        Make_Attribute_Reference (Loc,
+          Prefix         =>
+            New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
+          Attribute_Name =>
+            Name_Version));
+
+      Append_To (Register_Pkg_Actuals,
+         --  Subp_Info
+        Make_Attribute_Reference (Loc,
+          Prefix         =>
+            New_Occurrence_Of (Subp_Info_Array, Loc),
+          Attribute_Name =>
+            Name_Address));
+
+      Append_To (Register_Pkg_Actuals,
+         --  Subp_Info_Len
+        Make_Attribute_Reference (Loc,
+          Prefix         =>
+            New_Occurrence_Of (Subp_Info_Array, Loc),
+          Attribute_Name =>
+            Name_Length));
+
       Dummy_Register_Body :=
         Make_Package_Body (Loc,
           Defining_Unit_Name         =>
@@ -2294,29 +2334,7 @@ package body Exp_Dist is
                   Name                   =>
                     New_Occurrence_Of (RTE (RE_Register_Receiving_Stub), Loc),
 
-                  Parameter_Associations => New_List (
-                    Make_String_Literal (Loc,
-                      Strval => Get_Pkg_Name_String_Id (Pkg_Spec)),
-                    Make_Attribute_Reference (Loc,
-                      Prefix         =>
-                        New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
-                      Attribute_Name =>
-                        Name_Unrestricted_Access),
-                    Make_Attribute_Reference (Loc,
-                      Prefix         =>
-                        New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
-                      Attribute_Name =>
-                        Name_Version),
-                    Make_Attribute_Reference (Loc,
-                      Prefix =>
-                        New_Occurrence_Of (Subp_Info_Array, Loc),
-                      Attribute_Name =>
-                        Name_Address),
-                    Make_Attribute_Reference (Loc,
-                      Prefix =>
-                        New_Occurrence_Of (Subp_Info_Array, Loc),
-                      Attribute_Name =>
-                        Name_Length))))));
+                  Parameter_Associations => Register_Pkg_Actuals))));
 
       Append_To (Decls, Dummy_Register_Body);
       Analyze (Dummy_Register_Body);
@@ -2473,6 +2491,7 @@ package body Exp_Dist is
       Is_Function               : Boolean;
       Spec                      : Node_Id;
       Stub_Type                 : Entity_Id := Empty;
+      RACW_Type                 : Entity_Id := Empty;
       Nod                       : Node_Id)
    is
       Loc : constant Source_Ptr := Sloc (Nod);
@@ -2502,6 +2521,9 @@ package body Exp_Dist is
       --  List of statements for extra formal parameters. It will appear after
       --  the regular statements for writing out parameters.
 
+      pragma Warnings (Off, RACW_Type);
+      --  Unreferenced formal parameter.
+
    begin
       --  The general form of a calling stub for a given subprogram is:
 
@@ -3038,6 +3060,7 @@ package body Exp_Dist is
 
    procedure Build_Passive_Partition_Stub (U : Node_Id) is
       Pkg_Spec : Node_Id;
+      Pkg_Name : String_Id;
       L        : List_Id;
       Reg      : Node_Id;
       Loc      : constant Source_Ptr := Sloc (U);
@@ -3063,12 +3086,14 @@ package body Exp_Dist is
          L := Declarations (U);
       end if;
 
+      Get_Pkg_Name_String (Pkg_Spec);
+      Pkg_Name := String_From_Name_Buffer;
       Reg :=
         Make_Procedure_Call_Statement (Loc,
           Name                   =>
             New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc),
           Parameter_Associations => New_List (
-            Make_String_Literal (Loc, Get_Pkg_Name_String_Id (Pkg_Spec)),
+            Make_String_Literal (Loc, Pkg_Name),
             Make_Attribute_Reference (Loc,
               Prefix         =>
                 New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
@@ -3120,6 +3145,7 @@ package body Exp_Dist is
       Asynchronous             : Boolean;
       Dynamically_Asynchronous : Boolean   := False;
       Stub_Type                : Entity_Id := Empty;
+      RACW_Type                : Entity_Id := Empty;
       Locator                  : Entity_Id := Empty;
       New_Name                 : Name_Id   := No_Name) return Node_Id
    is
@@ -3325,6 +3351,7 @@ package body Exp_Dist is
                                     N_Function_Specification,
          Spec                  => Spec_To_Use,
          Stub_Type             => Stub_Type,
+         RACW_Type             => RACW_Type,
          Nod                   => Vis_Decl);
 
       RCI_Calling_Stubs_Table.Set
@@ -4049,11 +4076,11 @@ package body Exp_Dist is
       Pop_Scope;
    end Expand_Receiving_Stubs_Bodies;
 
-   ----------------------------
-   -- Get_Pkg_Name_string_Id --
-   ----------------------------
+   -------------------------
+   -- Get_Pkg_Name_string --
+   -------------------------
 
-   function Get_Pkg_Name_String_Id (Decl_Node : Node_Id) return String_Id is
+   procedure Get_Pkg_Name_String (Decl_Node : Node_Id) is
       Unit_Name_Id : constant Unit_Name_Type := Get_Unit_Name (Decl_Node);
 
    begin
@@ -4063,20 +4090,7 @@ package body Exp_Dist is
 
       Name_Len := Name_Len - 7;
       pragma Assert (Name_Buffer (Name_Len + 1) = ' ');
-
-      return Get_String_Id (Name_Buffer (1 .. Name_Len));
-   end Get_Pkg_Name_String_Id;
-
-   -------------------
-   -- Get_String_Id --
-   -------------------
-
-   function Get_String_Id (Val : String) return String_Id is
-   begin
-      Start_String;
-      Store_String_Chars (Val);
-      return End_String;
-   end Get_String_Id;
+   end Get_Pkg_Name_String;
 
    -----------------------
    -- Get_Subprogram_Id --
@@ -4331,21 +4345,26 @@ package body Exp_Dist is
      (Loc          : Source_Ptr;
       Package_Spec : Node_Id) return Node_Id
    is
-      Inst : constant Node_Id :=
-               Make_Package_Instantiation (Loc,
-                 Defining_Unit_Name   =>
-                   Make_Defining_Identifier (Loc, New_Internal_Name ('R')),
-                 Name                 =>
-                   New_Occurrence_Of (RTE (RE_RCI_Info), Loc),
-                 Generic_Associations => New_List (
-                   Make_Generic_Association (Loc,
-                     Selector_Name                     =>
-                       Make_Identifier (Loc, Name_RCI_Name),
-                     Explicit_Generic_Actual_Parameter =>
-                       Make_String_Literal (Loc,
-                         Strval => Get_Pkg_Name_String_Id (Package_Spec)))));
+      Inst : Node_Id;
+      Pkg_Name : String_Id;
 
    begin
+      Get_Pkg_Name_String (Package_Spec);
+      Pkg_Name := String_From_Name_Buffer;
+      Inst :=
+        Make_Package_Instantiation (Loc,
+          Defining_Unit_Name   =>
+            Make_Defining_Identifier (Loc, New_Internal_Name ('R')),
+          Name                 =>
+            New_Occurrence_Of (RTE (RE_RCI_Locator), Loc),
+          Generic_Associations => New_List (
+            Make_Generic_Association (Loc,
+              Selector_Name                     =>
+                Make_Identifier (Loc, Name_RCI_Name),
+              Explicit_Generic_Actual_Parameter =>
+                Make_String_Literal (Loc,
+                  Strval => Pkg_Name))));
+
       RCI_Locator_Table.Set (Defining_Unit_Name (Package_Spec),
         Defining_Unit_Name (Inst));
       return Inst;

gcc/ada/rtsfind.ads

@@ -1017,7 +1017,7 @@ package Rtsfind is
      RE_Raise_Program_Error_Unknown_Tag, -- System.Partition_Interface
      RE_Register_Passive_Package,        -- System.Partition_Interface
      RE_Register_Receiving_Stub,         -- System.Partition_Interface
-     RE_RCI_Info,                        -- System.Partition_Interface
+     RE_RCI_Locator,                     -- System.Partition_Interface
      RE_RCI_Subp_Info,                   -- System.Partition_Interface
      RE_RCI_Subp_Info_Array,             -- System.Partition_Interface
      RE_Subprogram_Id,                   -- System.Partition_Interface
@@ -1025,8 +1025,6 @@ package Rtsfind is
 
      RE_Global_Pool_Object,              -- System.Pool_Global
 
-     RE_Unbounded_Reclaim_Pool,          -- System.Pool_Local
-
      RE_Stack_Bounded_Pool,              -- System.Pool_Size
 
      RE_Do_Apc,                          -- System.RPC
@@ -1077,7 +1075,6 @@ package Rtsfind is
      RE_Get_Local_Address,               -- System.PolyORB_Interface
      RE_Get_Reference,                   -- System.PolyORB_Interface
      RE_Local_Oid_To_Address,            -- System.PolyORB_Interface
-     RE_RCI_Locator,                     -- System.PolyORB_Interface
      RE_Asynchronous_P_To_Sync_Scope,    -- System.PolyORB_Interface
      RE_Buffer_Stream_Type,              -- System.PolyORB_Interface
      RE_Allocate_Buffer,                 -- System.PolyORB_Interface
@@ -2099,7 +2096,7 @@ package Rtsfind is
      RE_Raise_Program_Error_Unknown_Tag  => System_Partition_Interface,
      RE_Register_Passive_Package         => System_Partition_Interface,
      RE_Register_Receiving_Stub          => System_Partition_Interface,
-     RE_RCI_Info                         => System_Partition_Interface,
+     RE_RCI_Locator                      => System_Partition_Interface,
      RE_RCI_Subp_Info                    => System_Partition_Interface,
      RE_RCI_Subp_Info_Array              => System_Partition_Interface,
      RE_Subprogram_Id                    => System_Partition_Interface,
@@ -2147,7 +2144,6 @@ package Rtsfind is
      RE_Get_Local_Address                => System_PolyORB_Interface,
      RE_Get_Reference                    => System_PolyORB_Interface,
      RE_Local_Oid_To_Address             => System_PolyORB_Interface,
-     RE_RCI_Locator                      => System_PolyORB_Interface,
      RE_Asynchronous_P_To_Sync_Scope     => System_PolyORB_Interface,
      RE_Buffer_Stream_Type               => System_PolyORB_Interface,
      RE_Allocate_Buffer                  => System_PolyORB_Interface,
@@ -2234,8 +2230,6 @@ package Rtsfind is
 
      RE_Global_Pool_Object               => System_Pool_Global,
 
-     RE_Unbounded_Reclaim_Pool           => System_Pool_Local,
-
      RE_Stack_Bounded_Pool               => System_Pool_Size,
 
      RE_Do_Apc                           => System_RPC,

gcc/ada/s-parint.adb

@@ -219,11 +219,11 @@ package body System.Partition_Interface is
         (Program_Error'Identity, Ada.Exceptions.Exception_Message (E));
    end Raise_Program_Error_Unknown_Tag;
 
-   --------------
-   -- RCI_Info --
-   --------------
+   -----------------
+   -- RCI_Locator --
+   -----------------
 
-   package body RCI_Info is
+   package body RCI_Locator is
 
       -----------------------------
       -- Get_Active_Partition_ID --
@@ -254,7 +254,7 @@ package body System.Partition_Interface is
          return 0;
       end Get_RCI_Package_Receiver;
 
-   end RCI_Info;
+   end RCI_Locator;
 
    ------------------------------
    -- Register_Passive_Package --

gcc/ada/s-parint.ads

@@ -42,7 +42,7 @@ package System.Partition_Interface is
 
    pragma Elaborate_Body;
 
-   type DSA_Implementation_Name is (No_DSA, GLADE_DSA, PolyORB_DSA);
+   type DSA_Implementation_Name is (No_DSA, GARLIC_DSA, PolyORB_DSA);
    DSA_Implementation : constant DSA_Implementation_Name := No_DSA;
 
    --  RCI receiving stubs contain a table of descriptors for
@@ -97,7 +97,7 @@ package System.Partition_Interface is
    --  unit has has the same version than the caller's one.
 
    function Get_Active_Partition_ID (Name : Unit_Name) return RPC.Partition_ID;
-   --  Similar in some respects to RCI_Info.Get_Active_Partition_ID
+   --  Similar in some respects to RCI_Locator.Get_Active_Partition_ID
 
    function Get_Active_Version (Name : Unit_Name) return String;
    --  Similar in some respects to Get_Active_Partition_ID
@@ -114,7 +114,7 @@ package System.Partition_Interface is
 
    function Get_RCI_Package_Receiver
      (Name : Unit_Name) return Interfaces.Unsigned_64;
-   --  Similar in some respects to RCI_Info.Get_RCI_Package_Receiver
+   --  Similar in some respects to RCI_Locator.Get_RCI_Package_Receiver
 
    procedure Get_Unique_Remote_Pointer
      (Handler : in out RACW_Stub_Type_Access);
@@ -149,10 +149,10 @@ package System.Partition_Interface is
 
    generic
       RCI_Name : String;
-   package RCI_Info is
+   package RCI_Locator is
       function Get_RCI_Package_Receiver return Interfaces.Unsigned_64;
       function Get_Active_Partition_ID return RPC.Partition_ID;
-   end RCI_Info;
+   end RCI_Locator;
    --  RCI package information caching
 
    procedure Run (Main : Main_Subprogram_Type := null);

gcc/ada/snames.adb

@@ -122,7 +122,7 @@ package body Snames is
      "text_io#" &
      "wide_text_io#" &
      "no_dsa#" &
-     "glade_dsa#" &
+     "garlic_dsa#" &
      "polyorb_dsa#" &
      "addr#" &
      "async#" &

gcc/ada/snames.ads

@@ -238,7 +238,7 @@ package Snames is
    --  Names of implementations of the distributed systems annex
 
    Name_No_DSA                         : constant Name_Id := N + 064;
-   Name_GLADE_DSA                      : constant Name_Id := N + 065;
+   Name_GARLIC_DSA                     : constant Name_Id := N + 065;
    Name_PolyORB_DSA                    : constant Name_Id := N + 066;
 
    --  Names of identifiers used in expanding distribution stubs