diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index a5791adf7dd..7235a164e0a 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -77,8 +77,55 @@ with Uname;          use Uname;
 with Urealp;         use Urealp;
 with Validsw;        use Validsw;
 
+with GNAT.HTable;
+
 package body Exp_Attr is
 
+   package Cached_Streaming_Ops is
+
+      Map_Size : constant := 63;
+      subtype Header_Num is Integer range 0 .. Map_Size - 1;
+
+      function Streaming_Op_Hash (Id : Entity_Id) return Header_Num is
+        (Header_Num (Id mod Map_Size));
+
+      --  Cache used to avoid building duplicate subprograms for a single
+      --  type/streaming-attribute pair.
+
+      package Read_Map is new GNAT.HTable.Simple_HTable
+        (Header_Num => Header_Num,
+         Key        => Entity_Id,
+         Element    => Entity_Id,
+         No_Element => Empty,
+         Hash       => Streaming_Op_Hash,
+         Equal      => "=");
+
+      package Write_Map is new GNAT.HTable.Simple_HTable
+        (Header_Num => Header_Num,
+         Key        => Entity_Id,
+         Element    => Entity_Id,
+         No_Element => Empty,
+         Hash       => Streaming_Op_Hash,
+         Equal      => "=");
+
+      package Input_Map is new GNAT.HTable.Simple_HTable
+        (Header_Num => Header_Num,
+         Key        => Entity_Id,
+         Element    => Entity_Id,
+         No_Element => Empty,
+         Hash       => Streaming_Op_Hash,
+         Equal      => "=");
+
+      package Output_Map is new GNAT.HTable.Simple_HTable
+        (Header_Num => Header_Num,
+         Key        => Entity_Id,
+         Element    => Entity_Id,
+         No_Element => Empty,
+         Hash       => Streaming_Op_Hash,
+         Equal      => "=");
+
+   end Cached_Streaming_Ops;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -210,13 +257,15 @@ package body Exp_Attr is
    --  is not a floating-point type.
 
    function Find_Stream_Subprogram
-     (Typ : Entity_Id;
-      Nam : TSS_Name_Type) return Entity_Id;
+     (Typ      : Entity_Id;
+      Nam      : TSS_Name_Type;
+      Attr_Ref : Node_Id) return Entity_Id;
    --  Returns the stream-oriented subprogram attribute for Typ. For tagged
    --  types, the corresponding primitive operation is looked up, else the
    --  appropriate TSS from the type itself, or from its closest ancestor
    --  defining it, is returned. In both cases, inheritance of representation
-   --  aspects is thus taken into account.
+   --  aspects is thus taken into account. Attr_Ref is used to identify the
+   --  point from which the function result will be referenced.
 
    function Full_Base (T : Entity_Id) return Entity_Id;
    --  The stream functions need to examine the underlying representation of
@@ -4115,18 +4164,19 @@ package body Exp_Attr is
       -----------
 
       when Attribute_Input => Input : declare
-         P_Type : constant Entity_Id := Entity (Pref);
-         B_Type : constant Entity_Id := Base_Type (P_Type);
-         U_Type : constant Entity_Id := Underlying_Type (P_Type);
-         Strm   : constant Node_Id   := First (Exprs);
-         Fname  : Entity_Id;
-         Decl   : Node_Id;
-         Call   : Node_Id;
-         Prag   : Node_Id;
-         Arg2   : Node_Id;
-         Rfunc  : Node_Id;
+         P_Type  : constant Entity_Id := Entity (Pref);
+         B_Type  : constant Entity_Id := Base_Type (P_Type);
+         U_Type  : constant Entity_Id := Underlying_Type (P_Type);
+         Strm    : constant Node_Id   := First (Exprs);
+         Has_TSS : Boolean := False;
+         Fname   : Entity_Id;
+         Decl    : Node_Id;
+         Call    : Node_Id;
+         Prag    : Node_Id;
+         Arg2    : Node_Id;
+         Rfunc   : Node_Id;
 
-         Cntrl  : Node_Id := Empty;
+         Cntrl   : Node_Id := Empty;
          --  Value for controlling argument in call. Always Empty except in
          --  the dispatching (class-wide type) case, where it is a reference
          --  to the dummy object initialized to the right internal tag.
@@ -4192,10 +4242,10 @@ package body Exp_Attr is
 
          --  If there is a TSS for Input, just call it
 
-         Fname := Find_Stream_Subprogram (P_Type, TSS_Stream_Input);
+         Fname := Find_Stream_Subprogram (P_Type, TSS_Stream_Input, N);
 
          if Present (Fname) then
-            null;
+            Has_TSS := True;
 
          else
             --  If there is a Stream_Convert pragma, use it, we rewrite
@@ -4252,7 +4302,7 @@ package body Exp_Attr is
 
                if Present (Find_Inherited_TSS (P_Type, TSS_Stream_Read)) then
                   Build_Record_Or_Elementary_Input_Function
-                    (Loc, P_Type, Decl, Fname);
+                    (P_Type, Decl, Fname);
                   Insert_Action (N, Decl);
 
                --  For normal cases, we call the I_xxx routine directly
@@ -4266,7 +4316,7 @@ package body Exp_Attr is
             --  Array type case
 
             elsif Is_Array_Type (U_Type) then
-               Build_Array_Input_Function (Loc, U_Type, Decl, Fname);
+               Build_Array_Input_Function (U_Type, Decl, Fname);
                Compile_Stream_Body_In_Scope (N, Decl, U_Type);
 
             --  Dispatching case with class-wide type
@@ -4395,7 +4445,7 @@ package body Exp_Attr is
                --  constrained discriminants (see Ada 2012 AI05-0192).
 
                Build_Record_Or_Elementary_Input_Function
-                 (Loc, U_Type, Decl, Fname);
+                 (U_Type, Decl, Fname);
                Insert_Action (N, Decl);
 
                if Nkind (Parent (N)) = N_Object_Declaration
@@ -4413,7 +4463,7 @@ package body Exp_Attr is
                      while Present (Comp) loop
                         Func :=
                           Find_Stream_Subprogram
-                            (Etype (Comp), TSS_Stream_Read);
+                            (Etype (Comp), TSS_Stream_Read, N);
 
                         if Present (Func) then
                            Freeze_Stream_Subprogram (Func);
@@ -4443,6 +4493,10 @@ package body Exp_Attr is
          if Nkind (Parent (N)) = N_Object_Declaration then
             Freeze_Stream_Subprogram (Fname);
          end if;
+
+         if not Has_TSS then
+            Cached_Streaming_Ops.Input_Map.Set (P_Type, Fname);
+         end if;
       end Input;
 
       -------------------
@@ -5279,13 +5333,14 @@ package body Exp_Attr is
       ------------
 
       when Attribute_Output => Output : declare
-         P_Type : constant Entity_Id := Entity (Pref);
-         U_Type : constant Entity_Id := Underlying_Type (P_Type);
-         Pname  : Entity_Id;
-         Decl   : Node_Id;
-         Prag   : Node_Id;
-         Arg3   : Node_Id;
-         Wfunc  : Node_Id;
+         P_Type  : constant Entity_Id := Entity (Pref);
+         U_Type  : constant Entity_Id := Underlying_Type (P_Type);
+         Has_TSS : Boolean := False;
+         Pname   : Entity_Id;
+         Decl    : Node_Id;
+         Prag    : Node_Id;
+         Arg3    : Node_Id;
+         Wfunc   : Node_Id;
 
       begin
          --  If no underlying type, we have an error that will be diagnosed
@@ -5310,10 +5365,10 @@ package body Exp_Attr is
 
          --  If TSS for Output is present, just call it
 
-         Pname := Find_Stream_Subprogram (P_Type, TSS_Stream_Output);
+         Pname := Find_Stream_Subprogram (P_Type, TSS_Stream_Output, N);
 
          if Present (Pname) then
-            null;
+            Has_TSS := True;
 
          else
             --  If there is a Stream_Convert pragma, use it, we rewrite
@@ -5374,7 +5429,7 @@ package body Exp_Attr is
 
                if Present (Find_Inherited_TSS (P_Type, TSS_Stream_Write)) then
                   Build_Record_Or_Elementary_Output_Procedure
-                    (Loc, P_Type, Decl, Pname);
+                    (P_Type, Decl, Pname);
                   Insert_Action (N, Decl);
 
                --  For normal cases, we call the W_xxx routine directly
@@ -5388,7 +5443,7 @@ package body Exp_Attr is
             --  Array type case
 
             elsif Is_Array_Type (U_Type) then
-               Build_Array_Output_Procedure (Loc, U_Type, Decl, Pname);
+               Build_Array_Output_Procedure (U_Type, Decl, Pname);
                Compile_Stream_Body_In_Scope (N, Decl, U_Type);
 
             --  Class-wide case, first output external tag, then dispatch
@@ -5499,7 +5554,7 @@ package body Exp_Attr is
                end if;
 
                Build_Record_Or_Elementary_Output_Procedure
-                 (Loc, Base_Type (U_Type), Decl, Pname);
+                 (Base_Type (U_Type), Decl, Pname);
                Insert_Action (N, Decl);
             end if;
          end if;
@@ -5507,6 +5562,10 @@ package body Exp_Attr is
          --  If we fall through, Pname is the name of the procedure to call
 
          Rewrite_Attribute_Proc_Call (Pname);
+
+         if not Has_TSS then
+            Cached_Streaming_Ops.Output_Map.Set (P_Type, Pname);
+         end if;
       end Output;
 
       ---------
@@ -6171,16 +6230,17 @@ package body Exp_Attr is
       ----------
 
       when Attribute_Read => Read : declare
-         P_Type : constant Entity_Id := Entity (Pref);
-         B_Type : constant Entity_Id := Base_Type (P_Type);
-         U_Type : constant Entity_Id := Underlying_Type (P_Type);
-         Pname  : Entity_Id;
-         Decl   : Node_Id;
-         Prag   : Node_Id;
-         Arg2   : Node_Id;
-         Rfunc  : Node_Id;
-         Lhs    : Node_Id;
-         Rhs    : Node_Id;
+         P_Type  : constant Entity_Id := Entity (Pref);
+         B_Type  : constant Entity_Id := Base_Type (P_Type);
+         U_Type  : constant Entity_Id := Underlying_Type (P_Type);
+         Has_TSS : Boolean := False;
+         Pname   : Entity_Id;
+         Decl    : Node_Id;
+         Prag    : Node_Id;
+         Arg2    : Node_Id;
+         Rfunc   : Node_Id;
+         Lhs     : Node_Id;
+         Rhs     : Node_Id;
 
       begin
          --  If no underlying type, we have an error that will be diagnosed
@@ -6205,10 +6265,10 @@ package body Exp_Attr is
 
          --  The simple case, if there is a TSS for Read, just call it
 
-         Pname := Find_Stream_Subprogram (P_Type, TSS_Stream_Read);
+         Pname := Find_Stream_Subprogram (P_Type, TSS_Stream_Read, N);
 
          if Present (Pname) then
-            null;
+            Has_TSS := True;
 
          else
             --  If there is a Stream_Convert pragma, use it, we rewrite
@@ -6308,7 +6368,7 @@ package body Exp_Attr is
             --  Array type case
 
             elsif Is_Array_Type (U_Type) then
-               Build_Array_Read_Procedure (N, U_Type, Decl, Pname);
+               Build_Array_Read_Procedure (U_Type, Decl, Pname);
                Compile_Stream_Body_In_Scope (N, Decl, U_Type);
 
             --  Tagged type case, use the primitive Read function. Note that
@@ -6342,10 +6402,10 @@ package body Exp_Attr is
 
                if Has_Defaulted_Discriminants (U_Type) then
                   Build_Mutable_Record_Read_Procedure
-                    (Loc, Full_Base (U_Type), Decl, Pname);
+                    (Full_Base (U_Type), Decl, Pname);
                else
                   Build_Record_Read_Procedure
-                    (Loc, Full_Base (U_Type), Decl, Pname);
+                    (Full_Base (U_Type), Decl, Pname);
                end if;
 
                Insert_Action (N, Decl);
@@ -6353,6 +6413,10 @@ package body Exp_Attr is
          end if;
 
          Rewrite_Attribute_Proc_Call (Pname);
+
+         if not Has_TSS then
+            Cached_Streaming_Ops.Read_Map.Set (P_Type, Pname);
+         end if;
       end Read;
 
       ---------
@@ -7857,13 +7921,14 @@ package body Exp_Attr is
       -----------
 
       when Attribute_Write => Write : declare
-         P_Type : constant Entity_Id := Entity (Pref);
-         U_Type : constant Entity_Id := Underlying_Type (P_Type);
-         Pname  : Entity_Id;
-         Decl   : Node_Id;
-         Prag   : Node_Id;
-         Arg3   : Node_Id;
-         Wfunc  : Node_Id;
+         P_Type  : constant Entity_Id := Entity (Pref);
+         U_Type  : constant Entity_Id := Underlying_Type (P_Type);
+         Has_TSS : Boolean := False;
+         Pname   : Entity_Id;
+         Decl    : Node_Id;
+         Prag    : Node_Id;
+         Arg3    : Node_Id;
+         Wfunc   : Node_Id;
 
       begin
          --  If no underlying type, we have an error that will be diagnosed
@@ -7888,10 +7953,10 @@ package body Exp_Attr is
 
          --  The simple case, if there is a TSS for Write, just call it
 
