This change adds the front-end support for new representation attribute/aspect
Scalar_Storage_Order.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-03-09 Thomas Quinot <qui...@adacore.com>
* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
Add Attribute_Scalar_Storage_Order.
(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
for Scalar_Storage_Order.
(Freeze): If Scalar_Storage_Order is specified, check that it
is compatible with Bit_Order.
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 185136)
+++ exp_attr.adb (working copy)
@@ -5672,7 +5672,8 @@
Attribute_Definite |
Attribute_Null_Parameter |
Attribute_Passed_By_Reference |
- Attribute_Pool_Address =>
+ Attribute_Pool_Address |
+ Attribute_Scalar_Storage_Order =>
null;
-- The following attributes are also handled by the back end, but return
Index: freeze.adb
===================================================================
--- freeze.adb (revision 185136)
+++ freeze.adb (working copy)
@@ -2129,6 +2129,28 @@
Next_Entity (Comp);
end loop;
+ -- Check compatibility of Scalar_Storage_Order with Bit_Order, if the
+ -- former is specified.
+
+ ADC := Get_Attribute_Definition_Clause
+ (Rec, Attribute_Scalar_Storage_Order);
+
+ if Present (ADC)
+ and then
+ Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
+ then
+ if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
+ Error_Msg_N
+ ("Scalar_Storage_Order High_Order_First is inconsistent with"
+ & " Bit_Order", ADC);
+ else
+ Error_Msg_N
+ ("Scalar_Storage_Order Low_Order_First is inconsistent with"
+ & " Bit_Order", ADC);
+
+ end if;
+ end if;
+
-- Deal with Bit_Order aspect specifying a non-default bit order
if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 185136)
+++ sem_attr.adb (working copy)
@@ -4442,6 +4442,35 @@
Check_Object_Reference (E1);
Set_Etype (N, Standard_Boolean);
+ --------------------------
+ -- Scalar_Storage_Order --
+ --------------------------
+
+ when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
+ begin
+ Check_E0;
+ Check_Type;
+
+ if not Is_Record_Type (P_Type) then
+ Error_Attr_P ("prefix of % attribute must be record type");
+ end if;
+
+ if Bytes_Big_Endian xor Reverse_Storage_Order (P_Type) then
+ Rewrite (N,
+ New_Occurrence_Of (RTE (RE_High_Order_First), Loc));
+ else
+ Rewrite (N,
+ New_Occurrence_Of (RTE (RE_Low_Order_First), Loc));
+ end if;
+
+ Set_Etype (N, RTE (RE_Bit_Order));
+ Resolve (N);
+
+ -- Reset incorrect indication of staticness
+
+ Set_Is_Static_Expression (N, False);
+ end Scalar_Storage_Order;
+
-----------
-- Scale --
-----------
@@ -7963,6 +7992,7 @@
Attribute_Priority |
Attribute_Read |
Attribute_Result |
+ Attribute_Scalar_Storage_Order |
Attribute_Simple_Storage_Pool |
Attribute_Storage_Pool |
Attribute_Storage_Size |
Index: aspects.adb
===================================================================
--- aspects.adb (revision 185136)
+++ aspects.adb (working copy)
@@ -278,6 +278,7 @@
Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
Aspect_Remote_Types => Aspect_Remote_Types,
+ Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Input => Aspect_Input,
Index: aspects.ads
===================================================================
--- aspects.ads (revision 185136)
+++ aspects.ads (working copy)
@@ -74,6 +74,7 @@
Aspect_Predicate, -- GNAT
Aspect_Priority,
Aspect_Read,
+ Aspect_Scalar_Storage_Order, -- GNAT
Aspect_Simple_Storage_Pool, -- GNAT
Aspect_Size,
Aspect_Small,
@@ -188,6 +189,7 @@
Aspect_Pure_Function => True,
Aspect_Remote_Access_Type => True,
Aspect_Shared => True,
+ Aspect_Scalar_Storage_Order => True,
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
@@ -281,6 +283,7 @@
Aspect_Predicate => Expression,
Aspect_Priority => Expression,
Aspect_Read => Name,
+ Aspect_Scalar_Storage_Order => Expression,
Aspect_Simple_Storage_Pool => Name,
Aspect_Size => Expression,
Aspect_Small => Expression,
@@ -367,6 +370,7 @@
Aspect_Remote_Access_Type => Name_Remote_Access_Type,
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
Aspect_Remote_Types => Name_Remote_Types,
+ Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order,
Aspect_Shared => Name_Shared,
Aspect_Shared_Passive => Name_Shared_Passive,
Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 185136)
+++ sem_ch13.adb (working copy)
@@ -1064,24 +1064,25 @@
-- Aspects corresponding to attribute definition clauses
- when Aspect_Address |
- Aspect_Alignment |
- Aspect_Bit_Order |
- Aspect_Component_Size |
- Aspect_External_Tag |
- Aspect_Input |
- Aspect_Machine_Radix |
- Aspect_Object_Size |
- Aspect_Output |
- Aspect_Read |
- Aspect_Size |
- Aspect_Small |
- Aspect_Simple_Storage_Pool |
- Aspect_Storage_Pool |
- Aspect_Storage_Size |
- Aspect_Stream_Size |
- Aspect_Value_Size |
- Aspect_Write =>
+ when Aspect_Address |
+ Aspect_Alignment |
+ Aspect_Bit_Order |
+ Aspect_Component_Size |
+ Aspect_External_Tag |
+ Aspect_Input |
+ Aspect_Machine_Radix |
+ Aspect_Object_Size |
+ Aspect_Output |
+ Aspect_Read |
+ Aspect_Scalar_Storage_Order |
+ Aspect_Size |
+ Aspect_Small |
+ Aspect_Simple_Storage_Pool |
+ Aspect_Storage_Pool |
+ Aspect_Storage_Size |
+ Aspect_Stream_Size |
+ Aspect_Value_Size |
+ Aspect_Write =>
-- Construct the attribute definition clause
@@ -2989,6 +2990,40 @@
Analyze_Stream_TSS_Definition (TSS_Stream_Read);
Set_Has_Specified_Stream_Read (Ent);
+ --------------------------
+ -- Scalar_Storage_Order --
+ --------------------------
+
+ -- Scalar_Storage_Order attribute definition clause
+
+ when Attribute_Scalar_Storage_Order => Scalar_Storage_Order : declare
+ begin
+ if not Is_Record_Type (U_Ent) then
+ Error_Msg_N
+ ("Scalar_Storage_Order can only be defined for record type",
+ Nam);
+
+ elsif Duplicate_Clause then
+ null;
+
+ else
+ Analyze_And_Resolve (Expr, RTE (RE_Bit_Order));
+
+ if Etype (Expr) = Any_Type then
+ return;
+
+ elsif not Is_Static_Expression (Expr) then
+ Flag_Non_Static_Expr
+ ("Scalar_Storage_Order requires static expression!", Expr);
+
+ else
+ if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
+ Set_Reverse_Storage_Order (U_Ent, True);
+ end if;
+ end if;
+ end if;
+ end Scalar_Storage_Order;
+
----------
-- Size --
----------
@@ -6147,7 +6182,7 @@
when Aspect_Address =>
T := RTE (RE_Address);
- when Aspect_Bit_Order =>
+ when Aspect_Bit_Order | Aspect_Scalar_Storage_Order =>
T := RTE (RE_Bit_Order);
when Aspect_CPU =>
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 185136)
+++ snames.ads-tmpl (working copy)
@@ -120,7 +120,7 @@
Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
- -- Note: the following table is read by the utility program XSNAMES and
+ -- Note: the following table is read by the utility program XSNAMES, and
-- its format should not be changed without coordinating with this program.
N : constant Name_Id := First_Name_Id + 256;
@@ -826,6 +826,7 @@
Name_Safe_Last : constant Name_Id := N + $;
Name_Safe_Small : constant Name_Id := N + $; -- Ada 83
Name_Same_Storage : constant Name_Id := N + $; -- Ada 12
+ Name_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
Name_Scale : constant Name_Id := N + $;
Name_Scaling : constant Name_Id := N + $;
Name_Signed_Zeros : constant Name_Id := N + $;
@@ -1387,6 +1388,7 @@
Attribute_Safe_Last,
Attribute_Safe_Small,
Attribute_Same_Storage,
+ Attribute_Scalar_Storage_Order,
Attribute_Scale,
Attribute_Scaling,
Attribute_Signed_Zeros,
