[Ada] Add support for XDR streaming in the default runtime

2020-06-18  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* Makefile.rtl: Add s-statxd.o.
	* bindgen.adb (Gen_Adainit): Add support for XDR_Stream.
	* bindusg.adb (Display): Add mention of -xdr.
	* gnatbind.adb: Process -xdr switch.
	* init.c (__gl_xdr_stream): New.
	* opt.ads (XDR_Stream): New.
	* libgnat/s-stratt__xdr.adb: Rename to...
	* libgnat/s-statxd.adb: this and adjust.
	* libgnat/s-statxd.ads: New.
	* libgnat/s-stratt.ads, libgnat/s-stratt.adb: Choose between
	default and XDR implementation at runtime.
	* libgnat/s-ststop.ads: Update comments.
	* doc/gnat_rm/implementation_advice.rst: Update doc on XDR
	streaming.
	* gnat_rm.texi: Regenerate.

13 files changed, 428 insertions, 167 deletions

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 2092c17..92af017 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -707,6 +707,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-stopoo$(objext) \
   s-stposu$(objext) \
   s-stratt$(objext) \
+  s-statxd$(objext) \
   s-strhas$(objext) \
   s-string$(objext) \
   s-ststop$(objext) \
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 99ad300..91b4cb3 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -197,6 +197,7 @@ package body Bindgen is
    --     Main_CPU                      : Integer;
    --     Default_Sized_SS_Pool         : System.Address;
    --     Binder_Sec_Stacks_Count       : Natural;
+   --     XDR_Stream                    : Integer;
 
    --  Main_Priority is the priority value set by pragma Priority in the main
    --  program. If no such pragma is present, the value is -1.
@@ -295,6 +296,9 @@ package body Bindgen is
    --  Binder_Sec_Stacks_Count is the number of generated secondary stacks in
    --  the Default_Sized_SS_Pool.
 
+   --  XDR_Stream indicates whether streaming should be performed using the
+   --  XDR protocol. A value of one indicates that XDR streaming is enabled.
+
    procedure WBI (Info : String) renames Osint.B.Write_Binder_Info;
    --  Convenient shorthand used throughout
 
@@ -758,13 +762,21 @@ package body Bindgen is
                  """__gnat_default_ss_size"");");
          end if;
 
-         WBI ("      Leap_Seconds_Support : Integer;");
-         WBI ("      pragma Import (C, Leap_Seconds_Support, " &
-              """__gl_leap_seconds_support"");");
+         if Leap_Seconds_Support then
+            WBI ("      Leap_Seconds_Support : Integer;");
+            WBI ("      pragma Import (C, Leap_Seconds_Support, " &
+                 """__gl_leap_seconds_support"");");
+         end if;
+
          WBI ("      Bind_Env_Addr : System.Address;");
          WBI ("      pragma Import (C, Bind_Env_Addr, " &
               """__gl_bind_env_addr"");");
 
+         if XDR_Stream then
+            WBI ("      XDR_Stream : Integer;");
+            WBI ("      pragma Import (C, XDR_Stream, ""__gl_xdr_stream"");");
+         end if;
+
          --  Import entry point for elaboration time signal handler
          --  installation, and indication of if it's been called previously.
 
@@ -978,16 +990,13 @@ package body Bindgen is
          Set_String (";");
          Write_Statement_Buffer;
 
-         Set_String ("      Leap_Seconds_Support := ");
-
          if Leap_Seconds_Support then
-            Set_Int (1);
-         else
-            Set_Int (0);
+            WBI ("      Leap_Seconds_Support := 1;");
          end if;
 
-         Set_String (";");
-         Write_Statement_Buffer;
+         if XDR_Stream then
+            WBI ("      XDR_Stream := 1;");
+         end if;
 
          if Bind_Env_String_Built then
             WBI ("      Bind_Env_Addr := Bind_Env'Address;");
diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb
index 45215d2..6fd55ee 100644
--- a/gcc/ada/bindusg.adb
+++ b/gcc/ada/bindusg.adb
@@ -315,6 +315,11 @@ package body Bindusg is
       Write_Line
         ("  -x        Exclude source files (check object consistency only)");
 