-         Pname := Find_Stream_Subprogram (P_Type, TSS_Stream_Write);
+         Pname := Find_Stream_Subprogram (P_Type, TSS_Stream_Write, N);
 
          if Present (Pname) then
-            null;
+            Has_TSS := True;
 
          else
             --  If there is a Stream_Convert pragma, use it, we rewrite
@@ -7951,7 +8016,7 @@ package body Exp_Attr is
             --  Array type case
 
             elsif Is_Array_Type (U_Type) then
-               Build_Array_Write_Procedure (N, U_Type, Decl, Pname);
+               Build_Array_Write_Procedure (U_Type, Decl, Pname);
                Compile_Stream_Body_In_Scope (N, Decl, U_Type);
 
             --  Tagged type case, use the primitive Write function. Note that
@@ -7992,10 +8057,10 @@ package body Exp_Attr is
 
                if Has_Defaulted_Discriminants (U_Type) then
                   Build_Mutable_Record_Write_Procedure
-                    (Loc, Full_Base (U_Type), Decl, Pname);
+                    (Full_Base (U_Type), Decl, Pname);
                else
                   Build_Record_Write_Procedure
-                    (Loc, Full_Base (U_Type), Decl, Pname);
+                    (Full_Base (U_Type), Decl, Pname);
                end if;
 
                Insert_Action (N, Decl);
@@ -8005,6 +8070,10 @@ package body Exp_Attr is
          --  If we fall through, Pname is the procedure to be called
 
          Rewrite_Attribute_Proc_Call (Pname);
