Commit 107051a5 by Francois-Xavier Coudert Committed by François-Xavier Coudert

trans.c (gfc_call_malloc, [...]): Simplify code.

	* trans.c (gfc_call_malloc, gfc_allocate_using_malloc,
	gfc_allocate_using_lib, gfc_allocate_allocatable,
	gfc_call_realloc): Simplify code.
	* trans-array.c (gfc_trans_allocate_array_storage,
	gfc_trans_auto_array_allocation, gfc_conv_array_parameter): Do not
	convert gfc_call_free() argument.
	* trans-expr.c (gfc_conv_string_tmp, gfc_conv_procedure_call,
	fcncall_realloc_result): Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Likewise.

From-SVN: r227316
parent 3ff2d74e
2015-08-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* trans.c (gfc_call_malloc, gfc_allocate_using_malloc,
gfc_allocate_using_lib, gfc_allocate_allocatable,
gfc_call_realloc): Simplify code.
* trans-array.c (gfc_trans_allocate_array_storage,
gfc_trans_auto_array_allocation, gfc_conv_array_parameter): Do not
convert gfc_call_free() argument.
* trans-expr.c (gfc_conv_string_tmp, gfc_conv_procedure_call,
fcncall_realloc_result): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Likewise.
2015-08-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2015-08-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/53668 PR fortran/53668
......
...@@ -922,7 +922,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, ...@@ -922,7 +922,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
{ {
/* Free the temporary. */ /* Free the temporary. */
tmp = gfc_conv_descriptor_data_get (desc); tmp = gfc_conv_descriptor_data_get (desc);
tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp)); tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (post, tmp); gfc_add_expr_to_block (post, tmp);
} }
} }
...@@ -5885,7 +5885,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, ...@@ -5885,7 +5885,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
gfc_add_modify (&init, decl, tmp); gfc_add_modify (&init, decl, tmp);
/* Free the temporary. */ /* Free the temporary. */
tmp = gfc_call_free (convert (pvoid_type_node, decl)); tmp = gfc_call_free (decl);
space = NULL_TREE; space = NULL_TREE;
} }
...@@ -7542,7 +7542,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, ...@@ -7542,7 +7542,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
} }
/* Free the temporary. */ /* Free the temporary. */
tmp = gfc_call_free (convert (pvoid_type_node, ptr)); tmp = gfc_call_free (ptr);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
stmt = gfc_finish_block (&block); stmt = gfc_finish_block (&block);
......
...@@ -3035,7 +3035,7 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len) ...@@ -3035,7 +3035,7 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
gfc_add_modify (&se->pre, var, tmp); gfc_add_modify (&se->pre, var, tmp);
/* Free the temporary afterwards. */ /* Free the temporary afterwards. */
tmp = gfc_call_free (convert (pvoid_type_node, var)); tmp = gfc_call_free (var);
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
} }
...@@ -5880,7 +5880,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -5880,7 +5880,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_add_modify (&se->pre, var, gfc_add_modify (&se->pre, var,
fold_convert (TREE_TYPE (var), fold_convert (TREE_TYPE (var),
null_pointer_node)); null_pointer_node));
tmp = gfc_call_free (convert (pvoid_type_node, var)); tmp = gfc_call_free (var);
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
} }
...@@ -6140,14 +6140,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -6140,14 +6140,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (se->ss && se->ss->loop) if (se->ss && se->ss->loop)
{ {
gfc_add_expr_to_block (&se->ss->loop->post, tmp); gfc_add_expr_to_block (&se->ss->loop->post, tmp);
tmp = gfc_call_free (convert (pvoid_type_node, info->data)); tmp = gfc_call_free (info->data);
gfc_add_expr_to_block (&se->ss->loop->post, tmp); gfc_add_expr_to_block (&se->ss->loop->post, tmp);
} }
else else
{ {
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
tmp = gfc_class_data_get (se->expr); tmp = gfc_class_data_get (se->expr);
tmp = gfc_call_free (convert (pvoid_type_node, tmp)); tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
} }
expr->must_finalize = 0; expr->must_finalize = 0;
...@@ -8453,7 +8453,7 @@ fcncall_realloc_result (gfc_se *se, int rank) ...@@ -8453,7 +8453,7 @@ fcncall_realloc_result (gfc_se *se, int rank)
boolean_type_node, tmp, boolean_type_node, tmp,
build_int_cst (TREE_TYPE (tmp), 0)); build_int_cst (TREE_TYPE (tmp), 0));
zero_cond = gfc_evaluate_now (zero_cond, &se->post); zero_cond = gfc_evaluate_now (zero_cond, &se->post);
tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp)); tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
tmp = gfc_conv_descriptor_data_get (res_desc); tmp = gfc_conv_descriptor_data_get (res_desc);
......
...@@ -6259,7 +6259,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) ...@@ -6259,7 +6259,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
/* Free the temporary. */ /* Free the temporary. */
gfc_start_block (&block); gfc_start_block (&block);
tmp = gfc_call_free (convert (pvoid_type_node, source)); tmp = gfc_call_free (source);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
stmt = gfc_finish_block (&block); stmt = gfc_finish_block (&block);
......
...@@ -567,17 +567,13 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -567,17 +567,13 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
tree tmp, msg, malloc_result, null_result, res, malloc_tree; tree tmp, msg, malloc_result, null_result, res, malloc_tree;
stmtblock_t block2; 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. */ /* Create a variable to hold the result. */
res = gfc_create_var (prvoid_type_node, NULL); res = gfc_create_var (prvoid_type_node, NULL);
/* Call malloc. */ /* Call malloc. */
gfc_start_block (&block2); gfc_start_block (&block2);
size = fold_convert (size_type_node, size);
size = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size, size = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size,
build_int_cst (size_type_node, 1)); build_int_cst (size_type_node, 1));
...@@ -604,7 +600,6 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -604,7 +600,6 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
} }
malloc_result = gfc_finish_block (&block2); malloc_result = gfc_finish_block (&block2);
gfc_add_expr_to_block (block, malloc_result); gfc_add_expr_to_block (block, malloc_result);
if (type != NULL) if (type != NULL)
...@@ -643,11 +638,6 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, ...@@ -643,11 +638,6 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
stmtblock_t on_error; stmtblock_t on_error;
tree status_type = status ? TREE_TYPE (status) : NULL_TREE; tree status_type = status ? TREE_TYPE (status) : NULL_TREE;
/* Evaluate size only once, and make sure it has the right type. */
size = gfc_evaluate_now (size, block);
if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
size = fold_convert (size_type_node, size);
/* If successful and stat= is given, set status to 0. */ /* If successful and stat= is given, set status to 0. */
if (status != NULL_TREE) if (status != NULL_TREE)
gfc_add_expr_to_block (block, gfc_add_expr_to_block (block,
...@@ -655,6 +645,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, ...@@ -655,6 +645,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
status, build_int_cst (status_type, 0))); status, build_int_cst (status_type, 0)));
/* The allocation itself. */ /* The allocation itself. */
size = fold_convert (size_type_node, size);
gfc_add_modify (block, pointer, gfc_add_modify (block, pointer,
fold_convert (TREE_TYPE (pointer), fold_convert (TREE_TYPE (pointer),
build_call_expr_loc (input_location, build_call_expr_loc (input_location,
...@@ -716,11 +707,6 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, ...@@ -716,11 +707,6 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
gcc_assert (token != NULL_TREE); gcc_assert (token != NULL_TREE);
/* Evaluate size only once, and make sure it has the right type. */
size = gfc_evaluate_now (size, block);
if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
size = fold_convert (size_type_node, size);
/* The allocation itself. */ /* The allocation itself. */
if (status == NULL_TREE) if (status == NULL_TREE)
pstat = null_pointer_node; pstat = null_pointer_node;
...@@ -734,6 +720,7 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, ...@@ -734,6 +720,7 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
errlen = build_int_cst (integer_type_node, 0); errlen = build_int_cst (integer_type_node, 0);
} }
size = fold_convert (size_type_node, size);
tmp = build_call_expr_loc (input_location, tmp = build_call_expr_loc (input_location,
gfor_fndecl_caf_register, 6, gfor_fndecl_caf_register, 6,
fold_build2_loc (input_location, fold_build2_loc (input_location,
...@@ -782,9 +769,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, ...@@ -782,9 +769,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
tree tmp, null_mem, alloc, error; tree tmp, null_mem, alloc, error;
tree type = TREE_TYPE (mem); tree type = TREE_TYPE (mem);
if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) size = fold_convert (size_type_node, size);
size = fold_convert (size_type_node, size);
null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, mem, boolean_type_node, mem,
build_int_cst (type, 0)), build_int_cst (type, 0)),
...@@ -866,27 +851,22 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, ...@@ -866,27 +851,22 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
/* Free a given variable, if it's not NULL. */ /* Free a given variable, if it's not NULL. */
tree tree
gfc_call_free (tree var) gfc_call_free (tree var)
{ {
stmtblock_t block; tree cond, call;
tree tmp, cond, call;
if (TREE_TYPE (var) != TREE_TYPE (pvoid_type_node)) /* Only evaluate the variable once. */
var = fold_convert (pvoid_type_node, var); var = save_expr (fold_convert (pvoid_type_node, var));
gfc_start_block (&block);
var = gfc_evaluate_now (var, &block);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, var, cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, var,
build_int_cst (pvoid_type_node, 0)); build_int_cst (pvoid_type_node, 0));
call = build_call_expr_loc (input_location, call = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_FREE), builtin_decl_explicit (BUILT_IN_FREE),
1, var); 1, var);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, call, return fold_build3_loc (input_location, COND_EXPR, void_type_node,
build_empty_stmt (input_location)); cond, call, build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
return gfc_finish_block (&block);
} }
...@@ -1499,10 +1479,8 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size) ...@@ -1499,10 +1479,8 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
tree msg, res, nonzero, null_result, tmp; tree msg, res, nonzero, null_result, tmp;
tree type = TREE_TYPE (mem); tree type = TREE_TYPE (mem);
size = gfc_evaluate_now (size, block); /* Only evaluate the size once. */
size = save_expr (fold_convert (size_type_node, size));
if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
size = fold_convert (size_type_node, size);
/* Create a variable to hold the result. */ /* Create a variable to hold the result. */
res = gfc_create_var (type, NULL); res = gfc_create_var (type, NULL);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment