public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/autopar_devel] [Ada] Add support for XDR streaming in the default runtime
@ 2020-08-22 22:48 Giuliano Belinassi
0 siblings, 0 replies; 2+ messages in thread
From: Giuliano Belinassi @ 2020-08-22 22:48 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:e2b1a82c07ebc03a3cbaa9b4854bf21de559a053
commit e2b1a82c07ebc03a3cbaa9b4854bf21de559a053
Author: Arnaud Charlet <charlet@adacore.com>
Date: Thu Apr 23 05:46:29 2020 -0400
[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.
Diff:
---
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 +
.../libgnat/{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(-)
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 --
+-- <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 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;
^ permalink raw reply [flat|nested] 2+ messages in thread
* [gcc/devel/autopar_devel] [Ada] Add support for XDR streaming in the default runtime
@ 2020-08-22 23:21 Giuliano Belinassi
0 siblings, 0 replies; 2+ messages in thread
From: Giuliano Belinassi @ 2020-08-22 23:21 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:743693db844283352474cc5861e0b2fd1e3d84ee
commit 743693db844283352474cc5861e0b2fd1e3d84ee
Author: Arnaud Charlet <charlet@adacore.com>
Date: Tue May 12 16:35:12 2020 +0200
[Ada] Add support for XDR streaming in the default runtime
gcc/ada/
* Makefile.rtl: Remove dead code.
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Document gnatbind -xdr switch.
* gnat_ugn.texi: Regenerate.
Diff:
---
gcc/ada/Makefile.rtl | 5 +----
gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst | 8 ++++++++
gcc/ada/gnat_ugn.texi | 8 ++++++++
3 files changed, 17 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 92af01733df..1f6ea017b97 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -2704,10 +2704,7 @@ setup-rts: force
$(RM) $(foreach PAIR,$(LIBGNAT_TARGET_PAIRS), \
$(RTSDIR)/$(word 1,$(subst <, ,$(PAIR))))
for f in $(RTSDIR)/*-*__*.ads $(RTSDIR)/*-*__*.adb; do \
- case "$$f" in \
- $(RTSDIR)/s-stratt__*) ;; \
- *) $(RM) $$f ;; \
- esac; \
+ $(RM) $$f ; \
done
# Copy new target dependent sources
$(foreach PAIR,$(LIBGNAT_TARGET_PAIRS), \
diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index 1fd59d77fe2..1d44d70e45c 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -6711,6 +6711,14 @@ be presented in subsequent sections.
Exclude source files (check object consistency only).
+ .. index:: -xdr (gnatbind)
+
+:switch:`-xdr`
+ Use the target-independent XDR protocol for stream oriented attributes
+ instead of the default implementation which is based on direct binary
+ representations and is therefore target-and endianness-dependent.
+
+
.. index:: -Xnnn (gnatbind)
:switch:`-X{nnn}`
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index b2f022e2c04..fc49da1b2ba 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -16142,6 +16142,14 @@ Override default wide character encoding for standard Text_IO files.
Exclude source files (check object consistency only).
+@geindex -xdr (gnatbind)
+
+@item @code{-xdr}
+
+Use the target-independent XDR protocol for stream oriented attributes
+instead of the default implementation which is based on direct binary
+representations and is therefore target-and endianness-dependent.
+
@geindex -Xnnn (gnatbind)
@item @code{-X@emph{nnn}}
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2020-08-22 23:21 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-22 22:48 [gcc/devel/autopar_devel] [Ada] Add support for XDR streaming in the default runtime Giuliano Belinassi
2020-08-22 23:21 Giuliano Belinassi
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).