[Ada] Implement attribute Descriptor_Size

Arnaud Charlet charlet@adacore.com
Tue Sep 6 10:54:00 GMT 2011


This patch provides support for attribute Descriptor_Size. Currently the
attribute is applicable only to unconstrained arrays types and returns the
size of the dope vector plus any additional padding due to alignment issues
in bits.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* gcc-interface/trans.c (Attribute_to_gnu): New case for
	attribute Descriptor_Size.
	* exp_attr.adb (Expand_N_Attribute_Reference): Add processing
	for attribute Descriptor_Size.
	* exp_ch7.adb (Double_Size_Of): Removed.
	(Make_Finalize_Address_Stmts): Remove the code which generates
	an expression to calculate the dope vector of an unconstrained
	array. Instead use attribute Descriptor_Size and leave the
	calculation to the back end.
	(Nearest_Multiple_Rounded_Up): Removed.
	(Size_Of): Removed.
	* sem_attr.adb (Analyze_Attribute): Add processing for attribute
	Descriptor_Size. Currently the attribute is applicable only
	to unconstrained arrays.
	(Eval_Attribute): Add processing for
	attribute Descriptor_Size.
	* snames.ads-tmpl: Add a predefined name and an Attribute_Id
	for Descriptor_Size.

-------------- next part --------------
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 178572)
+++ exp_ch7.adb	(working copy)
@@ -7023,99 +7023,6 @@
       Desg_Typ : Entity_Id;
       Obj_Expr : Node_Id;
 
-      function Double_Size_Of (Typ : Entity_Id) return Node_Id;
-      --  Subsidiary routine, produces an expression which calculates double
-      --  the size of Typ as the nearest multiple of its alignment rounded up.
-
-      function Nearest_Multiple_Rounded_Up
-        (Size_Expr : Node_Id;
-         Typ       : Entity_Id) return Node_Id;
-      --  Subsidiary routine, generate the following expression:
-      --    ((Size_Expr + Typ'Alignment - 1) / Typ'Alignment) * Typ'Alignment
-
-      function Size_Of (Typ : Entity_Id) return Node_Id;
-      --  Subsidiary routine, produces an expression which calculates the size
-      --  of Typ as the nearest multiple of its alignment rounded up.
-
-      --------------------
-      -- Double_Size_Of --
-      --------------------
-
-      function Double_Size_Of (Typ : Entity_Id) return Node_Id is
-      begin
-         return
-           Make_Op_Multiply (Loc,
-             Left_Opnd  => Make_Integer_Literal (Loc, 2),
-             Right_Opnd => Size_Of (Typ));
-      end Double_Size_Of;
-
-      ---------------------------------
-      -- Nearest_Multiple_Rounded_Up --
-      ---------------------------------
-
-      function Nearest_Multiple_Rounded_Up
-        (Size_Expr : Node_Id;
-         Typ       : Entity_Id) return Node_Id
-      is
-         function Alignment_Of (Typ : Entity_Id) return Node_Id;
-         --  Subsidiary routine, generate the following attribute reference:
-         --    Typ'Alignment
-
-         ------------------
-         -- Alignment_Of --
-         ------------------
-
-         function Alignment_Of (Typ : Entity_Id) return Node_Id is
-         begin
-            return
-              Make_Attribute_Reference (Loc,
-                Prefix         => New_Reference_To (Typ, Loc),
-                Attribute_Name => Name_Alignment);
-         end Alignment_Of;
-
-      --  Start of processing for Nearest_Multiple_Rounded_Up
-
-      begin
-         --  Generate:
-         --    ((Size_Expr + Typ'Alignment - 1) / Typ'Alignment) *
-         --                                           Typ'Alignment
-
-         return
-           Make_Op_Multiply (Loc,
-             Left_Opnd  =>
-               Make_Op_Divide (Loc,
-                 Left_Opnd  =>
-                   Make_Op_Add (Loc,
-                     Left_Opnd  => Size_Expr,
-                     Right_Opnd =>
-                       Make_Op_Subtract (Loc,
-                         Left_Opnd  => Alignment_Of (Typ),
-                         Right_Opnd => Make_Integer_Literal (Loc, 1))),
-                 Right_Opnd => Alignment_Of (Typ)),
-             Right_Opnd => Alignment_Of (Typ));
-      end Nearest_Multiple_Rounded_Up;
-
-      -------------
-      -- Size_Of --
-      -------------
-
-      function Size_Of (Typ : Entity_Id) return Node_Id is
-      begin
-         return
-           Nearest_Multiple_Rounded_Up
-             (Size_Expr =>
-                Make_Op_Divide (Loc,
-                  Left_Opnd  =>
-                    Make_Attribute_Reference (Loc,
-                      Prefix         => New_Reference_To (Typ, Loc),
-                      Attribute_Name => Name_Size),
-                  Right_Opnd =>
-                    Make_Integer_Literal (Loc, System_Storage_Unit)),
-              Typ => Typ);
-      end Size_Of;
-
-   --  Start of processing for Make_Finalize_Address_Stmts
-
    begin
       if Is_Array_Type (Typ) then
          if Is_Constrained (First_Subtype (Typ)) then
@@ -7190,11 +7097,7 @@
         and then not Is_Constrained (First_Subtype (Typ))
       then
          declare
-            Dope_Expr : Node_Id;
-            Dope_Id   : Entity_Id;
-            For_First : Boolean := True;
-            Index     : Node_Id;
-            Index_Typ : Entity_Id;
+            Dope_Id : Entity_Id;
 
          begin
             --  Ensure that Ptr_Typ a thin pointer, generate:
@@ -7207,40 +7110,9 @@
                 Expression =>
                   Make_Integer_Literal (Loc, System_Address_Size)));
 
