re PR fortran/30723 (Freeing memory doesn't need to call a library function)

       PR fortran/30723

	* trans.h (gfor_fndecl_internal_malloc, gfor_fndecl_internal_malloc64,
	gfor_fndecl_internal_free): Remove prototypes.
	(gfor_fndecl_os_error, gfc_call_free, gfc_call_malloc): Add prototypes.
	* trans.c (gfc_call_malloc, gfc_call_free): New functions.
	* f95-lang.c (gfc_init_builtin_functions): Add __builtin_free
	and __builtin_malloc builtins.
	* trans-decl.c (gfor_fndecl_internal_malloc,
	gfor_fndecl_internal_malloc64, gfor_fndecl_internal_free): Remove.
	(gfor_fndecl_os_error): Add.
	(gfc_build_builtin_function_decls): Don't create internal_malloc,
	internal_malloc64 and internal_free library function declaration.
	Create os_error library call function declaration.
	* trans-array.c (gfc_trans_allocate_array_storage,
	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
	gfc_conv_array_parameter, gfc_duplicate_allocatable): Use
	gfc_call_malloc and gfc_call_free instead of building calls to
	internal_malloc and internal_free.
	* trans-expr.c (gfc_conv_string_tmp): Likewise.
	* trans-stmt.c (gfc_do_allocate, gfc_trans_assign_need_temp,
	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
	gfc_trans_where_2: Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
	gfc_conv_intrinsic_fdate, gfc_conv_intrinsic_ttynam,
	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_trim): Likewise.

	* runtime/memory.c (internal_malloc, internal_malloc64,
	internal_free): Remove.
	* runtime/error.c (os_error): Export function.
	* intrinsics/move_alloc.c: Include stdlib.h.
	(move_alloc): Call free instead of internal_free.
	(move_alloc_c): Wrap long lines.
	* libgfortran.h (os_error): Export prototype.
	(internal_free): Remove prototype.
	* gfortran.map (GFORTRAN_1.0): Remove _gfortran_internal_free,
	_gfortran_internal_malloc and _gfortran_internal_malloc64.
	Add _gfortran_os_error.

From-SVN: r124721

gcc/fortran/ChangeLog

 2007-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+	PR fortran/30723
+	* trans.h (gfor_fndecl_internal_malloc, gfor_fndecl_internal_malloc64,
+	gfor_fndecl_internal_free): Remove prototypes.
+	(gfor_fndecl_os_error, gfc_call_free, gfc_call_malloc): Add prototypes.
+	* trans.c (gfc_call_malloc, gfc_call_free): New functions.
+	* f95-lang.c (gfc_init_builtin_functions): Add __builtin_free
+	and __builtin_malloc builtins.
+	* trans-decl.c (gfor_fndecl_internal_malloc,
+	gfor_fndecl_internal_malloc64, gfor_fndecl_internal_free): Remove.
+	(gfor_fndecl_os_error): Add.
+	(gfc_build_builtin_function_decls): Don't create internal_malloc,
+	internal_malloc64 and internal_free library function declaration.
+	Create os_error library call function declaration.
+	* trans-array.c (gfc_trans_allocate_array_storage,
+	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
+	gfc_conv_array_parameter, gfc_duplicate_allocatable): Use
+	gfc_call_malloc and gfc_call_free instead of building calls to
+	internal_malloc and internal_free.
+	* trans-expr.c (gfc_conv_string_tmp): Likewise.
+	* trans-stmt.c (gfc_do_allocate, gfc_trans_assign_need_temp,
+	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
+	gfc_trans_where_2: Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
+	gfc_conv_intrinsic_fdate, gfc_conv_intrinsic_ttynam,
+	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_trim): Likewise.
+
+2007-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
 	PR fortran/31725
 	* trans-expr.c (gfc_conv_substring): Evaluate substring bounds
 	only once.

gcc/fortran/f95-lang.c

@@ -988,6 +988,17 @@ gfc_init_builtin_functions (void)
   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
 		      "__builtin_expect", true);
 