+      --  Line for -xdr switch
+
+      Write_Line
+        ("  -xdr      Use the XDR protocol for streaming");
+
       --  Line for -X switch
 
       Write_Line
diff --git a/gcc/ada/doc/gnat_rm/implementation_advice.rst b/gcc/ada/doc/gnat_rm/implementation_advice.rst
index 31376d9..998d0c5 100644
--- a/gcc/ada/doc/gnat_rm/implementation_advice.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_advice.rst
@@ -712,43 +712,20 @@ RM 13.13.2(1.6): Stream Oriented Attributes
   to the nearest factor or multiple of the word size that is also a
   multiple of the stream element size."
 
-Followed, except that the number of stream elements is a power of 2.
+Followed, except that the number of stream elements is 1, 2, 3, 4 or 8.
 The Stream_Size may be used to override the default choice.
 
-However, such an implementation is based on direct binary
-representations and is therefore target- and endianness-dependent.  To
-address this issue, GNAT also supplies an alternate implementation of
-the stream attributes ``Read`` and ``Write``, which uses the
-target-independent XDR standard representation for scalar types.
+The default implementation is based on direct binary representations and is
+therefore target- and endianness-dependent.  To address this issue, GNAT also
+supplies an alternate implementation of the stream attributes ``Read`` and
+``Write``, which uses the target-independent XDR standard representation for
+scalar types. This XDR alternative can be enabled via the binder switch -xdr.
 
 .. index:: XDR representation
-
 .. index:: Read attribute
-
 .. index:: Write attribute
-
 .. index:: Stream oriented attributes
 
-The XDR implementation is provided as an alternative body of the
-``System.Stream_Attributes`` package, in the file
-:file:`s-stratt-xdr.adb` in the GNAT library.
-There is no :file:`s-stratt-xdr.ads` file.
-In order to install the XDR implementation, do the following:
-
-* Replace the default implementation of the
-  ``System.Stream_Attributes`` package with the XDR implementation.
-  For example on a Unix platform issue the commands:
-
-  .. code-block:: sh
-
-    $ mv s-stratt.adb s-stratt-default.adb
-    $ mv s-stratt-xdr.adb s-stratt.adb
-
-
-*
-  Rebuild the GNAT run-time library as documented in
-  the *GNAT and Libraries* section of the :title:`GNAT User's Guide`.
-
 RM A.1(52): Names of Predefined Numeric Types
 =============================================
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index c174073..d72f905 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -14445,14 +14445,14 @@ to the nearest factor or multiple of the word size that is also a
 multiple of the stream element size."
 @end quotation
 
-Followed, except that the number of stream elements is a power of 2.
+Followed, except that the number of stream elements is 1, 2, 3, 4 or 8.
 The Stream_Size may be used to override the default choice.
 
-However, such an implementation is based on direct binary
-representations and is therefore target- and endianness-dependent.  To
-address this issue, GNAT also supplies an alternate implementation of
-the stream attributes @code{Read} and @code{Write}, which uses the
-target-independent XDR standard representation for scalar types.
+The default implementation is based on direct binary representations and is
+therefore target- and endianness-dependent.  To address this issue, GNAT also
+supplies an alternate implementation of the stream attributes @code{Read} and
+@code{Write}, which uses the target-independent XDR standard representation for
+scalar types. This XDR alternative can be enabled via the binder switch -xdr.
 
 @geindex XDR representation
 
@@ -14462,30 +14462,6 @@ target-independent XDR standard representation for scalar types.
 
 @geindex Stream oriented attributes
 
