utils2.c (build_call_alloc_dealloc_proc): New helper for…

utils2.c (build_call_alloc_dealloc_proc): New helper for build_call_alloc_dealloc with arguments to be interpreted...

        ada/
        * gcc-interface/utils2.c (build_call_alloc_dealloc_proc): New
        helper for build_call_alloc_dealloc with arguments to be interpreted
        identically.  Process the case where a GNAT_PROC to call is provided.
        (maybe_wrap_malloc): New helper for build_call_alloc_dealloc, to build
        and return an allocator for DATA_SIZE bytes aimed at containing a
        DATA_TYPE object, using the default __gnat_malloc allocator.  Honor
        DATA_TYPE alignments greater than what the latter offers.
        (maybe_wrap_free): New helper for build_call_alloc_dealloc, to
        release a DATA_TYPE object designated by DATA_PTR using the
        __gnat_free entry point.
        (build_call_alloc_dealloc): Expect object data type instead of naked
        alignment constraint. Use the new helpers.
        (build_allocator): Remove special processing for the super-aligned
        case, now handled by build_call_alloc_dealloc.  Pass data type instead
        of the former alignment argument, as expected by the new interface.
        * gcc-interface/gigi.h (build_call_alloc_dealloc): Adjust prototype
        and comment.
        * gcc-interface/trans.c (gnat_to_gnu) <case N_Free_Statement>:
        Remove special processing for the super-aligned case, now handled
        by build_call_alloc_dealloc.  Pass data type instead of the former
        alignment argument, as expected by the new interface.

        testsuite/
        * gnat.dg/align_max.adb: New test.

From-SVN: r148314

gcc/ada/ChangeLog

+2009-06-09  Olivier Hainque  <hainque@adacore.com>
+
+	* gcc-interface/utils2.c (build_call_alloc_dealloc_proc): New
+	helper for build_call_alloc_dealloc with arguments to be interpreted
+	identically.  Process the case where a GNAT_PROC to call is provided.
+	(maybe_wrap_malloc): New helper for build_call_alloc_dealloc, to build
+	and return an allocator for DATA_SIZE bytes aimed at containing a
+	DATA_TYPE object, using the default __gnat_malloc allocator.  Honor
+	DATA_TYPE alignments greater than what the latter offers.
+	(maybe_wrap_free): New helper for build_call_alloc_dealloc, to
+	release a DATA_TYPE object designated by DATA_PTR using	the
+	__gnat_free entry point.
+	(build_call_alloc_dealloc): Expect object data type instead of naked
+	alignment constraint. Use the new helpers.
+	(build_allocator): Remove special processing for the super-aligned
+	case, now handled by build_call_alloc_dealloc.  Pass data
+	type instead of the former alignment argument, as expected by the new
+	interface.
+	* gcc-interface/gigi.h (build_call_alloc_dealloc): Adjust prototype
+	and comment.
+	* gcc-interface/trans.c (gnat_to_gnu) <case N_Free_Statement>:
+	Remove special processing for the super-aligned case, now handled
+	by build_call_alloc_dealloc.  Pass data type instead of	the former
+	alignment argument, as expected by the new interface.
+	
 2009-06-08  Alexandre Oliva  <aoliva@redhat.com>
 
 	* lib-writ.adb (flag_compare_debug): Import.

gcc/ada/gcc-interface/gigi.h

