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

1 files changed, 81 insertions, 0 deletions

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 5e717e4..97336b6 100644
--- a/gcc/fortran/trans.c
+++ b/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