diff options
Diffstat (limited to 'gcc/fortran/trans.c')
| -rw-r--r-- | gcc/fortran/trans.c | 81 |
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 |