diff mbox series

[Ada] Add stream-oriented attributes support for 128-bit integer types

Message ID 20201130141711.GA117790@adacore.com
State New
Headers show
Series [Ada] Add stream-oriented attributes support for 128-bit integer types | expand

Commit Message

Pierre-Marie de Rodat Nov. 30, 2020, 2:17 p.m. UTC
This was overlooked in the original implementation of these types.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* doc/gnat_ugn/building_executable_programs_with_gnat.rst (-xdr):
	Document that XDR is not supported for 128-bit integer types.
	* gnat_ugn.texi: Regenerate.
	* exp_strm.adb (Build_Elementary_Input_Call): Deal with types
	larger than Long_Long_Integer.
	(Build_Elementary_Write_Call): Likewise.
	* rtsfind.ads (RE_Id): Add RE_I_LLL{I,U] and RE_W_LLL{I,U}.
	(RE_Unit_Table): Add entries for them.
	* libgnat/s-stratt.ads (I_LLLI): New inline function.
	(I_LLLU): Likewise.
	(W_LLLI): New inline procedure.
	(W_LLLU): Likewise.
	* libgnat/s-stratt.adb (S_LLLI): New subtype of SEA.
	(S_LLLU): Likewise.
	(From_LLLI): New instance of Unchecked_Conversion.
	(From_LLLU): Likewise.
	(To_LLLI): Likewise.
	(To_LLLU): Likewise.
	(I_LLLI): Implement.
	(I_LLLU): Likewise.
	(W_LLLI): Likewise.
	(W_LLLU): Likewise.
diff mbox series

Patch

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
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -6704,6 +6704,9 @@  be presented in subsequent sections.
   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.
+  However it does not support 128-bit integer types and the exception
+  ``Ada.IO_Exceptions.Device_Error`` is raised if any attempt is made
+  at streaming 128-bit integer types with it.
 
 
   .. index:: -Xnnn  (gnatbind)


diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -578,8 +578,11 @@  package body Exp_Strm is
          elsif P_Size <= Standard_Long_Integer_Size then
             Lib_RE := RE_I_LI;
 
-         else
+         elsif P_Size <= Standard_Long_Long_Integer_Size then
             Lib_RE := RE_I_LLI;
+
+         else
+            Lib_RE := RE_I_LLLI;
          end if;
 
       --  Unsigned integer types, also includes unsigned fixed-point types
@@ -609,8 +612,11 @@  package body Exp_Strm is
          elsif P_Size <= Standard_Long_Integer_Size then
             Lib_RE := RE_I_LU;
 
-         else
+         elsif P_Size <= Standard_Long_Long_Integer_Size then
             Lib_RE := RE_I_LLU;
+
+         else
+            Lib_RE := RE_I_LLLU;
          end if;
 
       else pragma Assert (Is_Access_Type (U_Type));
@@ -802,16 +808,24 @@  package body Exp_Strm is
       then
          if P_Size <= Standard_Short_Short_Integer_Size then
             Lib_RE := RE_W_SSI;
+
          elsif P_Size <= Standard_Short_Integer_Size then
             Lib_RE := RE_W_SI;
+
          elsif P_Size = 24 then
             Lib_RE := RE_W_I24;
+
          elsif P_Size <= Standard_Integer_Size then
             Lib_RE := RE_W_I;
+
          elsif P_Size <= Standard_Long_Integer_Size then
             Lib_RE := RE_W_LI;
-         else
+
+         elsif P_Size <= Standard_Long_Long_Integer_Size then
             Lib_RE := RE_W_LLI;
+
+         else
+            Lib_RE := RE_W_LLLI;
          end if;
 
       --  Unsigned integer types, also includes unsigned fixed-point types
@@ -828,16 +842,24 @@  package body Exp_Strm is
       then
          if P_Size <= Standard_Short_Short_Integer_Size then
             Lib_RE := RE_W_SSU;
+
          elsif P_Size <= Standard_Short_Integer_Size then
             Lib_RE := RE_W_SU;