+  tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
+  ftype = build_function_type (void_type_node, tmp);
+  gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
+		      "free", false);
+
+  tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+  ftype = build_function_type (pvoid_type_node, tmp);
+  gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
+		      "malloc", false);
+  DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
+
 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
   builtin_types[(int) ENUM] = VALUE;
 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN)		\

gcc/fortran/trans-array.c

@@ -533,13 +533,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
       else
 	{
 	  /* Allocate memory to hold the data.  */
-	  if (gfc_index_integer_kind == 4)
-	    tmp = gfor_fndecl_internal_malloc;
-	  else if (gfc_index_integer_kind == 8)
-	    tmp = gfor_fndecl_internal_malloc64;
-	  else
-	    gcc_unreachable ();
-	  tmp = build_call_expr (tmp, 1, size);
+	  tmp = gfc_call_malloc (pre, NULL, size);
 	  tmp = gfc_evaluate_now (tmp, pre);
 	  gfc_conv_descriptor_data_set (pre, desc, tmp);
 	}
@@ -555,8 +549,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
     {
       /* Free the temporary.  */
       tmp = gfc_conv_descriptor_data_get (desc);
-      tmp = fold_convert (pvoid_type_node, tmp);
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+      tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
       gfc_add_expr_to_block (post, tmp);
     }
 }
@@ -3793,7 +3786,6 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
   stmtblock_t block;
   tree type;
   tree tmp;
-  tree fndecl;
   tree size;
   tree offset;
   bool onstack;
@@ -3857,14 +3849,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
   size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp);
 
   /* Allocate memory to hold the data.  */
-  if (gfc_index_integer_kind == 4)
-    fndecl = gfor_fndecl_internal_malloc;
-  else if (gfc_index_integer_kind == 8)
-    fndecl = gfor_fndecl_internal_malloc64;
-  else
-    gcc_unreachable ();
-  tmp = build_call_expr (fndecl, 1, size);
-  tmp = fold_convert (TREE_TYPE (decl), tmp);
+  tmp = gfc_call_malloc (&block, TREE_TYPE (decl), size);
   gfc_add_modify_expr (&block, decl, tmp);
 
   /* Set offset of the array.  */
@@ -3878,8 +3863,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
   gfc_add_expr_to_block (&block, fnbody);
 
   /* Free the temporary.  */
-  tmp = convert (pvoid_type_node, decl);
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+  tmp = gfc_call_free (convert (pvoid_type_node, decl));
   gfc_add_expr_to_block (&block, tmp);
 
   return gfc_finish_block (&block);
@@ -4235,7 +4219,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
 	}
 
       /* Free the temporary.  */
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmpdesc);
+      tmp = gfc_call_free (tmpdesc);
       gfc_add_expr_to_block (&cleanup, tmp);
 
       stmt = gfc_finish_block (&cleanup);
@@ -4841,8 +4825,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
       gfc_add_expr_to_block (&block, tmp);
 
       /* Free the temporary.  */
-      tmp = convert (pvoid_type_node, ptr);
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+      tmp = gfc_call_free (convert (pvoid_type_node, ptr));
       gfc_add_expr_to_block (&block, tmp);
 
       stmt = gfc_finish_block (&block);
@@ -4942,13 +4925,8 @@ gfc_duplicate_allocatable(tree dest, tree src, tree type, int rank)
 		      TYPE_SIZE_UNIT (gfc_get_element_type (type)));
 
   /* Allocate memory to the destination.  */
-  if (gfc_index_integer_kind == 4)
-    tmp = build_call_expr (gfor_fndecl_internal_malloc, 1, size);
-  else if (gfc_index_integer_kind == 8)
-    tmp = build_call_expr (gfor_fndecl_internal_malloc64, 1, size);
-  else
-    gcc_unreachable ();
-  tmp = fold_convert (TREE_TYPE (gfc_conv_descriptor_data_get (src)), tmp);
+  tmp = gfc_call_malloc (&block, TREE_TYPE (gfc_conv_descriptor_data_get (src)),
+			 size);
   gfc_conv_descriptor_data_set (&block, dest, tmp);
 
   /* We know the temporary and the value will be the same length,

gcc/fortran/trans-decl.c

@@ -74,11 +74,8 @@ tree gfc_static_ctors;
 
 /* Function declarations for builtin library functions.  */
 
