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

4 files changed, 56 insertions, 31 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eb9efa1..fdc054e 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 bfd0600..b65ec74 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 67e654c..815b15e 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 03ff0fe..df853ec 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);