Patchwork [Ada] Front-end support for attribute Scalar_Storage_Order

login
register
mail settings
Submitter Arnaud Charlet
Date March 9, 2012, 2:55 p.m.
Message ID <20120309145513.GA6163@adacore.com>
Download mbox | patch
Permalink /patch/145726/
State New
Headers show

Comments

Arnaud Charlet - March 9, 2012, 2:55 p.m.
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  <quinot@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.

Patch

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,