builtin-types.def (BT_FN_PTR_PTR_SIZE): New type.

	* builtin-types.def (BT_FN_PTR_PTR_SIZE): New type.
	* builtins.def (BUILT_IN_REALLOC): New builtin.

	* trans-array.c (gfc_grow_array): Use gfc_call_realloc.
	(gfc_array_allocate): Use gfc_allocate_with_status and
	gfc_allocate_array_with_status.
	(gfc_array_deallocate): Use gfc_deallocate_with_status.
	(gfc_trans_dealloc_allocated): Use gfc_deallocate_with_status.
	* trans-stmt.c (gfc_trans_allocate): Use gfc_allocate_with_status.
	(gfc_trans_deallocate): Use gfc_deallocate_with_status.
	* trans.c (gfc_allocate_with_status, gfc_allocate_array_with_status,
	gfc_deallocate_with_status, gfc_call_realloc): New functions.
	* trans.h (gfc_allocate_with_status, gfc_allocate_array_with_status,
	gfc_deallocate_with_status, gfc_call_realloc): New prototypes.
	(gfor_fndecl_internal_realloc, gfor_fndecl_allocate,
	gfor_fndecl_allocate_array, gfor_fndecl_deallocate): Remove.
	* f95-lang.c (gfc_init_builtin_functions): Create decl for
	BUILT_IN_REALLOC.
	* trans-decl.c (gfor_fndecl_internal_realloc,
	gfor_fndecl_allocate, gfor_fndecl_allocate_array,
	gfor_fndecl_deallocate): Remove function decls.
	(gfc_build_builtin_function_decls): Likewise.

	* runtime/memory.c (internal_realloc, allocate, allocate_array,
	deallocate): Remove functions.
	* gfortran.map (_gfortran_allocate, _gfortran_allocate_array,
	_gfortran_deallocate, _gfortran_internal_realloc): Remove symbols.
	* libgfortran.h (error_codes): Add comment.

	* gfortran.dg/alloc_comp_basics_1.f90: Update check.
	* gfortran.dg/alloc_comp_constructor_1.f90: Update check.

From-SVN: r127897

gcc/ChangeLog

+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* gcc/builtin-types.def (BT_FN_PTR_PTR_SIZE): New type.
+	* gcc/builtins.def (BUILT_IN_REALLOC): New builtin.
+
 2007-08-29  Douglas Gregor  <doug.gregor@gmail.com>
 
 	PR c++/33194

gcc/builtin-types.def

@@ -289,6 +289,8 @@ DEF_FUNCTION_TYPE_2 (BT_FN_INT_CONST_STRING_VALIST_ARG,
 		     BT_INT, BT_CONST_STRING, BT_VALIST_ARG)
 DEF_FUNCTION_TYPE_2 (BT_FN_PTR_SIZE_SIZE,
 		     BT_PTR, BT_SIZE, BT_SIZE)