+
          elsif P_Size = 24 then
             Lib_RE := RE_W_U24;
+
          elsif P_Size <= Standard_Integer_Size then
             Lib_RE := RE_W_U;
+
          elsif P_Size <= Standard_Long_Integer_Size then
             Lib_RE := RE_W_LU;
-         else
+
+         elsif P_Size <= Standard_Long_Long_Integer_Size then
             Lib_RE := RE_W_LLU;
+
+         else
+            Lib_RE := RE_W_LLLU;
          end if;
 
       else pragma Assert (Is_Access_Type (U_Type));


diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -21,7 +21,7 @@ 
 
 @copying
 @quotation
-GNAT User's Guide for Native Platforms , Nov 19, 2020
+GNAT User's Guide for Native Platforms , Nov 20, 2020
 
 AdaCore
 
@@ -15919,6 +15919,9 @@  Exclude source files (check object consistency only).
 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.
+However it does not support 128-bit integer types and the exception
+@code{Ada.IO_Exceptions.Device_Error} is raised if any attempt is made
+at streaming 128-bit integer types with it.
 
 @geindex -Xnnn (gnatbind)
 


diff --git a/gcc/ada/libgnat/s-stratt.adb b/gcc/ada/libgnat/s-stratt.adb
--- a/gcc/ada/libgnat/s-stratt.adb
+++ b/gcc/ada/libgnat/s-stratt.adb
@@ -44,7 +44,8 @@  package body System.Stream_Attributes is
 
    function XDR_Support return Boolean;
    pragma Inline (XDR_Support);