-The XDR implementation is provided as an alternative body of the
-@code{System.Stream_Attributes} package, in the file
-@code{s-stratt-xdr.adb} in the GNAT library.
-There is no @code{s-stratt-xdr.ads} file.
-In order to install the XDR implementation, do the following:
-
-
-@itemize *
-
-@item 
-Replace the default implementation of the
-@code{System.Stream_Attributes} package with the XDR implementation.
-For example on a Unix platform issue the commands:
-
-@example
-$ mv s-stratt.adb s-stratt-default.adb
-$ mv s-stratt-xdr.adb s-stratt.adb
-@end example
-
-@item 
-Rebuild the GNAT run-time library as documented in
-the @emph{GNAT and Libraries} section of the @cite{GNAT User's Guide}.
-@end itemize
-
 @node RM A 1 52 Names of Predefined Numeric Types,RM A 3 2 49 Ada Characters Handling,RM 13 13 2 1 6 Stream Oriented Attributes,Implementation Advice
 @anchor{gnat_rm/implementation_advice rm-a-1-52-names-of-predefined-numeric-types}@anchor{236}
 @section RM A.1(52): Names of Predefined Numeric Types
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index 4907082..4372152 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -499,6 +499,11 @@ procedure Gnatbind is
             Opt.Bind_Alternate_Main_Name := True;
             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 
+         --  -xdr
+
+         elsif Argv (2 .. Argv'Last) = "xdr" then
+            Opt.XDR_Stream := True;
+
          --  All other options are single character and are handled by
          --  Scan_Binder_Switches.
 
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index f9f627e..e76aa79 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -122,6 +122,7 @@ int   __gl_default_stack_size            = -1;
 int   __gl_leap_seconds_support          = 0;
 int   __gl_canonical_streams             = 0;
 char *__gl_bind_env_addr                 = NULL;
+int   __gl_xdr_stream                    = 0;
 
 /* This value is not used anymore, but kept for bootstrapping purpose.  */
 int   __gl_zero_cost_exceptions          = 0;
diff --git a/gcc/ada/libgnat/s-stratt__xdr.adb b/gcc/ada/libgnat/s-statxd.adb
index 7e32fcf..fcefae7 100644
--- a/gcc/ada/libgnat/s-stratt__xdr.adb
+++ b/gcc/ada/libgnat/s-statxd.adb
@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT RUN-TIME COMPONENTS                         --
 --                                                                          --
---             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
+--          S Y S T E M . S T R E A M _ A T T R I B U T E S . X D R         --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
@@ -29,20 +29,11 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This file is an alternate version of s-stratt.adb based on the XDR
---  standard. It is especially useful for exchanging streams between two
---  different systems with different basic type representations and endianness.
-
-pragma Warnings (Off, "*not allowed in compiler unit");
---  This body is used only when rebuilding the runtime library, not when
---  building the compiler, so it's OK to depend on features that would
---  otherwise break bootstrap (e.g. IF-expressions).
-
 with Ada.IO_Exceptions;
 with Ada.Streams;              use Ada.Streams;
 with Ada.Unchecked_Conversion;
 
-package body System.Stream_Attributes is
+package body System.Stream_Attributes.XDR is
 
    pragma Suppress (Range_Check);
    pragma Suppress (Overflow_Check);
@@ -68,19 +59,16 @@ package body System.Stream_Attributes is
    subtype SEA is Ada.Streams.Stream_Element_Array;
    subtype SEO is Ada.Streams.Stream_Element_Offset;
 
-   generic function UC renames Ada.Unchecked_Conversion;
-
-   type Field_Type is
-      record
-         E_Size       : Integer; --  Exponent bit size
-         E_Bias       : Integer; --  Exponent bias
-         F_Size       : Integer; --  Fraction bit size
-         E_Last       : Integer; --  Max exponent value
-         F_Mask       : SE;      --  Mask to apply on first fraction byte
-         E_Bytes      : SEO;     --  N. of exponent bytes completely used
-         F_Bytes      : SEO;     --  N. of fraction bytes completely used
-         F_Bits       : Integer; --  N. of bits used on first fraction word
-      end record;
+   type Field_Type is record
+      E_Size       : Integer; --  Exponent bit size
+      E_Bias       : Integer; --  Exponent bias
+      F_Size       : Integer; --  Fraction bit size
+      E_Last       : Integer; --  Max exponent value
+      F_Mask       : SE;      --  Mask to apply on first fraction byte
+      E_Bytes      : SEO;     --  N. of exponent bytes completely used
+      F_Bytes      : SEO;     --  N. of fraction bytes completely used
+      F_Bits       : Integer; --  N. of bits used on first fraction word
+   end record;
 
    type Precision is (Single, Double, Quadruple);
 
@@ -255,8 +243,8 @@ package body System.Stream_Attributes is
    type XDR_TM is mod BB ** TM_L;
 
    type XDR_SA is mod 2 ** Standard'Address_Size;
-   function To_XDR_SA is new UC (System.Address, XDR_SA);
-   function To_XDR_SA is new UC (XDR_SA, System.Address);
+   function To_XDR_SA is new Ada.Unchecked_Conversion (System.Address, XDR_SA);
+   function To_XDR_SA is new Ada.Unchecked_Conversion (XDR_SA, System.Address);
 
    --  Enumerations have the same representation as signed integers.
    --  Enumerations are handy for describing subsets of the integers.
@@ -299,19 +287,6 @@ package body System.Stream_Attributes is
    Optimize_Integers : constant Boolean :=
      Default_Bit_Order = High_Order_First;
 
-   -----------------
-   -- Block_IO_OK --
-   -----------------
-
-   --  We must inhibit Block_IO, because in XDR mode, each element is output
-   --  according to XDR requirements, which is not at all the same as writing
-   --  the whole array in one block.
-
-   function Block_IO_OK return Boolean is
-   begin
-      return False;
-   end Block_IO_OK;
-
    ----------
    -- I_AD --
    ----------
@@ -1485,7 +1460,7 @@ package body System.Stream_Attributes is
 
    procedure W_LI (Stream : not null access RST; Item : Long_Integer) is
       S : XDR_S_LI;
-      U : Unsigned;
+      U : Unsigned := 0;
       X : Long_Unsigned;
 
    begin
@@ -1629,7 +1604,7 @@ package body System.Stream_Attributes is
       Item   : Long_Long_Integer)
    is
       S : XDR_S_LLI;
-      U : Unsigned;
+      U : Unsigned := 0;
       X : Long_Long_Unsigned;
 
    begin
@@ -1677,7 +1652,7 @@ package body System.Stream_Attributes is
       Item   : Long_Long_Unsigned)
    is
       S : XDR_S_LLU;