+DEF_FUNCTION_TYPE_2 (BT_FN_PTR_PTR_SIZE,
+		     BT_PTR, BT_PTR, BT_SIZE)
 DEF_FUNCTION_TYPE_2 (BT_FN_COMPLEX_FLOAT_COMPLEX_FLOAT_COMPLEX_FLOAT,
 		     BT_COMPLEX_FLOAT, BT_COMPLEX_FLOAT, BT_COMPLEX_FLOAT)
 DEF_FUNCTION_TYPE_2 (BT_FN_COMPLEX_DOUBLE_COMPLEX_DOUBLE_COMPLEX_DOUBLE,

gcc/builtins.def

@@ -687,6 +687,7 @@ DEF_GCC_BUILTIN        (BUILT_IN_POPCOUNTIMAX, "popcountimax", BT_FN_INT_UINTMAX
 DEF_GCC_BUILTIN        (BUILT_IN_POPCOUNTL, "popcountl", BT_FN_INT_ULONG, ATTR_CONST_NOTHROW_LIST)
 DEF_GCC_BUILTIN        (BUILT_IN_POPCOUNTLL, "popcountll", BT_FN_INT_ULONGLONG, ATTR_CONST_NOTHROW_LIST)
 DEF_GCC_BUILTIN        (BUILT_IN_PREFETCH, "prefetch", BT_FN_VOID_CONST_PTR_VAR, ATTR_NOVOPS_LIST)
+DEF_LIB_BUILTIN        (BUILT_IN_REALLOC, "realloc", BT_FN_PTR_PTR_SIZE, ATTR_NOTHROW_LIST)
 DEF_GCC_BUILTIN        (BUILT_IN_RETURN, "return", BT_FN_VOID_PTR, ATTR_NORETURN_NOTHROW_LIST)
 DEF_GCC_BUILTIN        (BUILT_IN_RETURN_ADDRESS, "return_address", BT_FN_PTR_UINT, ATTR_NULL)
 DEF_GCC_BUILTIN        (BUILT_IN_SAVEREGS, "saveregs", BT_FN_PTR_VAR, ATTR_NULL)

gcc/fortran/ChangeLog

+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-array.c (gfc_grow_array): Use gfc_call_realloc.
+	(gfc_array_allocate): Use gfc_allocate_with_status and
+	gfc_allocate_array_with_status.
+	(gfc_array_deallocate): Use gfc_deallocate_with_status.
+	(gfc_trans_dealloc_allocated): Use gfc_deallocate_with_status.
+	* trans-stmt.c (gfc_trans_allocate): Use gfc_allocate_with_status.
+	(gfc_trans_deallocate): Use gfc_deallocate_with_status.
+	* trans.c (gfc_allocate_with_status, gfc_allocate_array_with_status,
+	gfc_deallocate_with_status, gfc_call_realloc): New functions.
+	* trans.h (gfc_allocate_with_status, gfc_allocate_array_with_status,
+	gfc_deallocate_with_status, gfc_call_realloc): New prototypes.
+	(gfor_fndecl_internal_realloc, gfor_fndecl_allocate,
+	gfor_fndecl_allocate_array, gfor_fndecl_deallocate): Remove.
+	* f95-lang.c (gfc_init_builtin_functions): Create decl for
+	BUILT_IN_REALLOC.
+	* trans-decl.c (gfor_fndecl_internal_realloc,
+	gfor_fndecl_allocate, gfor_fndecl_allocate_array,
+	gfor_fndecl_deallocate): Remove function decls.
+	(gfc_build_builtin_function_decls): Likewise.
+
 2007-08-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/33055

gcc/fortran/f95-lang.c

@@ -1036,6 +1036,12 @@ gfc_init_builtin_functions (void)
 		      "malloc", false);
   DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
 
+  tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
+  tmp = tree_cons (NULL_TREE, size_type_node, tmp);
+  ftype = build_function_type (pvoid_type_node, tmp);
+  gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
+		      "realloc", false);
+
   tmp = tree_cons (NULL_TREE, void_type_node, void_list_node);
   ftype = build_function_type (integer_type_node, tmp);
   gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,

gcc/fortran/trans-array.c

@@ -843,17 +843,11 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
   /* Calculate the new array size.  */
   size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
   tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node);
-  arg1 = build2 (MULT_EXPR, gfc_array_index_type, tmp,
-		 fold_convert (gfc_array_index_type, size));
+  arg1 = build2 (MULT_EXPR, size_type_node, fold_convert (size_type_node, tmp),
+		 fold_convert (size_type_node, size));
 
-  /* Pick the realloc function.  */
-  if (gfc_index_integer_kind == 4 || gfc_index_integer_kind == 8)
-    tmp = gfor_fndecl_internal_realloc;
-  else
-    gcc_unreachable ();
-
-  /* Set the new data pointer.  */
-  tmp = build_call_expr (tmp, 2, arg0, arg1);
+  /* Call the realloc() function.  */
+  tmp = gfc_call_realloc (pblock, arg0, arg1);
   gfc_conv_descriptor_data_set (pblock, desc, tmp);
 }
 
@@ -3571,7 +3565,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 {
   tree tmp;
   tree pointer;
-  tree allocate;
   tree offset;
   tree size;
   gfc_expr **lower;
@@ -3629,22 +3622,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
   pointer = gfc_conv_descriptor_data_get (se->expr);
   STRIP_NOPS (pointer);
 
-  if (TYPE_PRECISION (gfc_array_index_type) == 32 ||
-      TYPE_PRECISION (gfc_array_index_type) == 64)
-    {
-      if (allocatable_array)
-	allocate = gfor_fndecl_allocate_array;
-      else
-	allocate = gfor_fndecl_allocate;
-    }
-  else
-    gcc_unreachable ();
-
   /* The allocate_array variants take the old pointer as first argument.  */
   if (allocatable_array)
-    tmp = build_call_expr (allocate, 3, pointer, size, pstat);
+    tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat);
   else
