Toggling the scalar storage order by means of type punning or aliasing is not
supported in the general case, but it might be reasonable to support simple
overlays precisely used to test the effect of the attribute.
The following procedure must give the same output at all optimization levels:
with System;
with Interfaces; use Interfaces;
with Ada.Text_IO; use Ada.Text_IO;
procedure P is
type U8Array is Array (Natural Range <>) of Unsigned_8;
type One_Element_Unpacked is record
Value : Integer;
end record;
type One_Element_Packed is new One_Element_Unpacked;
for One_Element_Packed use record
Value at 0 range 0 .. 31;
end record;
One_Element_Packed_Size : constant Positive := 32;
for One_Element_Packed'Bit_Order use System.High_Order_First;
for One_Element_Packed'Scalar_Storage_Order use System.High_Order_First;
for One_Element_Packed'Size use One_Element_Packed_Size;
subtype One_Element_Byte_Array
is U8Array(1 .. (One_Element_Packed'Object_Size/Unsigned_8'Object_Size));
function F (Input : in One_Element_Packed) return One_Element_Byte_Array is
Result : constant One_Element_Byte_Array;
pragma Import (Ada, Result);
for Result'Address use Input'Address;
begin
return Result;
end;
a : constant One_Element_Packed := (Value => 12);
a_bytes : constant One_Element_Byte_Array := F (a);
begin
Put("Record with single component byte representation:");
for element of a_bytes loop
Put(element'img & " ");
end loop;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-18 Eric Botcazou <ebotca...@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Address>: Mark
the entity as being volatile for an overlay that toggles the scalar
storage order.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 252907)
+++ sem_ch13.adb (working copy)
@@ -5084,6 +5084,22 @@
Register_Address_Clause_Check
(N, U_Ent, No_Uint, O_Ent, Off);
end if;
+
+ -- If the overlay changes the storage order, mark the
+ -- entity as being volatile to block any optimization
+ -- for it since the construct is not really supported
+ -- by the back end.
+
+ if (Is_Record_Type (Etype (U_Ent))
+ or else Is_Array_Type (Etype (U_Ent)))
+ and then (Is_Record_Type (Etype (O_Ent))
+ or else Is_Array_Type (Etype (O_Ent)))
+ and then Reverse_Storage_Order (Etype (U_Ent))
+ /= Reverse_Storage_Order (Etype (O_Ent))
+ then
+ Set_Treat_As_Volatile (U_Ent);
+ end if;
+
else
-- If this is not an overlay, mark a variable as being
-- volatile to prevent unwanted optimizations. It's a