-      U : Unsigned;
+      U : Unsigned := 0;
       X : Long_Long_Unsigned := Item;
 
    begin
@@ -1714,7 +1689,7 @@ package body System.Stream_Attributes is
 
    procedure W_LU (Stream : not null access RST; Item : Long_Unsigned) is
       S : XDR_S_LU;
-      U : Unsigned;
+      U : Unsigned := 0;
       X : Long_Unsigned := Item;
 
    begin
@@ -2032,4 +2007,4 @@ package body System.Stream_Attributes is
       end if;
    end W_WWC;
 
-end System.Stream_Attributes;
+end System.Stream_Attributes.XDR;
diff --git a/gcc/ada/libgnat/s-statxd.ads b/gcc/ada/libgnat/s-statxd.ads
new file mode 100644
index 0000000..cca5e54
--- /dev/null
+++ b/gcc/ada/libgnat/s-statxd.ads
@@ -0,0 +1,117 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--          S Y S T E M . S T R E A M _ A T T R I B U T E S . X D R         --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 1992-2020, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains alternate implementations of the stream attributes
+--  for elementary types based on the XDR standard. These are the subprograms
+--  that are directly accessed by occurrences of the stream attributes where
+--  the type is elementary.
+
+--  It is especially useful for exchanging streams between two different
+--  systems with different basic type representations and endianness.
+
+--  We only provide the subprograms for the standard base types. For user
+--  defined types, the subprogram for the corresponding root type is called
+--  with an appropriate conversion.
+
+package System.Stream_Attributes.XDR is
+   pragma Preelaborate;
+
+   pragma Suppress (Accessibility_Check, XDR);
+   --  No need to check accessibility on arguments of subprograms
+
+   ---------------------
+   -- Input Functions --
+   ---------------------
+
+   --  Functions for S'Input attribute. These functions are also used for
+   --  S'Read, with the obvious transformation, since the input operation
+   --  is the same for all elementary types (no bounds or discriminants
+   --  are involved).
+
+   function I_AD  (Stream : not null access RST) return Fat_Pointer;
+   function I_AS  (Stream : not null access RST) return Thin_Pointer;
+   function I_B   (Stream : not null access RST) return Boolean;
+   function I_C   (Stream : not null access RST) return Character;
+   function I_F   (Stream : not null access RST) return Float;
+   function I_I   (Stream : not null access RST) return Integer;
+   function I_I24 (Stream : not null access RST) return Integer_24;
+   function I_LF  (Stream : not null access RST) return Long_Float;
+   function I_LI  (Stream : not null access RST) return Long_Integer;
+   function I_LLF (Stream : not null access RST) return Long_Long_Float;
+   function I_LLI (Stream : not null access RST) return Long_Long_Integer;
+   function I_LLU (Stream : not null access RST) return UST.Long_Long_Unsigned;
+   function I_LU  (Stream : not null access RST) return UST.Long_Unsigned;
+   function I_SF  (Stream : not null access RST) return Short_Float;
+   function I_SI  (Stream : not null access RST) return Short_Integer;
+   function I_SSI (Stream : not null access RST) return Short_Short_Integer;
+   function I_SSU (Stream : not null access RST) return
+                                                   UST.Short_Short_Unsigned;
+   function I_SU  (Stream : not null access RST) return UST.Short_Unsigned;
+   function I_U   (Stream : not null access RST) return UST.Unsigned;
+   function I_U24 (Stream : not null access RST) return Unsigned_24;
+   function I_WC  (Stream : not null access RST) return Wide_Character;
+   function I_WWC (Stream : not null access RST) return Wide_Wide_Character;
+
+   -----------------------
+   -- Output Procedures --
+   -----------------------
+
+   --  Procedures for S'Write attribute. These procedures are also used for
+   --  'Output, since for elementary types there is no difference between
+   --  'Write and 'Output because there are no discriminants or bounds to
+   --  be written.
+
+   procedure W_AD  (Stream : not null access RST; Item : Fat_Pointer);
+   procedure W_AS  (Stream : not null access RST; Item : Thin_Pointer);
+   procedure W_B   (Stream : not null access RST; Item : Boolean);
+   procedure W_C   (Stream : not null access RST; Item : Character);
+   procedure W_F   (Stream : not null access RST; Item : Float);
+   procedure W_I   (Stream : not null access RST; Item : Integer);
+   procedure W_I24 (Stream : not null access RST; Item : Integer_24);
+   procedure W_LF  (Stream : not null access RST; Item : Long_Float);
+   procedure W_LI  (Stream : not null access RST; Item : Long_Integer);
+   procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float);
+   procedure W_LLI (Stream : not null access RST; Item : Long_Long_Integer);
+   procedure W_LLU (Stream : not null access RST; Item :
+                                                    UST.Long_Long_Unsigned);
+   procedure W_LU  (Stream : not null access RST; Item : UST.Long_Unsigned);
+   procedure W_SF  (Stream : not null access RST; Item : Short_Float);
+   procedure W_SI  (Stream : not null access RST; Item : Short_Integer);
+   procedure W_SSI (Stream : not null access RST; Item : Short_Short_Integer);
+   procedure W_SSU (Stream : not null access RST; Item :
+                                                    UST.Short_Short_Unsigned);
+   procedure W_SU  (Stream : not null access RST; Item : UST.Short_Unsigned);
+   procedure W_U   (Stream : not null access RST; Item : UST.Unsigned);
+   procedure W_U24 (Stream : not null access RST; Item : Unsigned_24);
+   procedure W_WC  (Stream : not null access RST; Item : Wide_Character);
+   procedure W_WWC (Stream : not null access RST; Item : Wide_Wide_Character);
+
+end System.Stream_Attributes.XDR;
diff --git a/gcc/ada/libgnat/s-stratt.adb b/gcc/ada/libgnat/s-stratt.adb
index 64f3f04..366dabd 100644
--- a/gcc/ada/libgnat/s-stratt.adb
+++ b/gcc/ada/libgnat/s-stratt.adb
@@ -32,9 +32,20 @@
 with Ada.IO_Exceptions;
 with Ada.Streams; use Ada.Streams;
 with Ada.Unchecked_Conversion;
