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
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
1af5627c40
commit
1529b8d9be
15 changed files with 184 additions and 125 deletions
|
|
@ -1,3 +1,31 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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) \
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue