s-stopoo$(objext) \
s-stposu$(objext) \
s-stratt$(objext) \
+ s-statxd$(objext) \
s-strhas$(objext) \
s-string$(objext) \
s-ststop$(objext) \
-- 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.
-- 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
"""__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.
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;");
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
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
=============================================
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
@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
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.
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;
-- --
-- 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 --
-- --
-- --
------------------------------------------------------------------------------
--- 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);
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);
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.
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 --
----------
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
Item : Long_Long_Integer)
is
S : XDR_S_LLI;
- U : Unsigned;
+ U : Unsigned := 0;
X : Long_Long_Unsigned;
begin
Item : Long_Long_Unsigned)
is
S : XDR_S_LLU;
- U : Unsigned;
+ U : Unsigned := 0;
X : Long_Long_Unsigned := Item;
begin
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
end if;
end W_WWC;
-end System.Stream_Attributes;
+end System.Stream_Attributes.XDR;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
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
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;
----------
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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;
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;
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;
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;
---------
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;
---------
---------
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;
-----------
-----------
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;
----------
----------
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;
----------
----------
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;
-----------
-----------
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;
-----------
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;
----------
----------
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;
----------
----------
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;
-----------
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;
-----------
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;
---------
---------
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;
-----------
-----------
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;
----------
----------
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;
-----------
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;
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);
-- 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;
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
-- 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;