+
+         if not Has_TSS then
+            Cached_Streaming_Ops.Write_Map.Set (P_Type, Pname);
+         end if;
       end Write;
 
       --  The following attributes are handled by the back end (except that
@@ -8576,16 +8645,102 @@ package body Exp_Attr is
    ----------------------------
 
    function Find_Stream_Subprogram
-     (Typ : Entity_Id;
-      Nam : TSS_Name_Type) return Entity_Id
+     (Typ      : Entity_Id;
+      Nam      : TSS_Name_Type;
+      Attr_Ref : Node_Id) return Entity_Id
    is
+
+      function In_Available_Context (Ent : Entity_Id) return Boolean;
+      --  Ent is a candidate result for Find_Stream_Subprogram.
+      --  If, for example, a subprogram is declared within a case
+      --  alternative then Gigi does not want to see a call to it from
+      --  outside of the case alternative. Compare placement of Ent and
+      --  Attr_Ref to prevent this situation (by returning False).
+
+      --------------------------
+      -- In_Available_Context --
+      --------------------------
+
+      function In_Available_Context (Ent : Entity_Id) return Boolean is
+         Decl : Node_Id := Enclosing_Declaration (Ent);
+      begin
+         --  Enclosing_Declaration does not always return a declaration;
+         --  cope with this irregularity.
+         if Decl in N_Subprogram_Specification_Id
+           and then Nkind (Parent (Decl)) in
+                      N_Subprogram_Body | N_Subprogram_Declaration
+         then
+            Decl := Parent (Decl);
+         end if;
+
+         if Has_Declarations (Parent (Decl)) then
+            return In_Subtree (Attr_Ref, Root => Parent (Decl));
+         elsif Is_List_Member (Decl) then
+            declare
+               List_Elem : Node_Id := Next (Decl);
+            begin
+               while Present (List_Elem) loop
+                  if In_Subtree (Attr_Ref, Root => List_Elem) then
+                     return True;
+                  end if;
+                  Next (List_Elem);
+               end loop;
+               return False;
+            end;
+         else
+            return False; --  Can this occur ???
+         end if;
+      end In_Available_Context;
+
+      --  Local declarations
+
       Base_Typ : constant Entity_Id := Base_Type (Typ);
-      Ent      : constant Entity_Id := TSS (Typ, Nam);
+      Ent      : Entity_Id := TSS (Typ, Nam);
+
+   --  Start of processing for Find_Stream_Subprogram
+
    begin
       if Present (Ent) then
          return Ent;
       end if;
 
+      --  Everything after this point is an optimization. In other words,
+      --  there should be no *correctness* problems if we were to
+      --  unconditionally return Empty here.
+
+      if Is_Unchecked_Union (Base_Typ) then
+         --  Conservatively avoid possible problems (e.g., Write behaves
+         --  differently for a U_U type when called by Output vs. when
+         --  called from elsewhere).
+
+         return Empty;
+      end if;
+
+      if Nam = TSS_Stream_Read then
+         Ent := Cached_Streaming_Ops.Read_Map.Get (Typ);
+      elsif Nam = TSS_Stream_Write then
+         Ent := Cached_Streaming_Ops.Write_Map.Get (Typ);
+      elsif Nam = TSS_Stream_Input then
+         Ent := Cached_Streaming_Ops.Input_Map.Get (Typ);
+      elsif Nam = TSS_Stream_Output then
+         Ent := Cached_Streaming_Ops.Output_Map.Get (Typ);
+      end if;
+
+      if Present (Ent) then
+         --  Can't reuse Ent if it is no longer in scope
+
+         if In_Open_Scopes (Scope (Ent))
+
+           --  The preceding In_Open_Scopes test may not suffice if
+           --  case alternatives are involved.
+           and then In_Available_Context (Ent)
+         then
+            return Ent;
+         else
+            Ent := Empty;
+         end if;
+      end if;
+
       --  Stream attributes for strings are expanded into library calls. The
       --  following checks are disabled when the run-time is not available or
       --  when compiling predefined types due to bootstrap issues. As a result,
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index b992a587433..e23a3fde15c 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -12422,14 +12422,14 @@ package body Exp_Ch3 is
       if Stream_Operation_OK (Tag_Typ, TSS_Stream_Read)
         and then No (TSS (Tag_Typ, TSS_Stream_Read))
       then
-         Build_Record_Read_Procedure (Loc, Tag_Typ, Decl, Ent);
+         Build_Record_Read_Procedure (Tag_Typ, Decl, Ent);
          Append_To (Res, Decl);
       end if;
 
       if Stream_Operation_OK (Tag_Typ, TSS_Stream_Write)
         and then No (TSS (Tag_Typ, TSS_Stream_Write))
       then
-         Build_Record_Write_Procedure (Loc, Tag_Typ, Decl, Ent);
+         Build_Record_Write_Procedure (Tag_Typ, Decl, Ent);
          Append_To (Res, Decl);
       end if;
 
@@ -12441,14 +12441,14 @@ package body Exp_Ch3 is
         and then No (TSS (Tag_Typ, TSS_Stream_Input))
       then
          Build_Record_Or_Elementary_Input_Function
-           (Loc, Tag_Typ, Decl, Ent);
+           (Tag_Typ, Decl, Ent);
          Append_To (Res, Decl);
       end if;
 
       if Stream_Operation_OK (Tag_Typ, TSS_Stream_Output)
         and then No (TSS (Tag_Typ, TSS_Stream_Output))
       then
-         Build_Record_Or_Elementary_Output_Procedure (Loc, Tag_Typ, Decl, Ent);
+         Build_Record_Or_Elementary_Output_Procedure (Tag_Typ, Decl, Ent);
          Append_To (Res, Decl);
       end if;
 
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 7805f74e412..8f62bef2c64 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -3118,8 +3118,8 @@ package body Exp_Dist is
       --  Start of processing for Add_RACW_Read_Attribute
 
       begin
-         Build_Stream_Procedure (Loc,
-           RACW_Type, Body_Node, Pnam, Statements, Outp => True);
+         Build_Stream_Procedure
+           (RACW_Type, Body_Node, Pnam, Statements, Outp => True);
          Proc_Decl := Make_Subprogram_Declaration (Loc,
            Copy_Specification (Loc, Specification (Body_Node)));
 
@@ -3354,7 +3354,7 @@ package body Exp_Dist is
 
       begin
          Build_Stream_Procedure
-           (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => False);
+           (RACW_Type, Body_Node, Pnam, Statements, Outp => False);
 
          Proc_Decl := Make_Subprogram_Declaration (Loc,
            Copy_Specification (Loc, Specification (Body_Node)));
@@ -5800,7 +5800,7 @@ package body Exp_Dist is
 
       begin
          Build_Stream_Procedure
-           (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => True);
+           (RACW_Type, Body_Node, Pnam, Statements, Outp => True);
 
          Proc_Decl := Make_Subprogram_Declaration (Loc,
            Copy_Specification (Loc, Specification (Body_Node)));
@@ -6103,7 +6103,7 @@ package body Exp_Dist is
 
       begin
          Build_Stream_Procedure
-           (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => False);
+           (RACW_Type, Body_Node, Pnam, Statements, Outp => False);
 
          Proc_Decl :=
            Make_Subprogram_Declaration (Loc,
diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
index 2610584cef0..f1203ad9e97 100644
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -51,20 +51,17 @@ package body Exp_Strm is
    -----------------------
 
    procedure Build_Array_Read_Write_Procedure
-     (Nod  : Node_Id;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : Entity_Id;
       Nam  : Name_Id);
    --  Common routine shared to build either an array Read procedure or an
    --  array Write procedure, Nam is Name_Read or Name_Write to select which.
    --  Pnam is the defining identifier for the constructed procedure. The
-   --  other parameters are as for Build_Array_Read_Procedure except that
-   --  the first parameter Nod supplies the Sloc to be used to generate code.
+   --  other parameters are as for Build_Array_Read_Procedure.
 
    procedure Build_Record_Read_Write_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : Entity_Id;
       Nam  : Name_Id);
@@ -74,8 +71,7 @@ package body Exp_Strm is
    --  as for Build_Record_Read_Procedure.
 
    procedure Build_Stream_Function
-     (Loc   : Source_Ptr;
-      Typ   : Entity_Id;
+     (Typ   : Entity_Id;
       Decl  : out Node_Id;
       Fnam  : Entity_Id;
       Decls : List_Id;
@@ -140,11 +136,11 @@ package body Exp_Strm is
    --  reference, so the name must be unique.
 
    procedure Build_Array_Input_Function
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Fnam : out Entity_Id)
    is
+      Loc    : constant Source_Ptr := Sloc (Typ);
       Dim    : constant Pos := Number_Dimensions (Typ);
       Lnam   : Name_Id;
       Hnam   : Name_Id;
@@ -235,7 +231,7 @@ package body Exp_Strm is
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Input));
 
