re PR fortran/30115 (allocate() interface pessimizes aliasing)

2006-12-13  Richard Guenther  <rguenther@suse.de>

	PR fortran/30115
	* runtime/memory.c (allocate_size): Change interface to
	void *()(size_t, GFC_INTEGER_4 *).
	(allocate): Likewise.
	(allocate64): Likewise.
	(allocate_array): Change interface to
	void *()(void *, size_t, GFC_INTEGER_4 *).
	(allocate64_array): Likewise.
	(deallocate): Change interface to
	void ()(void *, GFC_INTEGER_4 *).

	* trans-array.c (gfc_array_allocate): Adjust for changed
	library interface.
	(gfc_array_deallocate): Likewise.
	(gfc_trans_dealloc_allocated): Likewise.
	* trans-stmt.c (gfc_trans_allocate): Likewise.
	(gfc_trans_deallocate): Likewise.
	* trans-decl.c (gfc_build_builtin_function_decls): Adjust
	function declarations to match the library changes.  Mark
	allocation functions with DECL_IS_MALLOC.

From-SVN: r119822

6 files changed, 108 insertions, 98 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eb9efa1b9cd..fdc054ecfc4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2006-12-13  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/30115
+	* trans-array.c (gfc_array_allocate): Adjust for changed
+	library interface.
+	(gfc_array_deallocate): Likewise.
+	(gfc_trans_dealloc_allocated): Likewise.
+	* trans-stmt.c (gfc_trans_allocate): Likewise.
+	(gfc_trans_deallocate): Likewise.
+	* trans-decl.c (gfc_build_builtin_function_decls): Adjust
+	function declarations to match the library changes.  Mark
+	allocation functions with DECL_IS_MALLOC.
+
 2006-12-12  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* trans-expr.c (gfc_conv_substring): Check for empty substring.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index bfd0600b582..b65ec748f47 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3355,8 +3355,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 			      lower, upper, &se->pre);
 
   /* Allocate memory to store the data.  */
-  tmp = gfc_conv_descriptor_data_addr (se->expr);
-  pointer = gfc_evaluate_now (tmp, &se->pre);
+  pointer = gfc_conv_descriptor_data_get (se->expr);
+  STRIP_NOPS (pointer);
 
   if (TYPE_PRECISION (gfc_array_index_type) == 32)
     {
@@ -3375,10 +3375,14 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
   else
     gcc_unreachable ();
 
-  tmp = gfc_chainon_list (NULL_TREE, pointer);
+  tmp = NULL_TREE;
+  /* The allocate_array variants take the old pointer as first argument.  */
+  if (allocatable_array)
+    tmp = gfc_chainon_list (tmp, pointer);
   tmp = gfc_chainon_list (tmp, size);
   tmp = gfc_chainon_list (tmp, pstat);
   tmp = build_function_call_expr (allocate, tmp);
+  tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
   gfc_add_expr_to_block (&se->pre, tmp);
 
   tmp = gfc_conv_descriptor_offset (se->expr);
@@ -3409,8 +3413,8 @@ gfc_array_deallocate (tree descriptor, tree pstat)
 
   gfc_start_block (&block);
   /* Get a pointer to the data.  */
-  tmp = gfc_conv_descriptor_data_addr (descriptor);
-  var = gfc_evaluate_now (tmp, &block);
+  var = gfc_conv_descriptor_data_get (descriptor);
+  STRIP_NOPS (var);
 
   /* Parameter is the address of the data component.  */
   tmp = gfc_chainon_list (NULL_TREE, var);
@@ -3418,6 +3422,11 @@ gfc_array_deallocate (tree descriptor, tree pstat)
   tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
+  /* Zero the data pointer.  */
+  tmp = build2 (MODIFY_EXPR, void_type_node,
+                var, build_int_cst (TREE_TYPE (var), 0));
+  gfc_add_expr_to_block (&block, tmp);
+
   return gfc_finish_block (&block);
 }
 
@@ -4690,8 +4699,8 @@ gfc_trans_dealloc_allocated (tree descriptor)
 
   gfc_start_block (&block);
 
-  tmp = gfc_conv_descriptor_data_addr (descriptor);
-  var = gfc_evaluate_now (tmp, &block);
+  var = gfc_conv_descriptor_data_get (descriptor);
+  STRIP_NOPS (var);
   tmp = gfc_create_var (gfc_array_index_type, NULL);
   ptr = build_fold_addr_expr (tmp);
 
@@ -4702,6 +4711,12 @@ gfc_trans_dealloc_allocated (tree descriptor)
   tmp = gfc_chainon_list (tmp, ptr);
   tmp = build_function_call_expr (gfor_fndecl_deallocate, tmp);
   gfc_add_expr_to_block (&block, tmp);
+
+  /* Zero the data pointer.  */
+  tmp = build2 (MODIFY_EXPR, void_type_node,
+		var, build_int_cst (TREE_TYPE (var), 0));
+  gfc_add_expr_to_block (&block, tmp);
+
   return gfc_finish_block (&block);
 }
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 67e654c9751..815b15e1016 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2304,27 +2304,31 @@ gfc_build_builtin_function_decls (void)
 
   gfor_fndecl_allocate =
     gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
