utils2.c (build_call_alloc_dealloc): Move the code retrieving an allocator return value from a super-aligned address...

2007-11-16  Olivier Hainque  <hainque@adacore.com>

        ada/
        * utils2.c (build_call_alloc_dealloc) <if gnu_obj>: Move the code
        retrieving an allocator return value from a super-aligned address from
        here to ...
        * trans.c (gnat_to_gnu) <case N_Free_Statement>: ... here, and don't
        expect a super-aligned address for a fat or thin pointer.

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

From-SVN: r130221

gcc/ada/ChangeLog

@@ -1,3 +1,11 @@
+2007-11-16  Olivier Hainque  <hainque@adacore.com>
+
+	* utils2.c (build_call_alloc_dealloc) <if gnu_obj>: Move the code
+	retrieving an allocator return value from a super-aligned address from
+	here to ...
+	* trans.c (gnat_to_gnu) <case N_Free_Statement>: ... here, and don't
+	expect a super-aligned address for a fat or thin pointer.
+	
 2007-11-14  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* trans.c (call_to_gnu): Always set the source location on the call

gcc/ada/trans.c

@@ -4565,7 +4565,9 @@ gnat_to_gnu (Node_Id gnat_node)
 	  tree gnu_obj_type;
 	  tree gnu_actual_obj_type = 0;
 	  tree gnu_obj_size;
-	  int align;
+	  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
@@ -4621,6 +4623,35 @@ gnat_to_gnu (Node_Id gnat_node)
 					 gnu_ptr, gnu_byte_offset);
 	    }
 
+ 	  /* If the object was allocated from the default storage pool, the
+ 	     alignement 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 (MINUS_EXPR, ptr_void_type_node,
+ 				   convert (ptr_void_type_node, gnu_ptr),
+ 				   convert (ptr_void_type_node,
+ 					    TYPE_SIZE_UNIT (ptr_void_type_node)));
+ 	      
+ 	      /* 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,
 						 Procedure_To_Call (gnat_node),
 						 Storage_Pool (gnat_node),

gcc/ada/utils2.c

@@ -1873,39 +1873,7 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
     }
 
   else if (gnu_obj)
-    {
-      /* If the required alignement was greater than what the default
-	 allocator guarantees, what we have in gnu_obj here is an address
-	 dynamically adjusted to match the requirement (see build_allocator).
-	 What we need to pass to free is the initial underlying allocator's
-	 return value, which has been stored just in front of the block we
-	 have.  */
-
-      unsigned int default_allocator_alignment
-	= get_target_default_allocator_alignment () * BITS_PER_UNIT;
-
-      if (align > default_allocator_alignment)
-	{
-	  /* We set GNU_OBJ
-	     as * (void **)((void *)GNU_OBJ - (void *)sizeof(void *))
-	     in two steps: */
-
-	  /* GNU_OBJ (void *) = (void *)GNU_OBJ - (void *)sizeof (void *))  */
-	  gnu_obj
-	    = build_binary_op (MINUS_EXPR, ptr_void_type_node,
-			       convert (ptr_void_type_node, gnu_obj),
-			       convert (ptr_void_type_node,
-					TYPE_SIZE_UNIT (ptr_void_type_node)));
-
-	  /* GNU_OBJ (void *) = *(void **)GNU_OBJ  */
-	  gnu_obj
-	    = build_unary_op (INDIRECT_REF, NULL_TREE,
-			      convert (build_pointer_type (ptr_void_type_node),
-				       gnu_obj));
-	}
-
-      return build_call_1_expr (free_decl, gnu_obj);
-    }
+    return build_call_1_expr (free_decl, gnu_obj);
 
   /* ??? For now, disable variable-sized allocators in the stack since
      we can't yet gimplify an ALLOCATE_EXPR.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2007-11-16  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/release_unc_maxalign.adb: New test.
+
 2007-11-16  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/34100

gcc/testsuite/gnat.dg/release_unc_maxalign.adb

@@ -0,0 +1,19 @@
+-- { dg-do run }
+
+with Ada.Unchecked_Deallocation;
+
+procedure Release_UNC_Maxalign is
+
+   type List is array (Natural range <>) of Integer;
+   for List'Alignment use Standard'Maximum_Alignment;
+
+   type List_Access is access all List;
+
+   procedure Release is new Ada.Unchecked_Deallocation
+     (Object => List, Name => List_Access);
+
+   My_List : List_Access;
+begin
+   My_List := new List (1 .. 3);
+   Release (My_List);
+end;