-      Build_Stream_Function (Loc, Typ, Decl, Fnam, Decls, Stms);
+      Build_Stream_Function (Typ, Decl, Fnam, Decls, Stms);
    end Build_Array_Input_Function;
 
    ----------------------------------
@@ -243,11 +239,11 @@ package body Exp_Strm is
    ----------------------------------
 
    procedure Build_Array_Output_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
+      Loc  : constant Source_Ptr := Sloc (Typ);
       Stms : List_Id;
       Indx : Node_Id;
 
@@ -301,7 +297,7 @@ package body Exp_Strm is
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Output));
 
-      Build_Stream_Procedure (Loc, Typ, Decl, Pnam, Stms, Outp => False);
+      Build_Stream_Procedure (Typ, Decl, Pnam, Stms, Outp => False);
    end Build_Array_Output_Procedure;
 
    --------------------------------
@@ -309,18 +305,17 @@ package body Exp_Strm is
    --------------------------------
 
    procedure Build_Array_Read_Procedure
-     (Nod  : Node_Id;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
-      Loc : constant Source_Ptr := Sloc (Nod);
+      Loc : constant Source_Ptr := Sloc (Typ);
 
    begin
       Pnam :=
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
-      Build_Array_Read_Write_Procedure (Nod, Typ, Decl, Pnam, Name_Read);
+      Build_Array_Read_Write_Procedure (Typ, Decl, Pnam, Name_Read);
    end Build_Array_Read_Procedure;
 
    --------------------------------------
@@ -345,13 +340,12 @@ package body Exp_Strm is
    --  The out keyword for V is supplied in the Read case
 
    procedure Build_Array_Read_Write_Procedure
-     (Nod  : Node_Id;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : Entity_Id;
       Nam  : Name_Id)
    is
-      Loc  : constant Source_Ptr := Sloc (Nod);
+      Loc  : constant Source_Ptr := Sloc (Typ);
       Ndim : constant Pos        := Number_Dimensions (Typ);
       Ctyp : constant Entity_Id  := Component_Type (Typ);
 
@@ -402,7 +396,7 @@ package body Exp_Strm is
 
       for J in 1 .. Ndim loop
          Stm :=
-           Make_Implicit_Loop_Statement (Nod,
+           Make_Implicit_Loop_Statement (Typ,
              Iteration_Scheme =>
                Make_Iteration_Scheme (Loc,
                  Loop_Parameter_Specification =>
@@ -424,7 +418,7 @@ package body Exp_Strm is
       end loop;
 
       Build_Stream_Procedure
-        (Loc, Typ, Decl, Pnam, New_List (Stm), Outp => Nam = Name_Read);
+        (Typ, Decl, Pnam, New_List (Stm), Outp => Nam = Name_Read);
    end Build_Array_Read_Write_Procedure;
 
    ---------------------------------
@@ -432,17 +426,16 @@ package body Exp_Strm is
    ---------------------------------
 
    procedure Build_Array_Write_Procedure
-     (Nod  : Node_Id;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
-      Loc : constant Source_Ptr := Sloc (Nod);
+      Loc : constant Source_Ptr := Sloc (Typ);
    begin
       Pnam :=
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Write));
-      Build_Array_Read_Write_Procedure (Nod, Typ, Decl, Pnam, Name_Write);
+      Build_Array_Read_Write_Procedure (Typ, Decl, Pnam, Name_Write);
    end Build_Array_Write_Procedure;
 
    ---------------------------------
@@ -894,11 +887,12 @@ package body Exp_Strm is
    -----------------------------------------
 
    procedure Build_Mutable_Record_Read_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
+      Loc  : constant Source_Ptr := Sloc (Typ);
+
       Out_Formal : Node_Id;
       --  Expression denoting the out formal parameter
 
@@ -951,7 +945,7 @@ package body Exp_Strm is
            Make_Raise_Program_Error (Loc,
              Reason => PE_Unchecked_Union_Restriction));
 
-         Build_Stream_Procedure (Loc, Typ, Decl, Pnam, Stms, Outp => True);
+         Build_Stream_Procedure (Typ, Decl, Pnam, Stms, Outp => True);
          return;
       end if;
 
@@ -1007,7 +1001,7 @@ package body Exp_Strm is
       --  Generate reads for the components of the record (including those
       --  that depend on discriminants).
 
-      Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read);
+      Build_Record_Read_Write_Procedure (Typ, Decl, Pnam, Name_Read);
 
       --  Save original statement sequence for component assignments, and
       --  replace it with Stms.
@@ -1066,11 +1060,11 @@ package body Exp_Strm is
    ------------------------------------------
 
    procedure Build_Mutable_Record_Write_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
+      Loc   : constant Source_Ptr := Sloc (Typ);
       Stms  : List_Id;
       Disc  : Entity_Id;
       D_Ref : Node_Id;
@@ -1111,7 +1105,7 @@ package body Exp_Strm is
       Pnam :=
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Write));
-      Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Write);
+      Build_Record_Read_Write_Procedure (Typ, Decl, Pnam, Name_Write);
 
       --  Write the discriminants before the rest of the components, so
       --  that discriminant values are properly set of variants, etc.