-tree gfor_fndecl_internal_malloc;
-tree gfor_fndecl_internal_malloc64;
 tree gfor_fndecl_internal_realloc;
 tree gfor_fndecl_internal_realloc64;
-tree gfor_fndecl_internal_free;
 tree gfor_fndecl_allocate;
 tree gfor_fndecl_allocate64;
 tree gfor_fndecl_allocate_array;
@@ -91,6 +88,7 @@ tree gfor_fndecl_stop_string;
 tree gfor_fndecl_select_string;
 tree gfor_fndecl_runtime_error;
 tree gfor_fndecl_runtime_error_at;
+tree gfor_fndecl_os_error;
 tree gfor_fndecl_generate_error;
 tree gfor_fndecl_set_fpe;
 tree gfor_fndecl_set_std;
@@ -2247,18 +2245,6 @@ gfc_build_builtin_function_decls (void)
   tree gfc_logical4_type_node = gfc_get_logical_type (4);
   tree gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node);
 
-  /* Treat these two internal malloc wrappers as malloc.  */
-  gfor_fndecl_internal_malloc =
-    gfc_build_library_function_decl (get_identifier (PREFIX("internal_malloc")),
-				     pvoid_type_node, 1, gfc_int4_type_node);
-  DECL_IS_MALLOC (gfor_fndecl_internal_malloc) = 1;
-
-  gfor_fndecl_internal_malloc64 =
-    gfc_build_library_function_decl (get_identifier
-				     (PREFIX("internal_malloc64")),
-				     pvoid_type_node, 1, gfc_int8_type_node);
-  DECL_IS_MALLOC (gfor_fndecl_internal_malloc64) = 1;
-
   gfor_fndecl_internal_realloc =
     gfc_build_library_function_decl (get_identifier
 				     (PREFIX("internal_realloc")),
@@ -2271,10 +2257,6 @@ gfc_build_builtin_function_decls (void)
 				     pvoid_type_node, 2, pvoid_type_node,
 				     gfc_int8_type_node);
 
-  gfor_fndecl_internal_free =
-    gfc_build_library_function_decl (get_identifier (PREFIX("internal_free")),
-				     void_type_node, 1, pvoid_type_node);
-
   gfor_fndecl_allocate =
     gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
 				     pvoid_type_node, 2,
@@ -2349,6 +2331,12 @@ gfc_build_builtin_function_decls (void)
 				     void_type_node, 3, pvoid_type_node,
                                      gfc_c_int_type_node, pchar_type_node);
 
+  gfor_fndecl_os_error =
+    gfc_build_library_function_decl (get_identifier (PREFIX("os_error")),
+				     void_type_node, 1, pchar_type_node);
+  /* The runtime_error function does not return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1;
+
   gfor_fndecl_set_fpe =
     gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")),
 				    void_type_node, 1, gfc_c_int_type_node);

gcc/fortran/trans-expr.c

@@ -935,13 +935,11 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
     {
       /* Allocate a temporary to hold the result.  */
       var = gfc_create_var (type, "pstr");
-      tmp = build_call_expr (gfor_fndecl_internal_malloc, 1, len);
-      tmp = convert (type, tmp);
+      tmp = gfc_call_malloc (&se->pre, type, len);
       gfc_add_modify_expr (&se->pre, var, tmp);
 
       /* Free the temporary afterwards.  */
-      tmp = convert (pvoid_type_node, var);
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+      tmp = gfc_call_free (convert (pvoid_type_node, var));
       gfc_add_expr_to_block (&se->post, tmp);
     }
 

gcc/fortran/trans-intrinsic.c

@@ -1275,7 +1275,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
 		 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1310,7 +1310,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
 		 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1347,7 +1347,7 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
 		 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -2866,8 +2866,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
 
 	  /* Free the temporary.  */
 	  gfc_start_block (&block);
