PR fortran/30723

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans.c

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