@@ -1152,11 +1146,11 @@ package body Exp_Strm is
    --  an elementary type, then no Cn constants are defined.
 
    procedure Build_Record_Or_Elementary_Input_Function
-     (Loc            : Source_Ptr;
-      Typ            : Entity_Id;
+     (Typ            : Entity_Id;
       Decl           : out Node_Id;
       Fnam           : out Entity_Id)
    is
+      Loc        : constant Source_Ptr := Sloc (Typ);
       B_Typ      : constant Entity_Id := Underlying_Type (Base_Type (Typ));
       Cn         : Name_Id;
       Constr     : List_Id;
@@ -1288,7 +1282,7 @@ package body Exp_Strm is
 
       Fnam := Make_Stream_Subprogram_Name (Loc, B_Typ, TSS_Stream_Input);
 
-      Build_Stream_Function (Loc, B_Typ, Decl, Fnam, Decls, Stms);
+      Build_Stream_Function (B_Typ, Decl, Fnam, Decls, Stms);
    end Build_Record_Or_Elementary_Input_Function;
 
    -------------------------------------------------
@@ -1296,11 +1290,11 @@ package body Exp_Strm is
    -------------------------------------------------
 
    procedure Build_Record_Or_Elementary_Output_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
+      Loc      : constant Source_Ptr := Sloc (Typ);
       Stms     : List_Id;
       Disc     : Entity_Id;
       Disc_Ref : Node_Id;
@@ -1356,7 +1350,7 @@ package body Exp_Strm is
 
       Pnam := Make_Stream_Subprogram_Name (Loc, Typ, TSS_Stream_Output);
 
-      Build_Stream_Procedure (Loc, Typ, Decl, Pnam, Stms, Outp => False);
+      Build_Stream_Procedure (Typ, Decl, Pnam, Stms, Outp => False);
    end Build_Record_Or_Elementary_Output_Procedure;
 
    ---------------------------------
@@ -1364,14 +1358,14 @@ package body Exp_Strm is
    ---------------------------------
 
    procedure Build_Record_Read_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
+      Loc : constant Source_Ptr := Sloc (Typ);
    begin
       Pnam := Make_Stream_Subprogram_Name (Loc, Typ, TSS_Stream_Read);
-      Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read);
+      Build_Record_Read_Write_Procedure (Typ, Decl, Pnam, Name_Read);
    end Build_Record_Read_Procedure;
 
    ---------------------------------------
@@ -1407,12 +1401,12 @@ package body Exp_Strm is
    --  The out keyword for V is supplied in the Read case
 
    procedure Build_Record_Read_Write_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : Entity_Id;
       Nam  : Name_Id)
    is