-	  tmp = convert (pvoid_type_node, source);
-	  tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+	  tmp = gfc_call_free (convert (pvoid_type_node, source));
 	  gfc_add_expr_to_block (&block, tmp);
 	  stmt = gfc_finish_block (&block);
 
@@ -3364,7 +3363,7 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
 		 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 

gcc/fortran/trans-stmt.c

@@ -1712,14 +1712,7 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
       tmpvar = gfc_create_var (build_pointer_type (type), "temp");
       *pdata = convert (pvoid_type_node, tmpvar);
 
-      if (gfc_index_integer_kind == 4)
-	tmp = gfor_fndecl_internal_malloc;
-      else if (gfc_index_integer_kind == 8)
-	tmp = gfor_fndecl_internal_malloc64;
-      else
-	gcc_unreachable ();
-      tmp = build_call_expr (tmp, 1, bytesize);
-      tmp = convert (TREE_TYPE (tmpvar), tmp);
+      tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar), bytesize);
       gfc_add_modify_expr (pblock, tmpvar, tmp);
     }
   return tmpvar;
@@ -2230,7 +2223,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
   if (ptemp1)
     {
       /* Free the temporary.  */
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, ptemp1);
+      tmp = gfc_call_free (ptemp1);
       gfc_add_expr_to_block (block, tmp);
     }
 }
@@ -2388,7 +2381,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
   /* Free the temporary.  */
   if (ptemp1)
     {
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, ptemp1);
+      tmp = gfc_call_free (ptemp1);
       gfc_add_expr_to_block (block, tmp);
     }
 }
@@ -2723,7 +2716,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
   if (pmask)
     {
       /* Free the temporary for the mask.  */
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, pmask);
+      tmp = gfc_call_free (pmask);
       gfc_add_expr_to_block (&block, tmp);
     }
   if (maskindex)
@@ -3320,14 +3313,14 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
   /* If we allocated a pending mask array, deallocate it now.  */
   if (ppmask)
     {
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, ppmask);
+      tmp = gfc_call_free (ppmask);
       gfc_add_expr_to_block (block, tmp);
     }
 
   /* If we allocated a current mask array, deallocate it now.  */
   if (pcmask)
     {
-      tmp = build_call_expr (gfor_fndecl_internal_free, 1, pcmask);
+      tmp = gfc_call_free (pcmask);
       gfc_add_expr_to_block (block, tmp);
     }
 }

gcc/fortran/trans.c

@@ -29,6 +29,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "toplev.h"
 #include "defaults.h"
 #include "real.h"
+#include "flags.h"
 #include "gfortran.h"
 #include "trans.h"
 #include "trans-stmt.h"
@@ -372,6 +373,86 @@ gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock,
 }
 
 
