The required level of support for elementary streaming includes support
for 24 bits elements, which is added here.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-12 Arnaud Charlet <char...@adacore.com>
gcc/ada/
* exp_strm.adb (Build_Elementary_Input_Call): Add support for 24
bits elementary types.
* rtsfind.ads: Add 24 bits integer streaming routines.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause
[Attribute_Stream_Size]): Add support for 24 bits elementary
types.
* libgnat/s-stratt.ads, libgnat/s-stratt.adb,
libgnat/s-stratt__xdr.adb: Add support for signed and unsigned
24 bits integers.--- gcc/ada/exp_strm.adb
+++ gcc/ada/exp_strm.adb
@@ -569,6 +569,9 @@ package body Exp_Strm is
elsif P_Size <= Standard_Short_Integer_Size then
Lib_RE := RE_I_SI;
+ elsif P_Size = 24 then
+ Lib_RE := RE_I_I24;
+
elsif P_Size <= Standard_Integer_Size then
Lib_RE := RE_I_I;
@@ -597,6 +600,9 @@ package body Exp_Strm is
elsif P_Size <= Standard_Short_Integer_Size then
Lib_RE := RE_I_SU;
+ elsif P_Size = 24 then
+ Lib_RE := RE_I_U24;
+
elsif P_Size <= Standard_Integer_Size then
Lib_RE := RE_I_U;
@@ -798,6 +804,8 @@ package body Exp_Strm is
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
@@ -822,6 +830,8 @@ package body Exp_Strm is
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
--- gcc/ada/libgnat/s-stratt.adb
+++ gcc/ada/libgnat/s-stratt.adb
@@ -59,6 +59,7 @@ package body System.Stream_Attributes is
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);
@@ -71,6 +72,7 @@ package body System.Stream_Attributes is
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);
@@ -80,6 +82,7 @@ package body System.Stream_Attributes is
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);
@@ -92,6 +95,7 @@ package body System.Stream_Attributes is
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);
@@ -101,6 +105,7 @@ package body System.Stream_Attributes is
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);
@@ -113,6 +118,7 @@ package body System.Stream_Attributes is
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);
@@ -233,6 +239,24 @@ package body System.Stream_Attributes is
end if;
end I_I;
+ -----------
+ -- I_I24 --
+ -----------
+
+ function I_I24 (Stream : not null access RST) return Integer_24 is
+ T : S_I24;
+ L : SEO;
+
+ begin
+ Ada.Streams.Read (Stream.all, T, L);
+
+ if L < T'Last then
+ raise Err;
+ else
+ return To_I24 (T);
+ end if;
+ end I_I24;
+
----------
-- I_LF --
----------
@@ -453,6 +477,24 @@ package body System.Stream_Attributes is
end if;
end I_U;
+ -----------
+ -- I_U24 --
+ -----------
+
+ function I_U24 (Stream : not null access RST) return Unsigned_24 is
+ T : S_U24;
+ L : SEO;
+
+ begin
+ Ada.Streams.Read (Stream.all, T, L);
+
+ if L < T'Last then
+ raise Err;
+ else
+ return To_U24 (T);
+ end if;
+ end I_U24;
+
----------
-- I_WC --
----------
@@ -551,6 +593,16 @@ package body System.Stream_Attributes is
Ada.Streams.Write (Stream.all, T);
end W_I;
+ -----------
+ -- W_I24 --
+ -----------
+
+ 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);
+ end W_I24;
+
----------
-- W_LF --
----------
@@ -683,6 +735,16 @@ package body System.Stream_Attributes is
Ada.Streams.Write (Stream.all, T);
end W_U;
+ -----------
+ -- W_U24 --
+ -----------
+
+ 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);
+ end W_U24;
+
----------
-- W_WC --
----------
--- gcc/ada/libgnat/s-stratt.ads
+++ gcc/ada/libgnat/s-stratt.ads
@@ -53,6 +53,12 @@ package System.Stream_Attributes is
subtype SEC is Ada.Streams.Stream_Element_Count;
+ type Integer_24 is range -2 ** 23 .. 2 ** 23 - 1;
+ for Integer_24'Size use 24;
+
+ type Unsigned_24 is mod 2 ** 24;
+ for Unsigned_24'Size use 24;
+
-- Enumeration types are usually transferred using the routine for the
-- corresponding integer. The exception is that special routines are
-- provided for Boolean and the character types, in case the protocol
@@ -104,6 +110,7 @@ package System.Stream_Attributes is
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;
@@ -117,6 +124,7 @@ package System.Stream_Attributes is
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;
@@ -135,6 +143,7 @@ package System.Stream_Attributes is
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);
@@ -149,6 +158,7 @@ package System.Stream_Attributes is
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);
--- gcc/ada/libgnat/s-stratt__xdr.adb
+++ gcc/ada/libgnat/s-stratt__xdr.adb
@@ -139,40 +139,47 @@ package body System.Stream_Attributes is
SSI_L : constant := 1;
SI_L : constant := 2;
+ I24_L : constant := 3;
I_L : constant := 4;
LI_L : constant := 8;
LLI_L : constant := 8;
subtype XDR_S_SSI is SEA (1 .. SSI_L);
subtype XDR_S_SI is SEA (1 .. SI_L);
+ subtype XDR_S_I24 is SEA (1 .. I24_L);
subtype XDR_S_I is SEA (1 .. I_L);
subtype XDR_S_LI is SEA (1 .. LI_L);
subtype XDR_S_LLI is SEA (1 .. LLI_L);
function Short_Short_Integer_To_XDR_S_SSI is
- new Ada.Unchecked_Conversion (Short_Short_Integer, XDR_S_SSI);
+ new Ada.Unchecked_Conversion (Short_Short_Integer, XDR_S_SSI);
function XDR_S_SSI_To_Short_Short_Integer is
- new Ada.Unchecked_Conversion (XDR_S_SSI, Short_Short_Integer);
+ new Ada.Unchecked_Conversion (XDR_S_SSI, Short_Short_Integer);
function Short_Integer_To_XDR_S_SI is
- new Ada.Unchecked_Conversion (Short_Integer, XDR_S_SI);
+ new Ada.Unchecked_Conversion (Short_Integer, XDR_S_SI);
function XDR_S_SI_To_Short_Integer is
- new Ada.Unchecked_Conversion (XDR_S_SI, Short_Integer);
+ new Ada.Unchecked_Conversion (XDR_S_SI, Short_Integer);
+
+ function Integer_To_XDR_S_I24 is
+ new Ada.Unchecked_Conversion (Integer_24, XDR_S_I24);
+ function XDR_S_I24_To_Integer is
+ new Ada.Unchecked_Conversion (XDR_S_I24, Integer_24);
function Integer_To_XDR_S_I is
- new Ada.Unchecked_Conversion (Integer, XDR_S_I);
+ new Ada.Unchecked_Conversion (Integer, XDR_S_I);
function XDR_S_I_To_Integer is
new Ada.Unchecked_Conversion (XDR_S_I, Integer);
function Long_Long_Integer_To_XDR_S_LI is
- new Ada.Unchecked_Conversion (Long_Long_Integer, XDR_S_LI);
+ new Ada.Unchecked_Conversion (Long_Long_Integer, XDR_S_LI);
function XDR_S_LI_To_Long_Long_Integer is
- new Ada.Unchecked_Conversion (XDR_S_LI, Long_Long_Integer);
+ new Ada.Unchecked_Conversion (XDR_S_LI, Long_Long_Integer);
function Long_Long_Integer_To_XDR_S_LLI is
- new Ada.Unchecked_Conversion (Long_Long_Integer, XDR_S_LLI);
+ new Ada.Unchecked_Conversion (Long_Long_Integer, XDR_S_LLI);
function XDR_S_LLI_To_Long_Long_Integer is
- new Ada.Unchecked_Conversion (XDR_S_LLI, Long_Long_Integer);
+ new Ada.Unchecked_Conversion (XDR_S_LLI, Long_Long_Integer);
-- An XDR unsigned integer is a 32-bit datum that encodes a nonnegative
-- integer in the range [0,4294967295]. It is represented by an unsigned
@@ -187,12 +194,14 @@ package body System.Stream_Attributes is
SSU_L : constant := 1;
SU_L : constant := 2;
+ U24_L : constant := 3;
U_L : constant := 4;
LU_L : constant := 8;
LLU_L : constant := 8;
subtype XDR_S_SSU is SEA (1 .. SSU_L);
subtype XDR_S_SU is SEA (1 .. SU_L);
+ subtype XDR_S_U24 is SEA (1 .. U24_L);
subtype XDR_S_U is SEA (1 .. U_L);
subtype XDR_S_LU is SEA (1 .. LU_L);
subtype XDR_S_LLU is SEA (1 .. LLU_L);
@@ -200,26 +209,32 @@ package body System.Stream_Attributes is
type XDR_SSU is mod BB ** SSU_L;
type XDR_SU is mod BB ** SU_L;
type XDR_U is mod BB ** U_L;
+ type XDR_U24 is mod BB ** U24_L;
function Short_Unsigned_To_XDR_S_SU is
- new Ada.Unchecked_Conversion (Short_Unsigned, XDR_S_SU);
+ new Ada.Unchecked_Conversion (Short_Unsigned, XDR_S_SU);
function XDR_S_SU_To_Short_Unsigned is
- new Ada.Unchecked_Conversion (XDR_S_SU, Short_Unsigned);
+ new Ada.Unchecked_Conversion (XDR_S_SU, Short_Unsigned);
+
+ function Unsigned_To_XDR_S_U24 is
+ new Ada.Unchecked_Conversion (Unsigned_24, XDR_S_U24);
+ function XDR_S_U24_To_Unsigned is
+ new Ada.Unchecked_Conversion (XDR_S_U24, Unsigned_24);
function Unsigned_To_XDR_S_U is
- new Ada.Unchecked_Conversion (Unsigned, XDR_S_U);
+ new Ada.Unchecked_Conversion (Unsigned, XDR_S_U);
function XDR_S_U_To_Unsigned is
- new Ada.Unchecked_Conversion (XDR_S_U, Unsigned);
+ new Ada.Unchecked_Conversion (XDR_S_U, Unsigned);
function Long_Long_Unsigned_To_XDR_S_LU is
- new Ada.Unchecked_Conversion (Long_Long_Unsigned, XDR_S_LU);
+ new Ada.Unchecked_Conversion (Long_Long_Unsigned, XDR_S_LU);
function XDR_S_LU_To_Long_Long_Unsigned is
- new Ada.Unchecked_Conversion (XDR_S_LU, Long_Long_Unsigned);
+ new Ada.Unchecked_Conversion (XDR_S_LU, Long_Long_Unsigned);
function Long_Long_Unsigned_To_XDR_S_LLU is
- new Ada.Unchecked_Conversion (Long_Long_Unsigned, XDR_S_LLU);
+ new Ada.Unchecked_Conversion (Long_Long_Unsigned, XDR_S_LLU);
function XDR_S_LLU_To_Long_Long_Unsigned is
- new Ada.Unchecked_Conversion (XDR_S_LLU, Long_Long_Unsigned);
+ new Ada.Unchecked_Conversion (XDR_S_LLU, Long_Long_Unsigned);
-- The standard defines the floating-point data type "float" (32 bits
-- or 4 bytes). The encoding used is the IEEE standard for normalized
@@ -484,6 +499,40 @@ package body System.Stream_Attributes is
end if;
end I_I;
+ -----------
+ -- I_I24 --
+ -----------
+
+ function I_I24 (Stream : not null access RST) return Integer_24 is
+ S : XDR_S_I24;
+ L : SEO;
+ U : XDR_U24 := 0;
+
+ begin
+ Ada.Streams.Read (Stream.all, S, L);
+
+ if L /= S'Last then
+ raise Data_Error;
+
+ elsif Optimize_Integers then
+ return XDR_S_I24_To_Integer (S);
+
+ else
+ for N in S'Range loop
+ U := U * BB + XDR_U24 (S (N));
+ end loop;
+
+ -- Test sign and apply two complement notation
+
+ if S (1) < BL then
+ return Integer_24 (U);
+
+ else
+ return Integer_24 (-((XDR_U24'Last xor U) + 1));
+ end if;
+ end if;
+ end I_I24;
+
----------
-- I_LF --
----------
@@ -1042,6 +1091,33 @@ package body System.Stream_Attributes is
end if;
end I_U;
+ -----------
+ -- I_U24 --
+ -----------
+
+ function I_U24 (Stream : not null access RST) return Unsigned_24 is
+ S : XDR_S_U24;
+ L : SEO;
+ U : XDR_U24 := 0;
+
+ begin
+ Ada.Streams.Read (Stream.all, S, L);
+
+ if L /= S'Last then
+ raise Data_Error;
+
+ elsif Optimize_Integers then
+ return XDR_S_U24_To_Unsigned (S);
+
+ else
+ for N in S'Range loop
+ U := U * BB + XDR_U24 (S (N));
+ end loop;
+
+ return Unsigned_24 (U);
+ end if;
+ end I_U24;
+
----------
-- I_WC --
----------
@@ -1289,6 +1365,38 @@ package body System.Stream_Attributes is
Ada.Streams.Write (Stream.all, S);
end W_I;
+ -----------
+ -- W_I24 --
+ -----------
+
+ procedure W_I24 (Stream : not null access RST; Item : Integer_24) is
+ S : XDR_S_I24;
+ U : XDR_U24;
+
+ begin
+ if Optimize_Integers then
+ S := Integer_To_XDR_S_I24 (Item);
+
+ else
+ -- Test sign and apply two complement notation
+
+ U := (if Item < 0
+ then XDR_U24'Last xor XDR_U24 (-(Item + 1))
+ else XDR_U24 (Item));
+
+ for N in reverse S'Range loop
+ S (N) := SE (U mod BB);
+ U := U / BB;
+ end loop;
+
+ if U /= 0 then
+ raise Data_Error;
+ end if;
+ end if;
+
+ Ada.Streams.Write (Stream.all, S);
+ end W_I24;
+
----------
-- W_LF --
----------
@@ -1846,6 +1954,32 @@ package body System.Stream_Attributes is
Ada.Streams.Write (Stream.all, S);
end W_U;
+ -----------
+ -- W_U24 --
+ -----------
+
+ procedure W_U24 (Stream : not null access RST; Item : Unsigned_24) is
+ S : XDR_S_U24;
+ U : XDR_U24 := XDR_U24 (Item);
+
+ begin
+ if Optimize_Integers then
+ S := Unsigned_To_XDR_S_U24 (Item);
+
+ else
+ for N in reverse S'Range loop
+ S (N) := SE (U mod BB);
+ U := U / BB;
+ end loop;
+
+ if U /= 0 then
+ raise Data_Error;
+ end if;
+ end if;
+
+ Ada.Streams.Write (Stream.all, S);
+ end W_U24;
+
----------
-- W_WC --
----------
--- gcc/ada/rtsfind.ads
+++ gcc/ada/rtsfind.ads
@@ -1377,6 +1377,7 @@ package Rtsfind is
RE_I_C, -- System.Stream_Attributes
RE_I_F, -- System.Stream_Attributes
RE_I_I, -- System.Stream_Attributes
+ RE_I_I24, -- System.Stream_Attributes
RE_I_LF, -- System.Stream_Attributes
RE_I_LI, -- System.Stream_Attributes
RE_I_LLF, -- System.Stream_Attributes
@@ -1389,6 +1390,7 @@ package Rtsfind is
RE_I_SSU, -- System.Stream_Attributes
RE_I_SU, -- System.Stream_Attributes
RE_I_U, -- System.Stream_Attributes
+ RE_I_U24, -- System.Stream_Attributes
RE_I_WC, -- System.Stream_Attributes
RE_I_WWC, -- System.Stream_Attributes
@@ -1398,6 +1400,7 @@ package Rtsfind is
RE_W_C, -- System.Stream_Attributes
RE_W_F, -- System.Stream_Attributes
RE_W_I, -- System.Stream_Attributes
+ RE_W_I24, -- System.Stream_Attributes
RE_W_LF, -- System.Stream_Attributes
RE_W_LI, -- System.Stream_Attributes
RE_W_LLF, -- System.Stream_Attributes
@@ -1410,6 +1413,7 @@ package Rtsfind is
RE_W_SSU, -- System.Stream_Attributes
RE_W_SU, -- System.Stream_Attributes
RE_W_U, -- System.Stream_Attributes
+ RE_W_U24, -- System.Stream_Attributes
RE_W_WC, -- System.Stream_Attributes
RE_W_WWC, -- System.Stream_Attributes
@@ -2654,6 +2658,7 @@ package Rtsfind is
RE_I_C => System_Stream_Attributes,
RE_I_F => System_Stream_Attributes,
RE_I_I => System_Stream_Attributes,
+ RE_I_I24 => System_Stream_Attributes,
RE_I_LF => System_Stream_Attributes,
RE_I_LI => System_Stream_Attributes,
RE_I_LLF => System_Stream_Attributes,
@@ -2666,6 +2671,7 @@ package Rtsfind is
RE_I_SSU => System_Stream_Attributes,
RE_I_SU => System_Stream_Attributes,
RE_I_U => System_Stream_Attributes,
+ RE_I_U24 => System_Stream_Attributes,
RE_I_WC => System_Stream_Attributes,
RE_I_WWC => System_Stream_Attributes,
@@ -2675,6 +2681,7 @@ package Rtsfind is
RE_W_C => System_Stream_Attributes,
RE_W_F => System_Stream_Attributes,
RE_W_I => System_Stream_Attributes,
+ RE_W_I24 => System_Stream_Attributes,
RE_W_LF => System_Stream_Attributes,
RE_W_LI => System_Stream_Attributes,
RE_W_LLF => System_Stream_Attributes,
@@ -2687,6 +2694,7 @@ package Rtsfind is
RE_W_SSU => System_Stream_Attributes,
RE_W_SU => System_Stream_Attributes,
RE_W_U => System_Stream_Attributes,
+ RE_W_U24 => System_Stream_Attributes,
RE_W_WC => System_Stream_Attributes,
RE_W_WWC => System_Stream_Attributes,
--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -6593,19 +6593,19 @@ package body Sem_Ch13 is
elsif Is_Elementary_Type (U_Ent) then
if Size /= System_Storage_Unit
and then Size /= System_Storage_Unit * 2
+ and then Size /= System_Storage_Unit * 3
and then Size /= System_Storage_Unit * 4
and then Size /= System_Storage_Unit * 8
then
- Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
Error_Msg_N
- ("stream size for elementary type must be a power of 2 "
- & "and at least ^", N);
+ ("stream size for elementary type must be 8, 16, 24, " &
+ "32 or 64", N);
elsif RM_Size (U_Ent) > Size then
Error_Msg_Uint_1 := RM_Size (U_Ent);
Error_Msg_N
- ("stream size for elementary type must be a power of 2 "
- & "and at least ^", N);
+ ("stream size for elementary type must be 8, 16, 24, " &
+ "32 or 64 and at least ^", N);
end if;
Set_Has_Stream_Size_Clause (U_Ent);
