diff options
author | Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2007-05-14 19:33:57 +0000 |
---|---|---|
committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2007-05-14 19:33:57 +0000 |
commit | 1529b8d9bece1721f2f12277534b4bf287ce1982 (patch) | |
tree | 4a299e8ff3b7b281e17a2e8950d235983d8b4c7a | |
parent | 1af5627c40801eb1715b9ac1eadff50d1de46288 (diff) | |
download | gcc-1529b8d9bece1721f2f12277534b4bf287ce1982.tar.gz |
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
-rw-r--r-- | gcc/fortran/ChangeLog | 28 | ||||
-rw-r--r-- | gcc/fortran/f95-lang.c | 11 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 38 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 26 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 6 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 11 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 19 | ||||
-rw-r--r-- | gcc/fortran/trans.c | 81 | ||||
-rw-r--r-- | gcc/fortran/trans.h | 10 | ||||
-rw-r--r-- | libgfortran/ChangeLog | 15 | ||||
-rw-r--r-- | libgfortran/gfortran.map | 4 | ||||
-rw-r--r-- | libgfortran/intrinsics/move_alloc.c | 14 | ||||
-rw-r--r-- | libgfortran/libgfortran.h | 5 | ||||
-rw-r--r-- | libgfortran/runtime/error.c | 1 | ||||
-rw-r--r-- | libgfortran/runtime/memory.c | 40 |
15 files changed, 184 insertions, 125 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 87947c26923..625e304437b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,33 @@ 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. diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index d4fc2cc8369..06cea98d73a 100644 --- a/gcc/fortran/f95-lang.c +++ b/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) \ diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4997673904f..61e35543fe3 100644 --- a/gcc/fortran/trans-array.c +++ b/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, diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 835e515e628..8c564cbca35 100644 --- a/gcc/fortran/trans-decl.c +++ b/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); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 34be30c19a1..d5f584c2ab9 100644 --- a/gcc/fortran/trans-expr.c +++ b/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); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 33b2e22ceb1..75b5a4cffc5 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/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); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 0fcc66f0d2b..d0af66e60b4 100644 --- a/gcc/fortran/trans-stmt.c +++ b/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); } } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 5e717e4cbcf..97336b68f61 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 diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 731045a2769..da4b0c10352 100644 --- a/gcc/fortran/trans.h +++ b/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; diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index acfaec5e22f..a90c7160cd1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,18 @@ +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 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index c1ca7255bb1..f67192db1d8 100644 --- a/libgfortran/gfortran.map +++ b/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; diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c index b73ef4b77a0..24baf3971cd 100644 --- a/libgfortran/intrinsics/move_alloc.c +++ b/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); } diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 0f7d2c7705a..fd510ee5fa1 100644 --- a/libgfortran/libgfortran.h +++ b/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); diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 2bcc293091a..bd3c306bc2f 100644 --- a/libgfortran/runtime/error.c +++ b/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 diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c index 58395303440..fe76675c9ad 100644 --- a/libgfortran/runtime/memory.c +++ b/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 |