From adffc3672314dc260d5c692d2dce81d42cdb22dc Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 17 Mar 2020 21:26:43 +0100 Subject: [PATCH] [Ada] Fix wrong access to large bit-packed arrays with reverse SSO 2020-06-11 Eric Botcazou gcc/ada/ * exp_pakd.ads: Add paragraph about scalar storage order. * exp_pakd.adb (Install_PAT): Do not set the scalar storage order of the PAT here but... (Set_PB_Type): ...here instead and... (Create_Packed_Array_Impl_Type): ...here as well. * rtsfind.ads (RE_Id): Add RE_Rev_Packed_Bytes{1,2,4}. (RE_Unit_Table): Likewise. * libgnat/s-unstyp.ads (Rev_Packed_Bytes1): New derived type. (Rev_Packed_Bytes2): Likewise. (Rev_Packed_Bytes4): Likewise. --- gcc/ada/exp_pakd.adb | 43 +++++++++++++++++++++++++----------- gcc/ada/exp_pakd.ads | 9 ++++++++ gcc/ada/libgnat/s-unstyp.ads | 20 ++++++++++++++++- gcc/ada/rtsfind.ads | 6 +++++ 4 files changed, 64 insertions(+), 14 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 02a0d987885..6d5cf62af07 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -501,8 +501,9 @@ package body Exp_Pakd is -- packed array type. It creates the type and installs it as required. procedure Set_PB_Type; - -- Sets PB_Type to Packed_Bytes{1,2,4} as required by the alignment - -- requirements (see documentation in the spec of this package). + -- Set PB_Type to [Rev_]Packed_Bytes{1,2,4} as required by the alignment + -- and the scalar storage order requirements (see documentation in the + -- spec of this package). ----------------- -- Install_PAT -- @@ -580,14 +581,6 @@ package body Exp_Pakd is Set_Is_Volatile_Full_Access (PAT, Is_Volatile_Full_Access (Typ)); Set_Treat_As_Volatile (PAT, Treat_As_Volatile (Typ)); - -- For a non-bit-packed array, propagate reverse storage order - -- flag from original base type to packed array base type. - - if not Is_Bit_Packed_Array (Typ) then - Set_Reverse_Storage_Order - (Etype (PAT), Reverse_Storage_Order (Base_Type (Typ))); - end if; - -- We definitely do not want to delay freezing for packed array -- types. This is of particular importance for the itypes that are -- generated for record components depending on discriminants where @@ -616,16 +609,36 @@ package body Exp_Pakd is or else Alignment (Typ) = 1 or else Component_Alignment (Typ) = Calign_Storage_Unit then - PB_Type := RTE (RE_Packed_Bytes1); + if Reverse_Storage_Order (Typ) then + PB_Type := RTE (RE_Rev_Packed_Bytes1); + else + PB_Type := RTE (RE_Packed_Bytes1); + end if; elsif Csize mod 4 /= 0 or else Alignment (Typ) = 2 then - PB_Type := RTE (RE_Packed_Bytes2); + if Reverse_Storage_Order (Typ) then + PB_Type := RTE (RE_Rev_Packed_Bytes2); + else + PB_Type := RTE (RE_Packed_Bytes2); + end if; else - PB_Type := RTE (RE_Packed_Bytes4); + if Reverse_Storage_Order (Typ) then + PB_Type := RTE (RE_Rev_Packed_Bytes4); + else + PB_Type := RTE (RE_Packed_Bytes4); + end if; end if; + + -- The Rev_Packed_Bytes{1,2,4} types cannot be directly declared with + -- the reverse scalar storage order in System.Unsigned_Types because + -- their component type is aliased and the combination would then be + -- flagged as illegal by the compiler. Moreover changing the compiler + -- would not address the bootstrap path issue with earlier versions. + + Set_Reverse_Storage_Order (PB_Type, Reverse_Storage_Order (Typ)); end Set_PB_Type; -- Start of processing for Create_Packed_Array_Impl_Type @@ -797,6 +810,10 @@ package body Exp_Pakd is end; Install_PAT; + + -- Propagate the reverse storage order flag to the base type + + Set_Reverse_Storage_Order (Etype (PAT), Reverse_Storage_Order (Typ)); return; -- Case of bit-packing required for unconstrained array. We create diff --git a/gcc/ada/exp_pakd.ads b/gcc/ada/exp_pakd.ads index 89c36d81a3a..33726ba547e 100644 --- a/gcc/ada/exp_pakd.ads +++ b/gcc/ada/exp_pakd.ads @@ -86,6 +86,15 @@ package Exp_Pakd is -- Packed_Bytes{1,2,4} type is made on the basis of alignment needs as -- described above for the unconstrained case. + -- When the packed array (sub)type is specified to have the reverse scalar + -- storage order, the Packed_Bytes{1,2,4} references above are replaced + -- with Rev_Packed_Bytes{1,2,4}. This is necessary because, although the + -- component type is Packed_Byte and therefore endian neutral, the scalar + -- storage order of the new type must be compatible with that of an outer + -- composite type, if this composite type contains a component whose type + -- is the packed array (sub)type and which does not start or does not end + -- on a storage unit boundary. + -- When a variable of packed array type is allocated, gigi will allocate -- the amount of space indicated by the corresponding packed array type. -- However, we do NOT attempt to rewrite the types of any references or diff --git a/gcc/ada/libgnat/s-unstyp.ads b/gcc/ada/libgnat/s-unstyp.ads index 081581254f2..0f6c73cbd5c 100644 --- a/gcc/ada/libgnat/s-unstyp.ads +++ b/gcc/ada/libgnat/s-unstyp.ads @@ -51,8 +51,8 @@ package System.Unsigned_Types is -- Used in the implementation of Is_Negative intrinsic (see Exp_Intr) type Packed_Byte is mod 2 ** 8; - pragma Universal_Aliasing (Packed_Byte); for Packed_Byte'Size use 8; + pragma Universal_Aliasing (Packed_Byte); -- Component type for Packed_Bytes1, Packed_Bytes2 and Packed_Byte4 arrays. -- As this type is used by the compiler to implement operations on user -- packed array, it needs to be able to alias any type. @@ -89,6 +89,24 @@ package System.Unsigned_Types is -- cases the clusters can be assumed to be 4-byte aligned if the array -- is aligned (see System.Pack_12 in file s-pack12 as an example). + type Rev_Packed_Bytes1 is new Packed_Bytes1; + pragma Suppress_Initialization (Rev_Packed_Bytes1); + -- This is equivalent to Packed_Bytes1, but for packed arrays with reverse + -- scalar storage order. But the Scalar_Storage_Order attribute cannot be + -- set directly here, see Exp_Pakd for more details. + + type Rev_Packed_Bytes2 is new Packed_Bytes2; + pragma Suppress_Initialization (Rev_Packed_Bytes2); + -- This is equivalent to Packed_Bytes2, but for packed arrays with reverse + -- scalar storage order. But the Scalar_Storage_Order attribute cannot be + -- set directly here, see Exp_Pakd for more details. + + type Rev_Packed_Bytes4 is new Packed_Bytes4; + pragma Suppress_Initialization (Rev_Packed_Bytes4); + -- This is equivalent to Packed_Bytes4, but for packed arrays with reverse + -- scalar storage order. But the Scalar_Storage_Order attribute cannot be + -- set directly here, see Exp_Pakd for more details. + type Bits_1 is mod 2**1; type Bits_2 is mod 2**2; type Bits_4 is mod 2**4; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 5074e18983b..df980233ea6 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1524,6 +1524,9 @@ package Rtsfind is RE_Packed_Bytes1, -- System.Unsigned_Types RE_Packed_Bytes2, -- System.Unsigned_Types RE_Packed_Bytes4, -- System.Unsigned_Types + RE_Rev_Packed_Bytes1, -- System.Unsigned_Types + RE_Rev_Packed_Bytes2, -- System.Unsigned_Types + RE_Rev_Packed_Bytes4, -- System.Unsigned_Types RE_Short_Unsigned, -- System.Unsigned_Types RE_Short_Short_Unsigned, -- System.Unsigned_Types RE_Unsigned, -- System.Unsigned_Types @@ -2798,6 +2801,9 @@ package Rtsfind is RE_Packed_Bytes1 => System_Unsigned_Types, RE_Packed_Bytes2 => System_Unsigned_Types, RE_Packed_Bytes4 => System_Unsigned_Types, + RE_Rev_Packed_Bytes1 => System_Unsigned_Types, + RE_Rev_Packed_Bytes2 => System_Unsigned_Types, + RE_Rev_Packed_Bytes4 => System_Unsigned_Types, RE_Short_Unsigned => System_Unsigned_Types, RE_Short_Short_Unsigned => System_Unsigned_Types, RE_Unsigned => System_Unsigned_Types, -- 2.30.2