[Ada] Fix wrong access to large bit-packed arrays with reverse SSO
2020-06-11 Eric Botcazou <ebotcazou@adacore.com>
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.
This commit is contained in:
Eric Botcazou
Pierre-Marie de Rodat
parent
cf0a011c2b
commit
adffc36723
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user