+/* Call malloc to allocate size bytes of memory, with special conditions:
+      + if size < 0, generate a runtime error,
+      + if size == 0, return a NULL pointer,
+      + if malloc returns NULL, issue a runtime error.  */
+tree
+gfc_call_malloc (stmtblock_t * block, tree type, tree size)
+{
+  tree tmp, msg, negative, zero, malloc_result, null_result, res;
+  stmtblock_t block2;
+
+  size = gfc_evaluate_now (size, block);
+
+  if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
+    size = fold_convert (size_type_node, size);
+
+  /* Create a variable to hold the result.  */
+  res = gfc_create_var (pvoid_type_node, NULL);
+
+  /* size < 0 ?  */
+  negative = fold_build2 (LT_EXPR, boolean_type_node, size,
+			  build_int_cst (size_type_node, 0));
+  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const
+      ("Attempt to allocate a negative amount of memory."));
+  tmp = fold_build3 (COND_EXPR, void_type_node, negative,
+		     build_call_expr (gfor_fndecl_runtime_error, 1, msg),
+		     build_empty_stmt ());
+  gfc_add_expr_to_block (block, tmp);
+
+  /* Call malloc and check the result.  */
+  gfc_start_block (&block2);
+  gfc_add_modify_expr (&block2, res,
+		       build_call_expr (built_in_decls[BUILT_IN_MALLOC], 1,
+		       size));
+  null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
+			     build_int_cst (pvoid_type_node, 0));
+  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const
+      ("Memory allocation failed"));
+  tmp = fold_build3 (COND_EXPR, void_type_node, null_result,
+		     build_call_expr (gfor_fndecl_os_error, 1, msg),
+		     build_empty_stmt ());
+  gfc_add_expr_to_block (&block2, tmp);
+  malloc_result = gfc_finish_block (&block2);
+
+  /* size == 0  */
+  zero = fold_build2 (EQ_EXPR, boolean_type_node, size,
+		      build_int_cst (size_type_node, 0));
+  tmp = fold_build2 (MODIFY_EXPR, pvoid_type_node, res,
+		     build_int_cst (pvoid_type_node, 0));
+  tmp = fold_build3 (COND_EXPR, void_type_node, zero, tmp, malloc_result);
+  gfc_add_expr_to_block (block, tmp);
+
+  if (type != NULL)
+    res = fold_convert (type, res);
+  return res;
+}
+
+
+/* Free a given variable, if it's not NULL.  */
+tree
+gfc_call_free (tree var)
+{
+  stmtblock_t block;
+  tree tmp, cond, call;
+
+  if (TREE_TYPE (var) != TREE_TYPE (pvoid_type_node))
+    var = fold_convert (pvoid_type_node, var);
+
+  gfc_start_block (&block);
+  var = gfc_evaluate_now (var, &block);
+  cond = fold_build2 (NE_EXPR, boolean_type_node, var,
+		      build_int_cst (pvoid_type_node, 0));
+  call = build_call_expr (built_in_decls[BUILT_IN_FREE], 1, var);
+  tmp = fold_build3 (COND_EXPR, void_type_node, cond, call,
+		     build_empty_stmt ());
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
 /* Add a statement to a block.  */
 
 void

gcc/fortran/trans.h

@@ -439,6 +439,12 @@ bool get_array_ctor_strlen (gfc_constructor *, tree *);
 /* Generate a runtime error check.  */
 void gfc_trans_runtime_check (tree, const char *, stmtblock_t *, locus *);
 
+/* Generate a call to free() after checking that its arg is non-NULL.  */
+tree gfc_call_free (tree);
+
+/* Allocate memory after performing a few checks.  */
+tree gfc_call_malloc (stmtblock_t *, tree, tree);
+
 /* Generate code for an assignment, includes scalarization.  */
 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool);
 
@@ -472,11 +478,8 @@ 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_malloc;
-extern GTY(()) tree gfor_fndecl_internal_malloc64;
 extern GTY(()) tree gfor_fndecl_internal_realloc;
 extern GTY(()) tree gfor_fndecl_internal_realloc64;
-extern GTY(()) tree gfor_fndecl_internal_free;
 extern GTY(()) tree gfor_fndecl_allocate;
 extern GTY(()) tree gfor_fndecl_allocate64;
 extern GTY(()) tree gfor_fndecl_allocate_array;
@@ -489,6 +492,7 @@ extern GTY(()) tree gfor_fndecl_stop_string;
 extern GTY(()) tree gfor_fndecl_select_string;
 extern GTY(()) tree gfor_fndecl_runtime_error;
 extern GTY(()) tree gfor_fndecl_runtime_error_at;
+extern GTY(()) tree gfor_fndecl_os_error;
 extern GTY(()) tree gfor_fndecl_generate_error;
 extern GTY(()) tree gfor_fndecl_set_fpe;
 extern GTY(()) tree gfor_fndecl_set_std;

libgfortran/ChangeLog

+2007-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30723
+	* runtime/memory.c (internal_malloc, internal_malloc64,
+	internal_free): Remove.
+	* runtime/error.c (os_error): Export function.
+	* intrinsics/move_alloc.c: Include stdlib.h.
+	(move_alloc): Call free instead of internal_free.
+	(move_alloc_c): Wrap long lines.
+	* libgfortran.h (os_error): Export prototype.
+	(internal_free): Remove prototype.
+	* gfortran.map (GFORTRAN_1.0): Remove _gfortran_internal_free,
+	_gfortran_internal_malloc and _gfortran_internal_malloc64.
+	Add _gfortran_os_error.
+
 2007-05-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/31880

