exp_dist.adb (Build_RPC_Receiver_Body): New subprogram.

	* exp_dist.adb (Build_RPC_Receiver_Body): New subprogram. This
	procedures factors the common processing for building an RPC receiver
	for an RCI package or an RACW type.
	Stylistic cleanup: change '/= Empty' to 'Present ()'; move body of
	Build_Remote_Subprogram_Proxy_Type into proper alphabetical order.
	(Get_PCS_Name): New subprogram. Returns the name of the PCS currently
	in use.
	(Specific_Add_RACW_Features): New subprogram. PCS-specific part of
	Add_RACW_Features.
	(Specific_Add_RAST_Features): New subprogram. PCS-specific part of
	Add_RAST_Features.
	(Assign_Subprogram_Identifier): New subprogram. Provision for assigning
	distribution subprogram identifiers that are either subprogram numbers
	or strings.
	(Get_Subprogram_Ids): New subprogram. Retrieve both the numeric and
	string distribution identifiers assigned to a given subprogram.
	(Get_Subprogram_Id): Reimplement in terms of Get_Subprogram_Ids.
	(Add_RAS_Dereference_TSS): Add comments.
	(Build_General_Calling_Stubs): Note that the RACW_Type formal parameter
	is not referenced yet because it will be used by the PolyORB DSA
	implementation.
	(Insert_Partition_Check): Remove fossile code.
	(First_RCI_Subprogram_Id): Document this constant.
	(Add_RAS_Access_TSS): Correct the setting of the Etype of the
	RAS_Access TSS.
	(Get_Pkg_Name_String): Remove subprogram. Usage occurrences are
	replaced with calls to Get_Library_Unit_Name_String. Previously there
	were several instances of the same code in different locations in the
	compiler; this checkin completes the replacement of all of these
	instances with calls to a common subprogram.
	Minor reformatting.

	* sem_dist.adb: Remove comment noting that RPC receiver generation
	should be disabled for RACWs that implement RASs.
	(Process_Partition_Id): Use new subprogram Get_Library_Unit_Name_String.

	* sem_util.ads, sem_util.adb (Has_Stream): New function
	(Get_Library_Unit_Name_String): New subprogram to retrieve the fully
	qualified name of a library unit into the name buffer.
	(Note_Possible_Modification): Generate a reference only
	if the context comes from source.

	* snames.ads (PCS_Names): New subtype corresponding to names of
	supported implementations of the Partition Communication Subsystem
	(PCS) (i.e. the runtime library support modules for the distributed
	systems annex).

From-SVN: r90903

gcc/ada/sem_dist.adb

@@ -43,7 +43,6 @@ with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
 with Tbuild;   use Tbuild;
-with Uname;    use Uname;
 
 package body Sem_Dist is
 
@@ -290,18 +289,10 @@ package body Sem_Dist is
       end if;
 
       --  Get and store the String_Id corresponding to the name of the
-      --  library unit whose Partition_Id is needed
+      --  library unit whose Partition_Id is needed.
 
-      Get_Unit_Name_String (Get_Unit_Name (Unit_Declaration_Node (Ety)));
-
-      --  Remove seven last character ("(spec)" or " (body)").
-      --  (this is a bit nasty, should have interface for this ???)
-
-      Name_Len := Name_Len - 7;
-
-      Start_String;
-      Store_String_Chars (Name_Buffer (1 .. Name_Len));
-      Prefix_String := End_String;
+      Get_Library_Unit_Name_String (Unit_Declaration_Node (Ety));
+      Prefix_String := String_From_Name_Buffer;
 
       --  Build the function call which will replace the attribute
 
@@ -510,9 +501,6 @@ package body Sem_Dist is
                     Name_Class))));
       Set_Is_Remote_Call_Interface (RACW_Type, Is_RCI);
       Set_Is_Remote_Types (RACW_Type, Is_RT);