+      Loc  : constant Source_Ptr := Sloc (Typ);
       Rdef : Node_Id;
       Stms : List_Id;
       Typt : Entity_Id;
@@ -1616,7 +1610,7 @@ package body Exp_Strm is
       end if;
 
       Build_Stream_Procedure
-        (Loc, Typ, Decl, Pnam, Stms, Outp => Nam = Name_Read);
+        (Typ, Decl, Pnam, Stms, Outp => Nam = Name_Read);
    end Build_Record_Read_Write_Procedure;
 
    ----------------------------------
@@ -1624,14 +1618,14 @@ package body Exp_Strm is
    ----------------------------------
 
    procedure Build_Record_Write_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
+      Loc : constant Source_Ptr := Sloc (Typ);
    begin
       Pnam := Make_Stream_Subprogram_Name (Loc, Typ, TSS_Stream_Write);
-      Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Write);
+      Build_Record_Read_Write_Procedure (Typ, Decl, Pnam, Name_Write);
    end Build_Record_Write_Procedure;
 
    -------------------------------
@@ -1674,13 +1668,13 @@ package body Exp_Strm is
    ---------------------------
 
    procedure Build_Stream_Function
-     (Loc   : Source_Ptr;
-      Typ   : Entity_Id;
+     (Typ   : Entity_Id;
       Decl  : out Node_Id;
       Fnam  : Entity_Id;
       Decls : List_Id;
       Stms  : List_Id)
    is
+      Loc  : constant Source_Ptr := Sloc (Typ);
       Spec : Node_Id;
 
    begin
@@ -1719,13 +1713,13 @@ package body Exp_Strm is
    ----------------------------
 
    procedure Build_Stream_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : Entity_Id;
       Stms : List_Id;
       Outp : Boolean)
    is
+      Loc  : constant Source_Ptr := Sloc (Typ);
       Spec : Node_Id;
 
    begin
diff --git a/gcc/ada/exp_strm.ads b/gcc/ada/exp_strm.ads
index e0d180aacbc..d56a5985989 100644
--- a/gcc/ada/exp_strm.ads
+++ b/gcc/ada/exp_strm.ads
@@ -57,38 +57,31 @@ package Exp_Strm is
    --  results are the declaration and name (entity) of the subprogram.
 
    procedure Build_Array_Input_Function
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Fnam : out Entity_Id);
    --  Build function for Input attribute for array type
 
    procedure Build_Array_Output_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
    --  Build procedure for Output attribute for array type
 
    procedure Build_Array_Read_Procedure
-     (Nod  : Node_Id;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
-   --  Build procedure for Read attribute for array type. Nod provides the
-   --  Sloc value for generated code.
+   --  Build procedure for Read attribute for array type.
 
    procedure Build_Array_Write_Procedure
-     (Nod  : Node_Id;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
-   --  Build procedure for Write attribute for array type. Nod provides the
-   --  Sloc value for generated code.
+   --  Build procedure for Write attribute for array type.
 
    procedure Build_Mutable_Record_Read_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
    --  Build procedure to Read a record with default discriminants.
@@ -96,8 +89,7 @@ package Exp_Strm is
    --  same manner as is done for 'Input.
 
    procedure Build_Mutable_Record_Write_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
    --  Build procedure to write a record with default discriminants.
@@ -105,8 +97,7 @@ package Exp_Strm is
    --  the same manner as is done for 'Output.
 
    procedure Build_Record_Or_Elementary_Input_Function
-     (Loc            : Source_Ptr;
-      Typ            : Entity_Id;
+     (Typ            : Entity_Id;
       Decl           : out Node_Id;
       Fnam           : out Entity_Id);
    --  Build function for Input attribute for record type or for an elementary
@@ -115,8 +106,7 @@ package Exp_Strm is
    --  runtime library routine directly).
 
    procedure Build_Record_Or_Elementary_Output_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
    --  Build procedure for Output attribute for record type or for an
@@ -125,22 +115,19 @@ package Exp_Strm is
    --  Output calls the appropriate runtime library routine directly.
 
    procedure Build_Record_Read_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
    --  Build procedure for Read attribute for record type
 
    procedure Build_Record_Write_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : out Entity_Id);
    --  Build procedure for Write attribute for record type
 
    procedure Build_Stream_Procedure
-     (Loc  : Source_Ptr;
-      Typ  : Entity_Id;
+     (Typ  : Entity_Id;
       Decl : out Node_Id;
       Pnam : Entity_Id;
       Stms : List_Id;