-				     void_type_node, 2, ppvoid_type_node,
-				     gfc_int4_type_node);
+				     pvoid_type_node, 2,
+				     gfc_int4_type_node, gfc_pint4_type_node);
+  DECL_IS_MALLOC (gfor_fndecl_allocate) = 1;
 
   gfor_fndecl_allocate64 =
     gfc_build_library_function_decl (get_identifier (PREFIX("allocate64")),
-				     void_type_node, 2, ppvoid_type_node,
-				     gfc_int8_type_node);
+				     pvoid_type_node, 2,
+				     gfc_int8_type_node, gfc_pint4_type_node);
+  DECL_IS_MALLOC (gfor_fndecl_allocate64) = 1;
 
   gfor_fndecl_allocate_array =
     gfc_build_library_function_decl (get_identifier (PREFIX("allocate_array")),
-				     void_type_node, 2, ppvoid_type_node,
-				     gfc_int4_type_node);
+				     pvoid_type_node, 3, pvoid_type_node,
+				     gfc_int4_type_node, gfc_pint4_type_node);
+  DECL_IS_MALLOC (gfor_fndecl_allocate_array) = 1;
 
   gfor_fndecl_allocate64_array =
     gfc_build_library_function_decl (get_identifier (PREFIX("allocate64_array")),
-				     void_type_node, 2, ppvoid_type_node,
-				     gfc_int8_type_node);
+				     pvoid_type_node, 3, pvoid_type_node,
+				     gfc_int8_type_node, gfc_pint4_type_node);
+  DECL_IS_MALLOC (gfor_fndecl_allocate64_array) = 1;
 
   gfor_fndecl_deallocate =
     gfc_build_library_function_decl (get_identifier (PREFIX("deallocate")),
-				     void_type_node, 2, ppvoid_type_node,
+				     void_type_node, 2, pvoid_type_node,
 				     gfc_pint4_type_node);
 
   gfor_fndecl_stop_numeric =
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 03ff0fee92b..df853ec264b 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3571,21 +3571,15 @@ gfc_trans_allocate (gfc_code * code)
       if (!gfc_array_allocate (&se, expr, pstat))
 	{
 	  /* A scalar or derived type.  */
-	  tree val;
-
-	  val = gfc_create_var (ppvoid_type_node, "ptr");
-	  tmp = gfc_build_addr_expr (ppvoid_type_node, se.expr);
-	  gfc_add_modify_expr (&se.pre, val, tmp);
-
 	  tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
 
 	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
 	    tmp = se.string_length;
 
-	  parm = gfc_chainon_list (NULL_TREE, val);
-	  parm = gfc_chainon_list (parm, tmp);
+	  parm = gfc_chainon_list (NULL_TREE, tmp);
 	  parm = gfc_chainon_list (parm, pstat);
 	  tmp = build_function_call_expr (gfor_fndecl_allocate, parm);
+	  tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, tmp);
 	  gfc_add_expr_to_block (&se.pre, tmp);
 
 	  if (code->expr)
@@ -3650,7 +3644,7 @@ gfc_trans_deallocate (gfc_code * code)
   gfc_se se;
   gfc_alloc *al;
   gfc_expr *expr;
-  tree apstat, astat, parm, pstat, stat, tmp, type, var;
+  tree apstat, astat, parm, pstat, stat, tmp;
   stmtblock_t block;
 
   gfc_start_block (&block);
@@ -3713,14 +3707,13 @@ gfc_trans_deallocate (gfc_code * code)
 	tmp = gfc_array_deallocate (se.expr, pstat);
       else
 	{
-	  type = build_pointer_type (TREE_TYPE (se.expr));
-	  var = gfc_create_var (type, "ptr");
-	  tmp = gfc_build_addr_expr (type, se.expr);
-	  gfc_add_modify_expr (&se.pre, var, tmp);
-
-	  parm = gfc_chainon_list (NULL_TREE, var);
+	  parm = gfc_chainon_list (NULL_TREE, se.expr);
 	  parm = gfc_chainon_list (parm, pstat);
 	  tmp = build_function_call_expr (gfor_fndecl_deallocate, parm);
+	  gfc_add_expr_to_block (&se.pre, tmp);
+
+	  tmp = build2 (MODIFY_EXPR, void_type_node,
+			se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
 	}
 
       gfc_add_expr_to_block (&se.pre, tmp);
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6d9739a6f8c..d80cf70f170 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,16 @@
+2006-12-13  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/30115
+	* runtime/memory.c (allocate_size): Change interface to
+	void *()(size_t, GFC_INTEGER_4 *).
+	(allocate): Likewise.
+	(allocate64): Likewise.
+	(allocate_array): Change interface to
+	void *()(void *, size_t, GFC_INTEGER_4 *).
+	(allocate64_array): Likewise.
+	(deallocate): Change interface to
+	void ()(void *, GFC_INTEGER_4 *).
+
 2006-12-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR libfortran/29810
diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c
index 43a72e3f1b2..b38d062669f 100644
--- a/libgfortran/runtime/memory.c
+++ b/libgfortran/runtime/memory.c
@@ -174,133 +174,110 @@ internal_realloc64 (void *mem, GFC_INTEGER_8 size)
 /* User-allocate, one call for each member of the alloc-list of an
    ALLOCATE statement. */
 
-static void
-allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat)
+static void *
+allocate_size (size_t size, GFC_INTEGER_4 * stat)
 {
   void *newmem;
 
-  if (!mem)
-    runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
-
   newmem = malloc (size ? size : 1);
   if (!newmem)
     {
       if (stat)
 	{
 	  *stat = 1;
-	  return;
+	  return newmem;
 	}
       else
 	runtime_error ("ALLOCATE: Out of memory.");
     }
 
-  (*mem) = newmem;
-
   if (stat)
     *stat = 0;
+
+  return newmem;
 }
 