-      --  ??? Object RPC receiver generation should be bypassed for this
-      --  RACW type, since actually calls will be received by the package
-      --  RPC receiver for the designated RCI subprogram.
 
       Subpkg_Decl :=
         Make_Package_Declaration (Loc,

gcc/ada/sem_util.adb

@@ -58,6 +58,7 @@ with Stringt;  use Stringt;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
+with Uname;    use Uname;
 
 package body Sem_Util is
 
@@ -2620,6 +2621,22 @@ package body Sem_Util is
       end if;
    end Get_Index_Bounds;
 
+   ----------------------------------
+   -- Get_Library_Unit_Name_string --
+   ----------------------------------
+
+   procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id) is
+      Unit_Name_Id : constant Unit_Name_Type := Get_Unit_Name (Decl_Node);
+
+   begin
+      Get_Unit_Name_String (Unit_Name_Id);
+
+      --  Remove seven last character (" (spec)" or " (body)").
+
+      Name_Len := Name_Len - 7;
+      pragma Assert (Name_Buffer (Name_Len + 1) = ' ');
+   end Get_Library_Unit_Name_String;
+
    ------------------------
    -- Get_Name_Entity_Id --
    ------------------------
@@ -2864,6 +2881,43 @@ package body Sem_Util is
       end if;
    end Has_Private_Component;
 
+   ----------------
+   -- Has_Stream --
+   ----------------
+
+   function Has_Stream (T : Entity_Id) return Boolean is
+      E : Entity_Id;
+
+   begin
+      if No (T) then
+         return False;
+
+      elsif Is_RTE (Root_Type (T), RE_Root_Stream_Type) then
+         return True;
+
+      elsif Is_Array_Type (T) then
+         return Has_Stream (Component_Type (T));
+
+      elsif Is_Record_Type (T) then
+         E := First_Component (T);
+         while Present (E) loop
+            if Has_Stream (Etype (E)) then
+               return True;
+            else
+               Next_Component (E);
+            end if;
+         end loop;
+
+         return False;
+
+      elsif Is_Private_Type (T) then
+         return Has_Stream (Underlying_Type (T));
+
+      else
+         return False;
+      end if;
+   end Has_Stream;
+
    --------------------------
    -- Has_Tagged_Component --
    --------------------------
@@ -5267,7 +5321,13 @@ package body Sem_Util is
                   goto Continue;
                end if;
 
-               Generate_Reference (Ent, Exp, 'm');
+               --  Generate a reference only if the assignment comes from
+               --  source. This excludes, for example, calls to a dispatching
+               --  assignment operation when the left-hand side is tagged.
+
+               if Modification_Comes_From_Source then
+                  Generate_Reference (Ent, Exp, 'm');
+               end if;
             end if;
 
             Kill_Checks (Ent);

gcc/ada/sem_util.ads

@@ -333,6 +333,10 @@ package Sem_Util is
    --  The third argument supplies a source location for constructed
    --  nodes returned by this function.
 
+   procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id);
+   --  Retrieve the fully expanded name of the library unit declared by
+   --  Decl_Node into the name buffer.
+
    function Get_Name_Entity_Id (Id : Name_Id) return Entity_Id;
    --  An entity value is associated with each name in the name table. The
    --  Get_Name_Entity_Id function fetches the Entity_Id of this entity,
@@ -374,6 +378,14 @@ package Sem_Util is
    --  Check if a type has a (sub)component of a private type that has not
    --  yet received a full declaration.
 
+   function Has_Stream (T : Entity_Id) return Boolean;
+   --  Tests if type T is derived from Ada.Streams.Root_Stream_Type, or
+   --  in the case of a composite type, has a component for which this
+   --  predicate is True, and if so returns True. Otherwise a result of
+   --  False means that there is no Stream type in sight. For a private
+   --  type, the test is applied to the underlying type (or returns False
+   --  if there is no underlying type).
+
    function Has_Tagged_Component (Typ : Entity_Id) return Boolean;
    --  Typ must be a composite type (array or record). This function is used
    --  to check if '=' has to be expanded into a bunch component comparaisons.

gcc/ada/snames.ads

@@ -237,9 +237,14 @@ package Snames is
 
    --  Names of implementations of the distributed systems annex
 
+   First_PCS_Name                      : constant Name_Id := N + 064;
    Name_No_DSA                         : constant Name_Id := N + 064;
    Name_GARLIC_DSA                     : constant Name_Id := N + 065;
    Name_PolyORB_DSA                    : constant Name_Id := N + 066;
+   Last_PCS_Name                       : constant Name_Id := N + 066;
+
+   subtype PCS_Names is Name_Id
+     range First_PCS_Name .. Last_PCS_Name;
 
    --  Names of identifiers used in expanding distribution stubs