+with System.Stream_Attributes.XDR;
 
 package body System.Stream_Attributes is
 
+   XDR_Flag : Integer;
+   pragma Import (C, XDR_Flag, "__gl_xdr_stream");
+   --  This imported value is used to determine whether the build had the
+   --  binder switch "-xdr" present which enables XDR streaming and sets this
+   --  flag to 1.
+
+   function XDR_Support return Boolean;
+   pragma Inline (XDR_Support);
+   --  Return True if XDR streaming should be used
+
    Err : exception renames Ada.IO_Exceptions.End_Error;
    --  Exception raised if insufficient data read (note that the RM implies
    --  that Data_Error might be the appropriate choice, but AI95-00132
@@ -123,12 +134,21 @@ package body System.Stream_Attributes is
    function To_WWC is new UC (S_WWC, Wide_Wide_Character);
 
    -----------------
+   -- XDR_Support --
+   -----------------
+
+   function XDR_Support return Boolean is
+   begin
+      return XDR_Flag = 1;
+   end XDR_Support;
+
+   -----------------
    -- Block_IO_OK --
    -----------------
 
    function Block_IO_OK return Boolean is
    begin
-      return True;
+      return not XDR_Support;
    end Block_IO_OK;
 
    ----------
@@ -140,6 +160,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_AD (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -158,6 +182,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_AS (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -176,6 +204,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_B (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -194,6 +226,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_C (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -212,6 +248,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_F (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -230,6 +270,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_I (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -248,6 +292,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_I24 (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -266,6 +314,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_LF (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -284,6 +336,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_LI (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -302,6 +358,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_LLF (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -320,6 +380,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_LLI (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -340,6 +404,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_LLU (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -358,6 +426,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_LU (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -376,6 +448,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_SF (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -394,6 +470,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_SI (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -412,6 +492,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_SSI (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -432,6 +516,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_SSU (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -450,6 +538,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_SU (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -468,6 +560,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_U (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -486,6 +582,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_U24 (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -504,6 +604,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_WC (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -522,6 +626,10 @@ package body System.Stream_Attributes is
       L : SEO;
 
    begin
+      if XDR_Support then
+         return XDR.I_WWC (Stream);
+      end if;
+
       Ada.Streams.Read (Stream.all, T, L);
 
       if L < T'Last then
@@ -538,6 +646,11 @@ package body System.Stream_Attributes is
    procedure W_AD (Stream : not null access RST; Item : Fat_Pointer) is
       T : constant S_AD := From_AD (Item);
    begin
+      if XDR_Support then
+         XDR.W_AD (Stream, Item);
+         return;
+      end if;
+
       Ada.Streams.Write (Stream.all, T);
    end W_AD;
 
@@ -548,6 +661,11 @@ package body System.Stream_Attributes is
    procedure W_AS (Stream : not null access RST; Item : Thin_Pointer) is
       T : constant S_AS := From_AS (Item);
    begin
+      if XDR_Support then
+         XDR.W_AS (Stream, Item);
+         return;
+      end if;
+
       Ada.Streams.Write (Stream.all, T);
    end W_AS;
 
@@ -558,6 +676,11 @@ package body System.Stream_Attributes is
    procedure W_B (Stream : not null access RST; Item : Boolean) is
       T : S_B;
    begin
+      if XDR_Support then
+         XDR.W_B (Stream, Item);
+         return;
+      end if;
+
       T (1) := Boolean'Pos (Item);
       Ada.Streams.Write (Stream.all, T);
    end W_B;
@@ -569,6 +692,11 @@ package body System.Stream_Attributes is
    procedure W_C (Stream : not null access RST; Item : Character) is
       T : S_C;
    begin
+      if XDR_Support then
+         XDR.W_C (Stream, Item);
+         return;
+      end if;
+
       T (1) := Character'Pos (Item);
       Ada.Streams.Write (Stream.all, T);
    end W_C;
@@ -578,9 +706,13 @@ package body System.Stream_Attributes is
    ---------
 
    procedure W_F (Stream : not null access RST; Item : Float) is
-      T : constant S_F := From_F (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_F (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_F (Item));
    end W_F;
 
    ---------
@@ -588,9 +720,13 @@ package body System.Stream_Attributes is
    ---------
 
    procedure W_I (Stream : not null access RST; Item : Integer) is
-      T : constant S_I := From_I (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_I (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_I (Item));
    end W_I;
 
    -----------
@@ -598,9 +734,13 @@ package body System.Stream_Attributes is
    -----------
 
    procedure W_I24 (Stream : not null access RST; Item : Integer_24) is
-      T : constant S_I24 := From_I24 (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_I24 (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_I24 (Item));
    end W_I24;
 
    ----------
@@ -608,9 +748,13 @@ package body System.Stream_Attributes is
    ----------
 
    procedure W_LF (Stream : not null access RST; Item : Long_Float) is
-      T : constant S_LF := From_LF (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_LF (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LF (Item));
    end W_LF;
 
    ----------
@@ -618,9 +762,13 @@ package body System.Stream_Attributes is
    ----------
 
    procedure W_LI (Stream : not null access RST; Item : Long_Integer) is
-      T : constant S_LI := From_LI (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_LI (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LI (Item));
    end W_LI;
 
    -----------
@@ -628,21 +776,27 @@ package body System.Stream_Attributes is
    -----------
 
    procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float) is
-      T : constant S_LLF := From_LLF (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_LLF (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LLF (Item));
    end W_LLF;
 
    -----------
    -- W_LLI --
    -----------
 
-   procedure W_LLI
-     (Stream : not null access RST; Item : Long_Long_Integer)
-   is
-      T : constant S_LLI := From_LLI (Item);
+   procedure W_LLI (Stream : not null access RST; Item : Long_Long_Integer) is
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_LLI (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LLI (Item));
    end W_LLI;
 
    -----------
@@ -652,21 +806,27 @@ package body System.Stream_Attributes is
    procedure W_LLU
      (Stream : not null access RST; Item : UST.Long_Long_Unsigned)
    is
-      T : constant S_LLU := From_LLU (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_LLU (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LLU (Item));
    end W_LLU;
 
    ----------
    -- W_LU --
    ----------
 
-   procedure W_LU
-     (Stream : not null access RST; Item : UST.Long_Unsigned)
-   is
-      T : constant S_LU := From_LU (Item);
+   procedure W_LU (Stream : not null access RST; Item : UST.Long_Unsigned) is
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_LU (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LU (Item));
    end W_LU;
 
    ----------
@@ -674,9 +834,13 @@ package body System.Stream_Attributes is
    ----------
 
    procedure W_SF (Stream : not null access RST; Item : Short_Float) is
-      T : constant S_SF := From_SF (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_SF (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_SF (Item));
    end W_SF;
 
    ----------
@@ -684,9 +848,13 @@ package body System.Stream_Attributes is
    ----------
 
    procedure W_SI (Stream : not null access RST; Item : Short_Integer) is
-      T : constant S_SI := From_SI (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_SI (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_SI (Item));
    end W_SI;
 
    -----------
@@ -696,9 +864,13 @@ package body System.Stream_Attributes is
    procedure W_SSI
      (Stream : not null access RST; Item : Short_Short_Integer)
    is
-      T : constant S_SSI := From_SSI (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_SSI (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_SSI (Item));
    end W_SSI;
 
    -----------
@@ -708,21 +880,27 @@ package body System.Stream_Attributes is
    procedure W_SSU
      (Stream : not null access RST; Item : UST.Short_Short_Unsigned)
    is
-      T : constant S_SSU := From_SSU (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_SSU (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_SSU (Item));
    end W_SSU;
 
    ----------
    -- W_SU --
    ----------
 
-   procedure W_SU
-     (Stream : not null access RST; Item : UST.Short_Unsigned)
-   is
-      T : constant S_SU := From_SU (Item);
+   procedure W_SU (Stream : not null access RST; Item : UST.Short_Unsigned) is
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_SU (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_SU (Item));
    end W_SU;
 
    ---------
@@ -730,9 +908,13 @@ package body System.Stream_Attributes is
    ---------
 
    procedure W_U (Stream : not null access RST; Item : UST.Unsigned) is
-      T : constant S_U := From_U (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_U (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_U (Item));
    end W_U;
 
    -----------
@@ -740,9 +922,13 @@ package body System.Stream_Attributes is
    -----------
 
    procedure W_U24 (Stream : not null access RST; Item : Unsigned_24) is
-      T : constant S_U24 := From_U24 (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_U24 (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_U24 (Item));
    end W_U24;
 
    ----------
@@ -750,9 +936,13 @@ package body System.Stream_Attributes is
    ----------
 
    procedure W_WC (Stream : not null access RST; Item : Wide_Character) is
-      T : constant S_WC := From_WC (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_WC (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_WC (Item));
    end W_WC;
 
    -----------
@@ -762,9 +952,13 @@ package body System.Stream_Attributes is
    procedure W_WWC
      (Stream : not null access RST; Item : Wide_Wide_Character)
    is
-      T : constant S_WWC := From_WWC (Item);
    begin
-      Ada.Streams.Write (Stream.all, T);
+      if XDR_Support then
+         XDR.W_WWC (Stream, Item);
+         return;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_WWC (Item));
    end W_WWC;
 
 end System.Stream_Attributes;
diff --git a/gcc/ada/libgnat/s-stratt.ads b/gcc/ada/libgnat/s-stratt.ads
index 7336949..c8c453a 100644
--- a/gcc/ada/libgnat/s-stratt.ads
+++ b/gcc/ada/libgnat/s-stratt.ads
@@ -163,11 +163,8 @@ package System.Stream_Attributes is
    procedure W_WWC (Stream : not null access RST; Item : Wide_Wide_Character);
 
    function Block_IO_OK return Boolean;
-   --  Package System.Stream_Attributes has several bodies - the default one
-   --  distributed with GNAT, and s-stratt__xdr.adb, which is based on the XDR
-   --  standard. Both bodies share the same spec. The role of this function is
-   --  to indicate whether the current version of System.Stream_Attributes
-   --  supports block IO. See System.Strings.Stream_Ops (s-ststop) for details.
+   --  Indicate whether the current setting supports block IO. See
+   --  System.Strings.Stream_Ops (s-ststop) for details on block IO.
 
 private
    pragma Inline (I_AD);
diff --git a/gcc/ada/libgnat/s-ststop.ads b/gcc/ada/libgnat/s-ststop.ads
index d0da060..321460b 100644
--- a/gcc/ada/libgnat/s-ststop.ads
+++ b/gcc/ada/libgnat/s-ststop.ads
@@ -60,8 +60,8 @@
 --  Note that if System.Stream_Attributes.Block_IO_OK is False, then the BLK_IO
 --  form is treated as equivalent to the normal case, so that the optimization
 --  is inhibited anyway, regardless of the setting of the restriction. This
---  handles versions of System.Stream_Attributes (in particular the XDR version
---  found in s-stratt-xdr) which do not permit block io optimization.
+--  handles the XDR implementation of System.Stream_Attributes in particular
+--  which does not permit block io optimization.
 
 pragma Compiler_Unit_Warning;
 
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 9e0263b..37f3d03 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -915,7 +915,7 @@ package Opt is
    Leap_Seconds_Support : Boolean := False;
    --  GNATBIND
    --  Set to True to enable leap seconds support in Ada.Calendar and its
-   --  children.
+   --  children. Set by -y.
 
    Legacy_Elaboration_Checks : Boolean := False;
    --  GNAT
@@ -1007,6 +1007,10 @@ package Opt is
    --  before preprocessing occurs. Set to True by switch -s of gnatprep or
    --  -s in preprocessing data file for the compiler.
 
+   XDR_Stream : Boolean := False;
+   --  GNATBIND
+   --  Set to True to enable XDR in s-stratt.adb. Set by -xdr.
+
    type Create_Repinfo_File_Proc is access procedure (Src  : String);
    type Write_Repinfo_Line_Proc  is access procedure (Info : String);
    type Close_Repinfo_File_Proc  is access procedure;