-    tmp = build_call_expr (allocate, 2, size, pstat);
+    tmp = gfc_allocate_with_status (&se->pre, size, pstat);
   tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
   gfc_add_expr_to_block (&se->pre, tmp);
 
@@ -3680,7 +3662,7 @@ gfc_array_deallocate (tree descriptor, tree pstat)
   STRIP_NOPS (var);
 
   /* Parameter is the address of the data component.  */
-  tmp = build_call_expr (gfor_fndecl_deallocate, 2, var, pstat);
+  tmp = gfc_deallocate_with_status (var, pstat, false);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer.  */
@@ -4998,7 +4980,6 @@ tree
 gfc_trans_dealloc_allocated (tree descriptor)
 { 
   tree tmp;
-  tree ptr;
   tree var;
   stmtblock_t block;
 
@@ -5006,13 +4987,11 @@ gfc_trans_dealloc_allocated (tree descriptor)
 
   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);
 
-  /* Call array_deallocate with an int* present in the second argument.
+  /* Call array_deallocate with an int * present in the second argument.
      Although it is ignored here, it's presence ensures that arrays that
      are already deallocated are ignored.  */
-  tmp = build_call_expr (gfor_fndecl_deallocate, 2, var, ptr);
+  tmp = gfc_deallocate_with_status (var, NULL_TREE, true);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer.  */

gcc/fortran/trans-decl.c

@@ -73,10 +73,6 @@ tree gfc_static_ctors;
 
 /* Function declarations for builtin library functions.  */
 
-tree gfor_fndecl_internal_realloc;
-tree gfor_fndecl_allocate;
-tree gfor_fndecl_allocate_array;
-tree gfor_fndecl_deallocate;
 tree gfor_fndecl_pause_numeric;
 tree gfor_fndecl_pause_string;
 tree gfor_fndecl_stop_numeric;
@@ -2273,35 +2269,10 @@ void
 gfc_build_builtin_function_decls (void)
 {
   tree gfc_int4_type_node = gfc_get_int_type (4);
-  tree gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node);
-
-  gfor_fndecl_internal_realloc =
-    gfc_build_library_function_decl (get_identifier
-				     (PREFIX("internal_realloc")),
-				     pvoid_type_node, 2, pvoid_type_node,
-				     gfc_array_index_type);
-
-  gfor_fndecl_allocate =
-    gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
-				     pvoid_type_node, 2,
-				     gfc_array_index_type, gfc_pint4_type_node);
-  DECL_IS_MALLOC (gfor_fndecl_allocate) = 1;
-
-  gfor_fndecl_allocate_array =
-    gfc_build_library_function_decl (get_identifier (PREFIX("allocate_array")),
-				     pvoid_type_node, 3, pvoid_type_node,
-				     gfc_array_index_type, gfc_pint4_type_node);
-  DECL_IS_MALLOC (gfor_fndecl_allocate_array) = 1;
-
-  gfor_fndecl_deallocate =
-    gfc_build_library_function_decl (get_identifier (PREFIX("deallocate")),
-				     void_type_node, 2, pvoid_type_node,
-				     gfc_pint4_type_node);
 
   gfor_fndecl_stop_numeric =
     gfc_build_library_function_decl (get_identifier (PREFIX("stop_numeric")),
 				     void_type_node, 1, gfc_int4_type_node);
