From 8cd7aec26f11d3d317e0e59e3dbe04b96b7052e4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 23 Apr 2020 05:46:29 -0400 Subject: [PATCH] [Ada] Add support for XDR streaming in the default runtime 2020-06-18 Arnaud Charlet 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. --- gcc/ada/Makefile.rtl | 1 + gcc/ada/bindgen.adb | 29 +- gcc/ada/bindusg.adb | 5 + gcc/ada/doc/gnat_rm/implementation_advice.rst | 35 +-- gcc/ada/gnat_rm.texi | 36 +-- gcc/ada/gnatbind.adb | 5 + gcc/ada/init.c | 1 + .../{s-stratt__xdr.adb => s-statxd.adb} | 63 ++-- gcc/ada/libgnat/s-statxd.ads | 117 +++++++ gcc/ada/libgnat/s-stratt.adb | 286 +++++++++++++++--- gcc/ada/libgnat/s-stratt.ads | 7 +- gcc/ada/libgnat/s-ststop.ads | 4 +- gcc/ada/opt.ads | 6 +- 13 files changed, 428 insertions(+), 167 deletions(-) rename gcc/ada/libgnat/{s-stratt__xdr.adb => s-statxd.adb} (96%) create mode 100644 gcc/ada/libgnat/s-statxd.ads diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 2092c1773c9..92af01733df 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 99ad3009d13..91b4cb38486 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 45215d2ebea..6fd55ee8721 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 31376d92461..998d0c597df 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 c174073d508..d72f905a2df 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 4907082a42c..4372152b439 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 f9f627ebcff..e76aa79c5a8 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 similarity index 96% rename from gcc/ada/libgnat/s-stratt__xdr.adb rename to gcc/ada/libgnat/s-statxd.adb index 7e32fcf9b91..fcefae7e6f2 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 00000000000..cca5e5471bd --- /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 -- +-- . -- +-- -- +-- 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 64f3f040081..366dabdc7b6 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 @@ -122,13 +133,22 @@ package body System.Stream_Attributes is function To_WC is new UC (S_WC, Wide_Character); 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 73369490146..c8c453aad2a 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 d0da0609d9d..321460b89d8 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 9e0263b431d..37f3d030e3f 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; -- 2.30.2