-extern void allocate (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
+extern void *allocate (GFC_INTEGER_4, GFC_INTEGER_4 *);
 export_proto(allocate);
 
-void
-allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
+void *
+allocate (GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 {
   if (size < 0)
-    {
-      runtime_error ("Attempt to allocate negative amount of memory.  "
-		     "Possible integer overflow");
-      abort ();
-    }
+    runtime_error ("Attempt to allocate negative amount of memory.  "
+		   "Possible integer overflow");
 
-  allocate_size (mem, (size_t) size, stat);
+  return allocate_size ((size_t) size, stat);
 }
 
-extern void allocate64 (void **, GFC_INTEGER_8, GFC_INTEGER_4 *);
+extern void *allocate64 (GFC_INTEGER_8, GFC_INTEGER_4 *);
 export_proto(allocate64);
 
-void
-allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
+void *
+allocate64 (GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 {
   if (size < 0)
-    {
-      runtime_error
-	("ALLOCATE64: Attempt to allocate negative amount of memory. "
-	 "Possible integer overflow");
-      abort ();
-    }
+    runtime_error ("ALLOCATE64: Attempt to allocate negative amount of "
+		   "memory. Possible integer overflow");
 
-  allocate_size (mem, (size_t) size, stat);
+  return allocate_size ((size_t) size, stat);
 }
 
 /* Function to call in an ALLOCATE statement when the argument is an
    allocatable array.  If the array is currently allocated, it is
    an error to allocate it again.  32-bit version.  */
 
-extern void allocate_array (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
+extern void *allocate_array (void *, GFC_INTEGER_4, GFC_INTEGER_4 *);
 export_proto(allocate_array);
 
-void
-allocate_array (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
+void *
+allocate_array (void *mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 {
-  if (*mem == NULL)
-    {
-      allocate (mem, size, stat);
-      return;
-    }
+  if (mem == NULL)
+    return allocate (size, stat);
   if (stat)
     {
-      free (*mem);
-      allocate (mem, size, stat);
+      free (mem);
+      mem = allocate (size, stat);
       *stat = ERROR_ALLOCATION;
-      return;
+      return mem;
     }
-  else
-    runtime_error ("Attempting to allocate already allocated array.");
 
-  return;
+  runtime_error ("Attempting to allocate already allocated array.");
 }
 
 /* Function to call in an ALLOCATE statement when the argument is an
    allocatable array.  If the array is currently allocated, it is
    an error to allocate it again.  64-bit version.  */
 
-extern void allocate64_array (void **, GFC_INTEGER_8, GFC_INTEGER_4 *);
+extern void *allocate64_array (void *, GFC_INTEGER_8, GFC_INTEGER_4 *);
 export_proto(allocate64_array);
 
-void
-allocate64_array (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
+void *
+allocate64_array (void *mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 {
-  if (*mem == NULL)
-    {
-      allocate64 (mem, size, stat);
-      return;
-    }
+  if (mem == NULL)
+    return allocate64 (size, stat);
   if (stat)
     {
-      free (*mem);
-      allocate (mem, size, stat);
+      free (mem);
+      mem = allocate (size, stat);
       *stat = ERROR_ALLOCATION;
-      return;
+      return mem;
     }
-  else
-    runtime_error ("Attempting to allocate already allocated array.");
 
-  return;
+  runtime_error ("Attempting to allocate already allocated array.");
 }
 
 /* User-deallocate; pointer is NULLified. */
 
-extern void deallocate (void **, GFC_INTEGER_4 *);
+extern void deallocate (void *, GFC_INTEGER_4 *);
 export_proto(deallocate);
 
 void
-deallocate (void **mem, GFC_INTEGER_4 * stat)
+deallocate (void *mem, GFC_INTEGER_4 * stat)
 {
   if (!mem)
-    runtime_error ("Internal: NULL mem pointer in DEALLOCATE.");
-
-  if (!*mem)
     {
       if (stat)
 	{
@@ -308,15 +285,10 @@ deallocate (void **mem, GFC_INTEGER_4 * stat)
 	  return;
 	}
       else
-	{
-	  runtime_error
-	    ("Internal: Attempt to DEALLOCATE unallocated memory.");
-	  abort ();
-	}
+	runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
     }
 
-  free (*mem);
-  *mem = NULL;
+  free (mem);
 
   if (stat)
     *stat = 0;