-
   /* Stop doesn't return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1;
 

gcc/fortran/trans-stmt.c

@@ -3565,11 +3565,7 @@ gfc_trans_allocate (gfc_code * code)
       TREE_USED (error_label) = 1;
     }
   else
-    {
-      pstat = integer_zero_node;
-      stat = error_label = NULL_TREE;
-    }
-
+    pstat = stat = error_label = NULL_TREE;
 
   for (al = code->ext.alloc_list; al != NULL; al = al->next)
     {
@@ -3590,7 +3586,7 @@ gfc_trans_allocate (gfc_code * code)
 	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
 	    tmp = se.string_length;
 
-	  tmp = build_call_expr (gfor_fndecl_allocate, 2, tmp, pstat);
+	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
 	  tmp = build2 (MODIFY_EXPR, void_type_node, se.expr,
 			fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);
@@ -3679,10 +3675,7 @@ gfc_trans_deallocate (gfc_code * code)
       gfc_add_modify_expr (&block, astat, build_int_cst (TREE_TYPE (astat), 0));
     }
   else
-    {
-      pstat = apstat = null_pointer_node;
-      stat = astat = NULL_TREE;
-    }
+    pstat = apstat = stat = astat = NULL_TREE;
 
   for (al = code->ext.alloc_list; al != NULL; al = al->next)
     {
@@ -3720,7 +3713,7 @@ gfc_trans_deallocate (gfc_code * code)
 	tmp = gfc_array_deallocate (se.expr, pstat);
       else
 	{
-	  tmp = build_call_expr (gfor_fndecl_deallocate, 2, se.expr, pstat);
+	  tmp = gfc_deallocate_with_status (se.expr, pstat, false);
 	  gfc_add_expr_to_block (&se.pre, tmp);
 
 	  tmp = build2 (MODIFY_EXPR, void_type_node,

gcc/fortran/trans.h

@@ -450,6 +450,18 @@ tree gfc_call_free (tree);
 /* Allocate memory after performing a few checks.  */
 tree gfc_call_malloc (stmtblock_t *, tree, tree);
 
+/* Allocate memory for arrays, with optional status variable.  */
+tree gfc_allocate_array_with_status (stmtblock_t *, tree, tree, tree);
+
+/* Allocate memory, with optional status variable.  */
+tree gfc_allocate_with_status (stmtblock_t *, tree, tree);
+
+/* Generate code to deallocate an array.  */
+tree gfc_deallocate_with_status (tree, tree, bool);
+
+/* Generate code to call realloc().  */
+tree gfc_call_realloc (stmtblock_t *, tree, tree);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool);
 
@@ -483,10 +495,6 @@ struct gimplify_omp_ctx;
 void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
 
 /* Runtime library function decls.  */
-extern GTY(()) tree gfor_fndecl_internal_realloc;
-extern GTY(()) tree gfor_fndecl_allocate;
-extern GTY(()) tree gfor_fndecl_allocate_array;
-extern GTY(()) tree gfor_fndecl_deallocate;
 extern GTY(()) tree gfor_fndecl_pause_numeric;
 extern GTY(()) tree gfor_fndecl_pause_string;
 extern GTY(()) tree gfor_fndecl_stop_numeric;

gcc/testsuite/ChangeLog

+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* gfortran.dg/alloc_comp_basics_1.f90: Update check.
+	* gfortran.dg/alloc_comp_constructor_1.f90: Update check.
+
 2007-08-29  Douglas Gregor  <doug.gregor@gmail.com>
 
 	PR c++/33194

gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90

@@ -139,6 +139,6 @@ contains
     end subroutine check_alloc2
 
 end program alloc