-   --  Return True if XDR streaming should be used
+   --  Return True if XDR streaming should be used. Note that 128-bit integers
+   --  are not supported by the XDR protocol and will raise Device_Error.
 
    Err : exception renames Ada.IO_Exceptions.End_Error;
    --  Exception raised if insufficient data read (note that the RM implies
@@ -64,74 +65,81 @@  package body System.Stream_Attributes is
    Thin_Pointer_Size : constant := System.Address'Size;
    Fat_Pointer_Size  : constant := System.Address'Size * 2;
 
-   subtype S_AD  is SEA (1 .. (Fat_Pointer_Size              + SU - 1) / SU);
-   subtype S_AS  is SEA (1 .. (Thin_Pointer_Size             + SU - 1) / SU);
-   subtype S_B   is SEA (1 .. (Boolean'Size                  + SU - 1) / SU);
-   subtype S_C   is SEA (1 .. (Character'Size                + SU - 1) / SU);
-   subtype S_F   is SEA (1 .. (Float'Size                    + SU - 1) / SU);
-   subtype S_I   is SEA (1 .. (Integer'Size                  + SU - 1) / SU);
-   subtype S_I24 is SEA (1 .. (Integer_24'Size               + SU - 1) / SU);
-   subtype S_LF  is SEA (1 .. (Long_Float'Size               + SU - 1) / SU);
-   subtype S_LI  is SEA (1 .. (Long_Integer'Size             + SU - 1) / SU);
-   subtype S_LLF is SEA (1 .. (Long_Long_Float'Size          + SU - 1) / SU);
-   subtype S_LLI is SEA (1 .. (Long_Long_Integer'Size        + SU - 1) / SU);
-   subtype S_LLU is SEA (1 .. (UST.Long_Long_Unsigned'Size   + SU - 1) / SU);
-   subtype S_LU  is SEA (1 .. (UST.Long_Unsigned'Size        + SU - 1) / SU);
-   subtype S_SF  is SEA (1 .. (Short_Float'Size              + SU - 1) / SU);
-   subtype S_SI  is SEA (1 .. (Short_Integer'Size            + SU - 1) / SU);
-   subtype S_SSI is SEA (1 .. (Short_Short_Integer'Size      + SU - 1) / SU);
-   subtype S_SSU is SEA (1 .. (UST.Short_Short_Unsigned'Size + SU - 1) / SU);
-   subtype S_SU  is SEA (1 .. (UST.Short_Unsigned'Size       + SU - 1) / SU);
-   subtype S_U   is SEA (1 .. (UST.Unsigned'Size             + SU - 1) / SU);
-   subtype S_U24 is SEA (1 .. (Unsigned_24'Size              + SU - 1) / SU);
-   subtype S_WC  is SEA (1 .. (Wide_Character'Size           + SU - 1) / SU);
-   subtype S_WWC is SEA (1 .. (Wide_Wide_Character'Size      + SU - 1) / SU);
+   subtype S_AD   is SEA (1 .. (Fat_Pointer_Size              + SU - 1) / SU);
+   subtype S_AS   is SEA (1 .. (Thin_Pointer_Size             + SU - 1) / SU);
+   subtype S_B    is SEA (1 .. (Boolean'Size                  + SU - 1) / SU);
+   subtype S_C    is SEA (1 .. (Character'Size                + SU - 1) / SU);
+   subtype S_F    is SEA (1 .. (Float'Size                    + SU - 1) / SU);
+   subtype S_I    is SEA (1 .. (Integer'Size                  + SU - 1) / SU);
+   subtype S_I24  is SEA (1 .. (Integer_24'Size               + SU - 1) / SU);
+   subtype S_LF   is SEA (1 .. (Long_Float'Size               + SU - 1) / SU);
+   subtype S_LI   is SEA (1 .. (Long_Integer'Size             + SU - 1) / SU);
+   subtype S_LLF  is SEA (1 .. (Long_Long_Float'Size          + SU - 1) / SU);
+   subtype S_LLI  is SEA (1 .. (Long_Long_Integer'Size        + SU - 1) / SU);
+   subtype S_LLLI is SEA (1 .. (Long_Long_Long_Integer'Size   + SU - 1) / SU);
+   subtype S_LLLU is
+                  SEA (1 .. (UST.Long_Long_Long_Unsigned'Size + SU - 1) / SU);
+   subtype S_LLU  is SEA (1 .. (UST.Long_Long_Unsigned'Size   + SU - 1) / SU);
+   subtype S_LU   is SEA (1 .. (UST.Long_Unsigned'Size        + SU - 1) / SU);
+   subtype S_SF   is SEA (1 .. (Short_Float'Size              + SU - 1) / SU);
+   subtype S_SI   is SEA (1 .. (Short_Integer'Size            + SU - 1) / SU);
+   subtype S_SSI  is SEA (1 .. (Short_Short_Integer'Size      + SU - 1) / SU);
+   subtype S_SSU  is SEA (1 .. (UST.Short_Short_Unsigned'Size + SU - 1) / SU);
+   subtype S_SU   is SEA (1 .. (UST.Short_Unsigned'Size       + SU - 1) / SU);
+   subtype S_U    is SEA (1 .. (UST.Unsigned'Size             + SU - 1) / SU);
+   subtype S_U24  is SEA (1 .. (Unsigned_24'Size              + SU - 1) / SU);
+   subtype S_WC   is SEA (1 .. (Wide_Character'Size           + SU - 1) / SU);
+   subtype S_WWC  is SEA (1 .. (Wide_Wide_Character'Size      + SU - 1) / SU);
 
    --  Unchecked conversions from the elementary type to the stream type
 
-   function From_AD  is new UC (Fat_Pointer,              S_AD);
-   function From_AS  is new UC (Thin_Pointer,             S_AS);
-   function From_F   is new UC (Float,                    S_F);
-   function From_I   is new UC (Integer,                  S_I);
-   function From_I24 is new UC (Integer_24,               S_I24);
-   function From_LF  is new UC (Long_Float,               S_LF);
-   function From_LI  is new UC (Long_Integer,             S_LI);
-   function From_LLF is new UC (Long_Long_Float,          S_LLF);
-   function From_LLI is new UC (Long_Long_Integer,        S_LLI);
-   function From_LLU is new UC (UST.Long_Long_Unsigned,   S_LLU);
-   function From_LU  is new UC (UST.Long_Unsigned,        S_LU);
-   function From_SF  is new UC (Short_Float,              S_SF);
-   function From_SI  is new UC (Short_Integer,            S_SI);
-   function From_SSI is new UC (Short_Short_Integer,      S_SSI);
-   function From_SSU is new UC (UST.Short_Short_Unsigned, S_SSU);
-   function From_SU  is new UC (UST.Short_Unsigned,       S_SU);
-   function From_U   is new UC (UST.Unsigned,             S_U);
-   function From_U24 is new UC (Unsigned_24,              S_U24);
-   function From_WC  is new UC (Wide_Character,           S_WC);
-   function From_WWC is new UC (Wide_Wide_Character,      S_WWC);
+   function From_AD   is new UC (Fat_Pointer,                 S_AD);
+   function From_AS   is new UC (Thin_Pointer,                S_AS);
+   function From_F    is new UC (Float,                       S_F);
+   function From_I    is new UC (Integer,                     S_I);
+   function From_I24  is new UC (Integer_24,                  S_I24);
+   function From_LF   is new UC (Long_Float,                  S_LF);
+   function From_LI   is new UC (Long_Integer,                S_LI);
+   function From_LLF  is new UC (Long_Long_Float,             S_LLF);
+   function From_LLI  is new UC (Long_Long_Integer,           S_LLI);
+   function From_LLLI is new UC (Long_Long_Long_Integer,      S_LLLI);
+   function From_LLLU is new UC (UST.Long_Long_Long_Unsigned, S_LLLU);
+   function From_LLU  is new UC (UST.Long_Long_Unsigned,      S_LLU);
+   function From_LU   is new UC (UST.Long_Unsigned,           S_LU);
+   function From_SF   is new UC (Short_Float,                 S_SF);
+   function From_SI   is new UC (Short_Integer,               S_SI);
+   function From_SSI  is new UC (Short_Short_Integer,         S_SSI);
+   function From_SSU  is new UC (UST.Short_Short_Unsigned,    S_SSU);
+   function From_SU   is new UC (UST.Short_Unsigned,          S_SU);
+   function From_U    is new UC (UST.Unsigned,                S_U);
+   function From_U24  is new UC (Unsigned_24,                 S_U24);
+   function From_WC   is new UC (Wide_Character,              S_WC);
+   function From_WWC  is new UC (Wide_Wide_Character,         S_WWC);
 
    --  Unchecked conversions from the stream type to elementary type
 
-   function To_AD  is new UC (S_AD,  Fat_Pointer);
-   function To_AS  is new UC (S_AS,  Thin_Pointer);
-   function To_F   is new UC (S_F,   Float);
-   function To_I   is new UC (S_I,   Integer);
-   function To_I24 is new UC (S_I24, Integer_24);
-   function To_LF  is new UC (S_LF,  Long_Float);
-   function To_LI  is new UC (S_LI,  Long_Integer);
-   function To_LLF is new UC (S_LLF, Long_Long_Float);
-   function To_LLI is new UC (S_LLI, Long_Long_Integer);
-   function To_LLU is new UC (S_LLU, UST.Long_Long_Unsigned);
-   function To_LU  is new UC (S_LU,  UST.Long_Unsigned);
-   function To_SF  is new UC (S_SF,  Short_Float);
-   function To_SI  is new UC (S_SI,  Short_Integer);
-   function To_SSI is new UC (S_SSI, Short_Short_Integer);
-   function To_SSU is new UC (S_SSU, UST.Short_Short_Unsigned);
-   function To_SU  is new UC (S_SU,  UST.Short_Unsigned);
-   function To_U   is new UC (S_U,   UST.Unsigned);
-   function To_U24 is new UC (S_U24, Unsigned_24);
-   function To_WC  is new UC (S_WC,  Wide_Character);
-   function To_WWC is new UC (S_WWC, Wide_Wide_Character);
+   function To_AD   is new UC (S_AD,   Fat_Pointer);
+   function To_AS   is new UC (S_AS,   Thin_Pointer);
+   function To_F    is new UC (S_F,    Float);
+   function To_I    is new UC (S_I,    Integer);
+   function To_I24  is new UC (S_I24,  Integer_24);
+   function To_LF   is new UC (S_LF,   Long_Float);
+   function To_LI   is new UC (S_LI,   Long_Integer);
+   function To_LLF  is new UC (S_LLF,  Long_Long_Float);
+   function To_LLI  is new UC (S_LLI,  Long_Long_Integer);
+   function To_LLLI is new UC (S_LLLI, Long_Long_Long_Integer);
+   function To_LLLU is new UC (S_LLLU, UST.Long_Long_Long_Unsigned);
+   function To_LLU  is new UC (S_LLU,  UST.Long_Long_Unsigned);
+   function To_LU   is new UC (S_LU,   UST.Long_Unsigned);
+   function To_SF   is new UC (S_SF,   Short_Float);
+   function To_SI   is new UC (S_SI,   Short_Integer);
+   function To_SSI  is new UC (S_SSI,  Short_Short_Integer);
+   function To_SSU  is new UC (S_SSU,  UST.Short_Short_Unsigned);
+   function To_SU   is new UC (S_SU,   UST.Short_Unsigned);
+   function To_U    is new UC (S_U,    UST.Unsigned);
+   function To_U24  is new UC (S_U24,  Unsigned_24);
+   function To_WC   is new UC (S_WC,   Wide_Character);
+   function To_WWC  is new UC (S_WWC,  Wide_Wide_Character);
 
    -----------------
    -- XDR_Support --
@@ -393,6 +401,53 @@  package body System.Stream_Attributes is
       end if;
    end I_LLI;
 
+   ------------
+   -- I_LLLI --
+   ------------
+
+   function I_LLLI (Stream : not null access RST) return Long_Long_Long_Integer
+   is
+      T : S_LLLI;
+      L : SEO;
+
+   begin
+      if XDR_Support then
+         raise Ada.IO_Exceptions.Device_Error;
+      end if;
+
+      Ada.Streams.Read (Stream.all, T, L);
+
+      if L < T'Last then
+         raise Err;
+      else
+         return To_LLLI (T);
+      end if;
+   end I_LLLI;
+
+   ------------
+   -- I_LLLU --
+   ------------
+
+   function I_LLLU
+     (Stream : not null access RST) return UST.Long_Long_Long_Unsigned
+   is
+      T : S_LLLU;
+      L : SEO;
+
+   begin
+      if XDR_Support then
+         raise Ada.IO_Exceptions.Device_Error;
+      end if;
+
+      Ada.Streams.Read (Stream.all, T, L);
+
+      if L < T'Last then
+         raise Err;
+      else
+         return To_LLLU (T);
+      end if;
+   end I_LLLU;
+
    -----------
    -- I_LLU --
    -----------
@@ -799,6 +854,35 @@  package body System.Stream_Attributes is
       Ada.Streams.Write (Stream.all, From_LLI (Item));
    end W_LLI;
 
+   ------------
+   -- W_LLLI --
+   ------------
+
+   procedure W_LLLI
+     (Stream : not null access RST; Item : Long_Long_Long_Integer) is
+   begin
+      if XDR_Support then
+         raise Ada.IO_Exceptions.Device_Error;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LLLI (Item));
+   end W_LLLI;
+
+   ------------
+   -- W_LLLU --
+   ------------
+
+   procedure W_LLLU
+     (Stream : not null access RST; Item : UST.Long_Long_Long_Unsigned)
+   is
+   begin
+      if XDR_Support then
+         raise Ada.IO_Exceptions.Device_Error;
+      end if;
+
+      Ada.Streams.Write (Stream.all, From_LLLU (Item));
+   end W_LLLU;
+
    -----------
    -- W_LLU --
    -----------


diff --git a/gcc/ada/libgnat/s-stratt.ads b/gcc/ada/libgnat/s-stratt.ads
--- a/gcc/ada/libgnat/s-stratt.ads
+++ b/gcc/ada/libgnat/s-stratt.ads
@@ -104,29 +104,34 @@  package System.Stream_Attributes is
    --  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;
+   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_LLLI (Stream : not null access RST) return
+                                                    Long_Long_Long_Integer;
+   function I_LLLU (Stream : not null access RST) return
+                                                   UST.Long_Long_Long_Unsigned;
+   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 --
@@ -137,30 +142,34 @@  package System.Stream_Attributes is
    --  '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);
+   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_LLLI (Stream : not null access RST; Item :
+                                                     Long_Long_Long_Integer);
+   procedure W_LLLU (Stream : not null access RST; Item :
+                                                  UST.Long_Long_Long_Unsigned);
+   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);
 
    function Block_IO_OK return Boolean;
    --  Indicate whether the current setting supports block IO. See
@@ -177,6 +186,8 @@  private
    pragma Inline (I_LI);
    pragma Inline (I_LLF);
    pragma Inline (I_LLI);
+   pragma Inline (I_LLLI);
+   pragma Inline (I_LLLU);
    pragma Inline (I_LLU);
    pragma Inline (I_LU);
    pragma Inline (I_SF);
@@ -198,6 +209,8 @@  private
    pragma Inline (W_LI);
    pragma Inline (W_LLF);
    pragma Inline (W_LLI);
+   pragma Inline (W_LLLI);
+   pragma Inline (W_LLLU);
    pragma Inline (W_LLU);
    pragma Inline (W_LU);
    pragma Inline (W_SF);


diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -1869,6 +1869,8 @@  package Rtsfind is
      RE_I_LI,                            -- System.Stream_Attributes
      RE_I_LLF,                           -- System.Stream_Attributes
      RE_I_LLI,                           -- System.Stream_Attributes
+     RE_I_LLLI,                          -- System.Stream_Attributes
+     RE_I_LLLU,                          -- System.Stream_Attributes
      RE_I_LLU,                           -- System.Stream_Attributes
      RE_I_LU,                            -- System.Stream_Attributes
      RE_I_SF,                            -- System.Stream_Attributes
@@ -1892,6 +1894,8 @@  package Rtsfind is
      RE_W_LI,                            -- System.Stream_Attributes
      RE_W_LLF,                           -- System.Stream_Attributes
      RE_W_LLI,                           -- System.Stream_Attributes
+     RE_W_LLLI,                          -- System.Stream_Attributes
+     RE_W_LLLU,                          -- System.Stream_Attributes
      RE_W_LLU,                           -- System.Stream_Attributes
      RE_W_LU,                            -- System.Stream_Attributes
      RE_W_SF,                            -- System.Stream_Attributes
@@ -3550,6 +3554,8 @@  package Rtsfind is
      RE_I_LI                             => System_Stream_Attributes,
      RE_I_LLF                            => System_Stream_Attributes,
      RE_I_LLI                            => System_Stream_Attributes,
+     RE_I_LLLI                           => System_Stream_Attributes,
+     RE_I_LLLU                           => System_Stream_Attributes,
      RE_I_LLU                            => System_Stream_Attributes,
      RE_I_LU                             => System_Stream_Attributes,
      RE_I_SF                             => System_Stream_Attributes,
@@ -3573,6 +3579,8 @@  package Rtsfind is
      RE_W_LI                             => System_Stream_Attributes,
      RE_W_LLF                            => System_Stream_Attributes,
      RE_W_LLI                            => System_Stream_Attributes,
+     RE_W_LLLI                           => System_Stream_Attributes,
+     RE_W_LLLU                           => System_Stream_Attributes,
      RE_W_LLU                            => System_Stream_Attributes,
      RE_W_LU                             => System_Stream_Attributes,
      RE_W_SF                             => System_Stream_Attributes,