@@ -843,13 +843,13 @@ extern tree build_component_ref (tree record_variable, tree component,
    If GNU_OBJ is nonzero, it is an object to deallocate.  Otherwise,
    generate an allocator.
 
-   GNU_SIZE is the size of the object in bytes and ALIGN is the alignment
-   in bits.  GNAT_PROC, if present, is a procedure to call and GNAT_POOL
-   is the storage pool to use.  If not present, malloc and free are used.
-   GNAT_NODE is used to provide an error location for restriction violation
-   messages.  */
+   GNU_SIZE is the number of bytes to allocate and GNU_TYPE is the contained
+   object type, used to determine the to-be-honored address alignment.
+   GNAT_PROC, if present, is a procedure to call and GNAT_POOL is the storage
+   pool to use.  If not present, malloc and free are used.  GNAT_NODE is used
+   to provide an error location for restriction violation messages.  */
 extern tree build_call_alloc_dealloc (tree gnu_obj, tree gnu_size,
-                                      unsigned align, Entity_Id gnat_proc,
+                                      tree gnu_type, Entity_Id gnat_proc,
 				      Entity_Id gnat_pool, Node_Id gnat_node);
 
 /* Build a GCC tree to correspond to allocating an object of TYPE whose

gcc/ada/gcc-interface/trans.c

@@ -5101,9 +5101,6 @@ gnat_to_gnu (Node_Id gnat_node)
 	  tree gnu_obj_type;
 	  tree gnu_actual_obj_type = 0;
 	  tree gnu_obj_size;
-	  unsigned int align;
-	  unsigned int default_allocator_alignment
-	    = get_target_default_allocator_alignment () * BITS_PER_UNIT;
 
 	  /* If this is a thin pointer, we must dereference it to create
 	     a fat pointer, then go back below to a thin pointer.  The
@@ -5142,7 +5139,6 @@ gnat_to_gnu (Node_Id gnat_node)
 	    gnu_actual_obj_type = gnu_obj_type;
 
 	  gnu_obj_size = TYPE_SIZE_UNIT (gnu_actual_obj_type);
-	  align = TYPE_ALIGN (gnu_obj_type);
 
 	  if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
 	      && TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
@@ -5159,39 +5155,8 @@ gnat_to_gnu (Node_Id gnat_node)
 					 gnu_ptr, gnu_byte_offset);
 	    }
 
- 	  /* If the object was allocated from the default storage pool, the
- 	     alignment was greater than what the allocator provides, and this
- 	     is not a fat or thin pointer, what we have in gnu_ptr here is an
- 	     address dynamically adjusted to match the alignment requirement
- 	     (see build_allocator).  What we need to pass to free is the
- 	     initial allocator's return value, which has been stored just in
- 	     front of the block we have.  */
-
- 	  if (No (Procedure_To_Call (gnat_node))
- 	      && align > default_allocator_alignment
- 	      && ! TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type))
- 	    {
- 	      /* We set GNU_PTR
- 		 as * (void **)((void *)GNU_PTR - (void *)sizeof(void *))
- 		 in two steps:  */
-
- 	      /* GNU_PTR (void *)
-		 = (void *)GNU_PTR - (void *)sizeof (void *))  */
- 	      gnu_ptr
- 		= build_binary_op
-		    (POINTER_PLUS_EXPR, ptr_void_type_node,
-		     convert (ptr_void_type_node, gnu_ptr),
-		     size_int (-POINTER_SIZE/BITS_PER_UNIT));
-
- 	      /* GNU_PTR (void *) = *(void **)GNU_PTR  */
- 	      gnu_ptr
- 		= build_unary_op
-		    (INDIRECT_REF, NULL_TREE,
-		     convert (build_pointer_type (ptr_void_type_node),
-			      gnu_ptr));
- 	    }
-
-	  gnu_result = build_call_alloc_dealloc (gnu_ptr, gnu_obj_size, align,
+	  gnu_result
+	      = build_call_alloc_dealloc (gnu_ptr, gnu_obj_size, gnu_obj_type,
 					  Procedure_To_Call (gnat_node),
 					  Storage_Pool (gnat_node),
 					  gnat_node);

gcc/testsuite/ChangeLog

+2009-06-09  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/align_max.adb: New test.
+
 2009-06-08  Jason Merrill  <jason@redhat.com>
 
 	* g++.dg/cpp0x/auto15.C: New.

gcc/testsuite/gnat.dg/align_max.adb

+--  { dg-do run }
+
+with System.Storage_Elements; use System.Storage_Elements;
+with Ada.Unchecked_Deallocation;
+
+procedure Align_MAX is
+
+   Align : constant := Standard'Maximum_Alignment;
+
+   generic
+      type Data_Type (<>) is private;
+      type Access_Type is access Data_Type;
+      with function Allocate return Access_Type;
+      with function Address (Ptr : Access_Type) return System.Address;
+   package Check is
+      --  The hooks below just force asm generation that helps associating
+      --  obscure nested function names with their package instance name.
+      Hook_Allocate : System.Address := Allocate'Address;
+      Hook_Address : System.Address := Address'Address;
+      pragma Volatile (Hook_Allocate);
+      pragma Volatile (Hook_Address);
+
+      procedure Run (Announce : String);
+   end;
+
+   package body Check is
+
+      procedure Free is new
+        Ada.Unchecked_Deallocation (Data_Type, Access_Type);
+
+      procedure Run (Announce : String) is
+         Addr : System.Address;
+         Blocks : array (1 .. 1024) of Access_Type;
+      begin
+         for J in Blocks'Range loop
+            Blocks (J) := Allocate;
+            Addr := Address (Blocks (J));
+            if Addr mod Data_Type'Alignment /= 0 then
+               raise Program_Error;
+            end if;
+         end loop;
+
+         for J in Blocks'Range loop
+            Free (Blocks (J));
+         end loop;
+      end;
+   end;
+
+begin
+   declare
+      type Array_Type is array (Integer range <>) of Integer;
+      for Array_Type'Alignment use Align;
+
+      type FAT_Array_Access is access all Array_Type;
+
+      function Allocate return FAT_Array_Access is
+      begin
+         return new Array_Type (1 .. 1);
+      end;
+
+      function Address (Ptr : FAT_Array_Access) return System.Address is
+      begin
+         return Ptr(1)'Address;
+      end;
+      package Check_FAT is new
+        Check (Array_Type, FAT_Array_Access, Allocate, Address);
+   begin
+      Check_FAT.Run ("Checking FAT pointer to UNC array");
+   end;
+
+   declare
+      type Array_Type is array (Integer range <>) of Integer;
+      for Array_Type'Alignment use Align;
+
+      type THIN_Array_Access is access all Array_Type;
+      for THIN_Array_Access'Size use Standard'Address_Size;
+
+      function Allocate return THIN_Array_Access is
+      begin
+         return new Array_Type (1 .. 1);
+      end;
+
+      function Address (Ptr : THIN_Array_Access) return System.Address is
+      begin
+         return Ptr(1)'Address;
+      end;
+      package Check_THIN is new
+        Check (Array_Type, THIN_Array_Access, Allocate, Address);
+   begin
+      Check_THIN.Run ("Checking THIN pointer to UNC array");
+   end;
+
+   declare
+      type Array_Type is array (Integer range 1 .. 1) of Integer;
+      for Array_Type'Alignment use Align;
+
+      type Array_Access is access all Array_Type;
+
+      function Allocate return Array_Access is
+      begin
+         return new Array_Type;
+      end;
+
+      function Address (Ptr : Array_Access) return System.Address is
+      begin
+         return Ptr(1)'Address;
+      end;
+      package Check_Array is new
+        Check (Array_Type, Array_Access, Allocate, Address);
+   begin
+      Check_Array.Run ("Checking pointer to constrained array");
+   end;
+
+   declare
+      type Record_Type is record
+         Value : Integer;
+      end record;
+      for Record_Type'Alignment use Align;
+
+      type Record_Access is access all Record_Type;
+
+      function Allocate return Record_Access is
+      begin
+         return new Record_Type;
+      end;
+
+      function Address (Ptr : Record_Access) return System.Address is
+      begin
+         return Ptr.all'Address;
+      end;
+      package Check_Record is new
+        Check (Record_Type, Record_Access, Allocate, Address);
+   begin
+      Check_Record.Run ("Checking pointer to record");
+   end;
+end;
+