-            --  For unconstrained arrays, create the expression which computes
-            --  the size of the dope vector.
-
-            Index := First_Index (Typ);
-            while Present (Index) loop
-               Index_Typ := Etype (Index);
-
-               --  Each bound has two values and a potential hole added to
-               --  compensate for alignment differences.
-
-               if For_First then
-                  For_First := False;
-                  Dope_Expr := Double_Size_Of (Index_Typ);
-
-               else
-                  Dope_Expr :=
-                    Make_Op_Add (Loc,
-                      Left_Opnd  => Dope_Expr,
-                      Right_Opnd => Double_Size_Of (Index_Typ));
-               end if;
-
-               Next_Index (Index);
-            end loop;
-
-            --  Dope_Expr calculates the size of the dope, acounting for
-            --  individual alignment holes on the index type level. Since the
-            --  alignment of the component type dictates the underlying layout
-            --  of the array, round the size of the dope to the next higher
-            --  multiple of the component alignment.
-
-            Dope_Expr := Nearest_Multiple_Rounded_Up (Dope_Expr, Typ);
-
             --  Generate:
-            --    Dnn : Storage_Offset := Dope_Expr;
+            --    Dnn : constant Storage_Offset :=
+            --            Desg_Typ'Descriptor_Size / Storage_Unit;
 
             Dope_Id := Make_Temporary (Loc, 'D');
 
@@ -7250,7 +7122,14 @@
                 Constant_Present    => True,
                 Object_Definition   =>
                   New_Reference_To (RTE (RE_Storage_Offset), Loc),
-                Expression          => Dope_Expr));
+                Expression          =>
+                  Make_Op_Divide (Loc,
+                    Left_Opnd  =>
+                      Make_Attribute_Reference (Loc,
+                        Prefix         => New_Reference_To (Desg_Typ, Loc),
+                        Attribute_Name => Name_Descriptor_Size),
+                    Right_Opnd =>
+                      Make_Integer_Literal (Loc, System_Storage_Unit))));
 
             --  Shift the address from the start of the dope vector to the
             --  start of the elements:
Index: exp_attr.adb
===================================================================
--- exp_attr.adb	(revision 178565)
+++ exp_attr.adb	(working copy)
@@ -1799,6 +1799,15 @@
          Analyze_And_Resolve (N, Typ);
       end Count;
 
+      ---------------------
+      -- Descriptor_Size --
+      ---------------------
+
+      --  This attribute is handled entirely by the back end
+
+      when Attribute_Descriptor_Size =>
+         Apply_Universal_Integer_Attribute_Checks (N);
+
       ---------------
       -- Elab_Body --
       ---------------
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 178565)
+++ sem_attr.adb	(working copy)
@@ -3014,6 +3014,28 @@
          Check_Floating_Point_Type_0;
          Set_Etype (N, Standard_Boolean);
 
+      ---------------------
+      -- Descriptor_Size --
+      ---------------------
+
+      when Attribute_Descriptor_Size =>
+         Check_E0;
+
+         --  Attribute Descriptor_Size is relevant only in the context of an
+         --  unconstrained array type.
+
+         if Is_Entity_Name (P)
+           and then Is_Type (Entity (P))
+           and then Is_Array_Type (Entity (P))
+           and then not Is_Constrained (Entity (P))
+         then
+            null;
+         else
+            Error_Attr_P ("invalid prefix for % attribute");
+         end if;
+
+         Set_Etype (N, Universal_Integer);
+
       ------------
       -- Digits --
       ------------
@@ -6246,6 +6268,13 @@
          Fold_Uint
            (N, UI_From_Int (Boolean'Pos (Denorm_On_Target)), True);
 
+      ---------------------
+      -- Descriptor_Size --
+      ---------------------
+
+      when Attribute_Descriptor_Size =>
+         null;
+
       ------------
       -- Digits --
       ------------
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 178579)
+++ snames.ads-tmpl	(working copy)
@@ -744,6 +744,7 @@
    Name_Definite                       : constant Name_Id := N + $;
    Name_Delta                          : constant Name_Id := N + $;
    Name_Denorm                         : constant Name_Id := N + $;
+   Name_Descriptor_Size                : constant Name_Id := N + $;
    Name_Digits                         : constant Name_Id := N + $;
    Name_Elaborated                     : constant Name_Id := N + $; -- GNAT
    Name_Emax                           : constant Name_Id := N + $; -- Ada 83
@@ -1298,6 +1299,7 @@
       Attribute_Definite,
       Attribute_Delta,
       Attribute_Denorm,
+      Attribute_Descriptor_Size,
       Attribute_Digits,
       Attribute_Elaborated,
       Attribute_Emax,
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 178565)
+++ gcc-interface/trans.c	(working copy)
@@ -1878,6 +1878,20 @@
       prefix_unused = true;
       break;
 
+    case Attr_Descriptor_Size:
+      gnu_type = TREE_TYPE (gnu_prefix);
+      gcc_assert (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE);
+
+      /* What we want is the offset of the ARRAY field in the record that the
+        thin pointer designates, but the components have been shifted so this
+        is actually the opposite of the offset of the BOUNDS field.  */
+      gnu_type = TYPE_OBJECT_RECORD_TYPE (gnu_type);
+      gnu_result = size_binop (MINUS_EXPR, bitsize_zero_node,
+                               bit_position (TYPE_FIELDS (gnu_type)));
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      prefix_unused = true;
+      break;
+
     case Attr_Null_Parameter:
       /* This is just a zero cast to the pointer type for our prefix and
 	 dereferenced.  */


More information about the Gcc-patches mailing list