libgfortran/gfortran.map

@@ -166,9 +166,6 @@ GFORTRAN_1.0 {
     _gfortran_idate_i8;
     _gfortran_ierrno_i4;
     _gfortran_ierrno_i8;
-    _gfortran_internal_free;
-    _gfortran_internal_malloc;
-    _gfortran_internal_malloc64;
     _gfortran_internal_pack;
     _gfortran_internal_realloc;
     _gfortran_internal_realloc64;
@@ -502,6 +499,7 @@ GFORTRAN_1.0 {
     _gfortran_nearest_r16;
     _gfortran_nearest_r4;
     _gfortran_nearest_r8;
+    _gfortran_os_error;
     _gfortran_pack;
     _gfortran_pack_char;
     _gfortran_pack_s;

libgfortran/intrinsics/move_alloc.c

@@ -28,8 +28,13 @@ License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
 
+#include "config.h"
 #include "libgfortran.h"
 
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
 extern void move_alloc (gfc_array_char *, gfc_array_char *);
 export_proto(move_alloc);
 
@@ -38,7 +43,8 @@ move_alloc (gfc_array_char * from, gfc_array_char * to)
 {
   int i;
 
-  internal_free (to->data);
+  if (to->data)
+    free (to->data);
 
   for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++)
     {
@@ -60,8 +66,10 @@ extern void move_alloc_c (gfc_array_char *, GFC_INTEGER_4,
 export_proto(move_alloc_c);
 
 void
-move_alloc_c (gfc_array_char * from, GFC_INTEGER_4 from_length __attribute__((unused)),
-	      gfc_array_char * to, GFC_INTEGER_4 to_length __attribute__((unused)))
+move_alloc_c (gfc_array_char * from,
+	      GFC_INTEGER_4 from_length __attribute__((unused)),
+	      gfc_array_char * to,
+	      GFC_INTEGER_4 to_length __attribute__((unused)))
 {
   move_alloc (from, to);
 }

libgfortran/libgfortran.h

@@ -583,7 +583,7 @@ extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
 internal_proto(xtoa);
 
 extern void os_error (const char *) __attribute__ ((noreturn));
-internal_proto(os_error);
+iexport_proto(os_error);
 
 extern void show_locus (st_parameter_common *);
 internal_proto(show_locus);
@@ -634,9 +634,6 @@ internal_proto(free_mem);
 extern void *internal_malloc_size (size_t);
 internal_proto(internal_malloc_size);
 
-extern void internal_free (void *);
-iexport_proto(internal_free);
-
 /* environ.c */
 
 extern int check_buffered (int);

libgfortran/runtime/error.c

@@ -285,6 +285,7 @@ os_error (const char *message)
   st_printf ("Operating system error: %s\n%s\n", get_oserror (), message);
   sys_exit (1);
 }
+iexport(os_error);
 
 
 /* void runtime_error()-- These are errors associated with an

libgfortran/runtime/memory.c

@@ -77,46 +77,6 @@ internal_malloc_size (size_t size)
   return get_mem (size);
 }
 
-extern void *internal_malloc (GFC_INTEGER_4);
-export_proto(internal_malloc);
-
-void *
-internal_malloc (GFC_INTEGER_4 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
-  return internal_malloc_size ((size_t) size);
-}
-
-extern void *internal_malloc64 (GFC_INTEGER_8);
-export_proto(internal_malloc64);
-
-void *
-internal_malloc64 (GFC_INTEGER_8 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
-  return internal_malloc_size ((size_t) size);
-}
-
-
-/* Free internally allocated memory.  Pointer is NULLified.  Also used to
-   free user allocated memory.  */
-
-void
-internal_free (void *mem)
-{
-  if (mem != NULL)
-    free (mem);
-}
-iexport(internal_free);
 
 /* Reallocate internal memory MEM so it has SIZE bytes of data.
    Allocate a new block if MEM is zero, and free the block if