-! { dg-final { scan-tree-dump-times "deallocate" 24 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 24 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
 ! { dg-final { cleanup-modules "alloc_m" } }

gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90

@@ -104,5 +104,5 @@ contains
     end function blaha
 
 end program test_constructor
-! { dg-final { scan-tree-dump-times "deallocate" 18 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }

libgfortran/ChangeLog

+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* runtime/memory.c (internal_realloc, allocate, allocate_array,
+	deallocate): Remove functions.
+	* gfortran.map (_gfortran_allocate, _gfortran_allocate_array,
+	_gfortran_deallocate, _gfortran_internal_realloc): Remove symbols.
+	* libgfortran.h (error_codes): Add comment.
+
 2007-08-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/33055

libgfortran/gfortran.map

@@ -11,8 +11,6 @@ GFORTRAN_1.0 {
     _gfortran_all_l16;
     _gfortran_all_l4;
     _gfortran_all_l8;
-    _gfortran_allocate;
-    _gfortran_allocate_array;
     _gfortran_any_l16;
     _gfortran_any_l4;
     _gfortran_any_l8;
@@ -60,7 +58,6 @@ GFORTRAN_1.0 {
     _gfortran_ctime;
     _gfortran_ctime_sub;
     _gfortran_date_and_time;
-    _gfortran_deallocate;
     _gfortran_eoshift0_1;
     _gfortran_eoshift0_1_char;
     _gfortran_eoshift0_2;
@@ -167,7 +164,6 @@ GFORTRAN_1.0 {
     _gfortran_ierrno_i4;
     _gfortran_ierrno_i8;
     _gfortran_internal_pack;
-    _gfortran_internal_realloc;
     _gfortran_internal_unpack;
     _gfortran_irand;
     _gfortran_isatty_l4;

libgfortran/libgfortran.h

@@ -447,7 +447,9 @@ typedef enum
   ERROR_READ_OVERFLOW,
   ERROR_INTERNAL,
   ERROR_INTERNAL_UNIT,
-  ERROR_ALLOCATION,
+  ERROR_ALLOCATION,		/* Keep in sync with value used in
+				   gcc/fortran/trans.c
+				   (gfc_allocate_array_with_status).  */
   ERROR_DIRECT_EOR,
   ERROR_SHORT_RECORD,
   ERROR_CORRUPT_FILE,

libgfortran/runtime/memory.c

@@ -38,10 +38,6 @@ Boston, MA 02110-1301, USA.  */
    performance is desired, but it can help when you're debugging code.  */
 /* #define GFC_CLEAR_MEMORY */
 
-/* If GFC_CHECK_MEMORY is defined, we do some sanity checks at runtime.
-   This causes small overhead, but again, it also helps debugging.  */
-#define GFC_CHECK_MEMORY
-
 void *
 get_mem (size_t n)
 {
@@ -76,123 +72,3 @@ internal_malloc_size (size_t size)
 
   return get_mem (size);
 }
-
-
-/* Reallocate internal memory MEM so it has SIZE bytes of data.
-   Allocate a new block if MEM is zero, and free the block if
-   SIZE is 0.  */
-
-extern void *internal_realloc (void *, index_type);
-export_proto(internal_realloc);
-
-void *
-internal_realloc (void *mem, index_type size)
-{
-#ifdef GFC_CHECK_MEMORY
-  /* Under normal circumstances, this is _never_ going to happen!  */
-  if (size < 0)
-    runtime_error ("Attempt to allocate a negative amount of memory.");
-#endif
-  mem = realloc (mem, size);
-  if (!mem && size != 0)
-    os_error ("Out of memory.");
-  
-  if (size == 0)
-      return NULL;
-
-  return mem;
-}
-
-
-/* User-allocate, one call for each member of the alloc-list of an
-   ALLOCATE statement. */
-
-extern void *allocate (index_type, GFC_INTEGER_4 *) __attribute__ ((malloc));
-export_proto(allocate);
-
-void *
-allocate (index_type size, GFC_INTEGER_4 * stat)
-{
-  void *newmem;
-
-#ifdef GFC_CHECK_MEMORY
-  /* The only time this can happen is the size computed by the
-     frontend wraps around.  */
-  if (size < 0)
-    {
-      if (stat)
-	{
-	  *stat = ERROR_ALLOCATION;
-	  return NULL;
-	}
-      else
-	runtime_error ("Attempt to allocate negative amount of memory. "
-		       "Possible integer overflow");
-    }
-#endif
-  newmem = malloc (size ? size : 1);
-  if (!newmem)
-    {
-      if (stat)
-	{
-	  *stat = ERROR_ALLOCATION;
-	  return newmem;
-	}
-      else
-	runtime_error ("ALLOCATE: Out of memory.");
-    }
-
-  if (stat)
-    *stat = 0;
-
-  return newmem;
-}
-
-/* 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.  */
-
-extern void *allocate_array (void *, index_type, GFC_INTEGER_4 *);
-export_proto(allocate_array);
-
-void *
-allocate_array (void *mem, index_type size, GFC_INTEGER_4 * stat)
-{
-  if (mem == NULL)
-    return allocate (size, stat);
-  if (stat)
-    {
-      free (mem);
-      mem = allocate (size, stat);
-      *stat = ERROR_ALLOCATION;
-      return mem;
-    }
-
-  runtime_error ("Attempting to allocate already allocated array.");
-}
-
-
-/* User-deallocate; pointer is then NULLified by the front-end. */
-
-extern void deallocate (void *, GFC_INTEGER_4 *);
-export_proto(deallocate);
-
-void
-deallocate (void *mem, GFC_INTEGER_4 * stat)
-{
-  if (!mem)
-    {
-      if (stat)
-	{
-	  *stat = 1;
-	  return;
-	}
-      else
-	runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
-    }
-
-  free (mem);
-
-  if (stat)
-    *stat = 0;
-}