Patchwork [Ada] Implement pragma Default_Storage_Pool

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 19, 2010, 10:30 a.m.
Message ID <20101019103026.GA4758@adacore.com>
Download mbox | patch
Permalink /patch/68304/
State New
Headers show

Comments

Arnaud Charlet - Oct. 19, 2010, 10:30 a.m.
This patch implements AI05-0193-1, which introduces a new attribute
Max_Alignment_For_Allocation, analogous to Max_Size_In_Storage_Elements, but
for alignment instead of size. It returns an upper bound on the Alignment that
can be passed to Allocate.

The following test should run silently.

gnatmake -gnat2012 -gnata -g test_max_alignment_for_allocation.adb

procedure Test_Max_Alignment_For_Allocation is
begin
   pragma Assert (String'Alignment = 1);
   pragma Assert (String'Max_Alignment_For_Allocation = 16);
   null;
end Test_Max_Alignment_For_Allocation;

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

2010-10-19  Bob Duff  <duff@adacore.com>

	* sem_attr.adb (Eval_Attribute): Implement Max_Alignment_For_Allocation
	attribute.
	* exp_attr.adb (Expand_N_Attribute_Reference): Add
	Attribute_Max_Alignment_For_Allocation to the case statement.
	* snames.ads-tmpl (Name_Max_Alignment_For_Allocation,
	Attribute_Max_Alignment_For_Allocation): New attribute name.

Patch

Index: exp_attr.adb
===================================================================
--- exp_attr.adb	(revision 165687)
+++ exp_attr.adb	(working copy)
@@ -5310,8 +5310,8 @@  package body Exp_Attr is
       --  that the result is in range.
 
       when Attribute_Aft                          |
-           Attribute_Max_Size_In_Storage_Elements
-      =>
+           Attribute_Max_Alignment_For_Allocation |
+           Attribute_Max_Size_In_Storage_Elements =>
          Apply_Universal_Integer_Attribute_Checks (N);
 
       --  The following attributes should not appear at this stage, since they
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 165689)
+++ sem_attr.adb	(working copy)
@@ -3420,10 +3420,12 @@  package body Sem_Attr is
          Set_Etype (N, P_Base_Type);
 
       ----------------------------------
+      -- Max_Alignment_For_Allocation --
       -- Max_Size_In_Storage_Elements --
       ----------------------------------
 
-      when Attribute_Max_Size_In_Storage_Elements =>
+      when Attribute_Max_Alignment_For_Allocation |
+        Attribute_Max_Size_In_Storage_Elements =>
          Check_E0;
          Check_Type;
          Check_Not_Incomplete_Type;
@@ -5589,7 +5591,9 @@  package body Sem_Attr is
                or else
              Id = Attribute_Type_Class
                or else
-             Id = Attribute_Unconstrained_Array)
+             Id = Attribute_Unconstrained_Array
+               or else
+             Id = Attribute_Max_Alignment_For_Allocation)
         and then not Is_Generic_Type (P_Entity)
       then
          P_Type := P_Entity;
@@ -5714,7 +5718,7 @@  package body Sem_Attr is
       then
          Static := False;
 
-      else
+      elsif Id /= Attribute_Max_Alignment_For_Allocation then
          if not Is_Constrained (P_Type)
            or else (Id /= Attribute_First and then
                     Id /= Attribute_Last  and then
@@ -6624,6 +6628,29 @@  package body Sem_Attr is
       end Max;
 
       ----------------------------------
+      -- Max_Alignment_For_Allocation --
+      ----------------------------------
+
+      --  Max_Alignment_For_Allocation is usually the Alignment. However,
+      --  arrays are allocated with dope, so we need to take into account both
+      --  the alignment of the array, which comes from the component alignment,
+      --  and the alignment of the dope. Also, if the alignment is unknown, we
+      --  use the max (it's OK to be pessimistic).
+
+      when Attribute_Max_Alignment_For_Allocation =>
+         declare
+            A : Uint := UI_From_Int (Ttypes.Maximum_Alignment);
+         begin
+            if Known_Alignment (P_Type) and then
+              (not Is_Array_Type (P_Type) or else Alignment (P_Type) > A)
+            then
+               A := Alignment (P_Type);
+            end if;
+
+            Fold_Uint (N, A, Static);
+         end;
+
+      ----------------------------------
       -- Max_Size_In_Storage_Elements --
       ----------------------------------
 
@@ -7641,7 +7668,7 @@  package body Sem_Attr is
          end if;
       end Width;
 
-      --  The following attributes denote function that cannot be folded
+      --  The following attributes denote functions that cannot be folded
 
       when Attribute_From_Any |
            Attribute_To_Any   |
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 165687)
+++ snames.ads-tmpl	(working copy)
@@ -764,6 +764,7 @@  package Snames is
    Name_Machine_Rounds                 : constant Name_Id := N + $;
    Name_Machine_Size                   : constant Name_Id := N + $; -- GNAT
    Name_Mantissa                       : constant Name_Id := N + $; -- Ada 83
+   Name_Max_Alignment_For_Allocation   : constant Name_Id := N + $; -- Ada 12
    Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + $;
    Name_Maximum_Alignment              : constant Name_Id := N + $; -- GNAT
    Name_Mechanism_Code                 : constant Name_Id := N + $; -- GNAT
@@ -1282,6 +1283,7 @@  package Snames is
       Attribute_Machine_Rounds,
       Attribute_Machine_Size,
       Attribute_Mantissa,
+      Attribute_Max_Alignment_For_Allocation,
       Attribute_Max_Size_In_Storage_Elements,
       Attribute_Maximum_Alignment,
       Attribute_Mechanism_Code,