enum rounding_mode { RND_ROUND, RND_TRUNC, RND_CEIL, RND_FLOOR };
/* Evaluate the arguments to an intrinsic function. */
+/* FIXME: This function and its callers should be rewritten so that it's
+ not necessary to cons up a list to hold the arguments. */
static tree
gfc_conv_intrinsic_function_args (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));
- arglist = gfc_chainon_list (NULL_TREE, var);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
+ tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- arglist = gfc_chainon_list (NULL_TREE, var);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
+ tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- arglist = gfc_chainon_list (NULL_TREE, var);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
+ tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
gcc_unreachable ();
}
- /* Most negative(+HUGE) for maxval, most negative (-HUGE) for minval. */
+ /* We start with the most negative possible value for MAXLOC, and the most
+ positive possible value for MINLOC. The most negative possible value is
+ -HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
+ possible value is HUGE in both cases. */
if (op == GT_EXPR)
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
gfc_add_modify_expr (&se->pre, limit, tmp);
+ if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
+ tmp = build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp,
+ build_int_cst (type, 1));
+
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, arrayss);
gcc_unreachable ();
}
- /* Most negative(-HUGE) for maxval, most positive (-HUGE) for minval. */
+ /* We start with the most negative possible value for MAXVAL, and the most
+ positive possible value for MINVAL. The most negative possible value is
+ -HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
+ possible value is HUGE in both cases. */
if (op == GT_EXPR)
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
+
+ if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
+ tmp = build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp,
+ build_int_cst (type, 1));
+
gfc_add_modify_expr (&se->pre, limit, tmp);
/* Walk the arguments. */
tree lower;
tree stride;
tree stmt;
- tree args;
gfc_actual_arglist *arg;
gfc_se argse;
gfc_ss *ss;
&& arg->expr->ref->u.ar.type == AR_FULL))
{
tmp = build_fold_addr_expr (argse.expr);
- tmp = gfc_chainon_list (NULL_TREE, tmp);
- source = build_function_call_expr (gfor_fndecl_in_pack, tmp);
+ source = build_call_expr (gfor_fndecl_in_pack, 1, tmp);
source = gfc_evaluate_now (source, &argse.pre);
/* Free the temporary. */
gfc_start_block (&block);
tmp = convert (pvoid_type_node, source);
- tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
+ tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
gfc_add_expr_to_block (&block, tmp);
stmt = gfc_finish_block (&block);
se->loop->to[n] = upper;
/* Build a destination descriptor, using the pointer, source, as the
- data field. This is already allocated so set callee_alloc. */
+ data field. This is already allocated so set callee_alloc.
+ FIXME callee_alloc is not set! */
+
tmp = gfc_typenode_for_spec (&expr->ts);
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
- info, tmp, false, true, false, false);
+ info, tmp, false, true, false);
/* Use memcpy to do the transfer. */
- tmp = gfc_conv_descriptor_data_get (info->descriptor);
- args = gfc_chainon_list (NULL_TREE, tmp);
- tmp = fold_convert (pvoid_type_node, source);
- args = gfc_chainon_list (args, source);
- args = gfc_chainon_list (args, size_bytes);
- tmp = built_in_decls[BUILT_IN_MEMCPY];
- tmp = build_function_call_expr (tmp, args);
+ tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY],
+ 3,
+ gfc_conv_descriptor_data_get (info->descriptor),
+ fold_convert (pvoid_type_node, source),
+ size_bytes);
gfc_add_expr_to_block (&se->pre, tmp);
se->expr = info->descriptor;
tree type;
tree ptr;
gfc_ss *ss;
- tree tmpdecl, tmp, args;
+ tree tmpdecl, tmp;
/* Get a pointer to the source. */
arg = expr->value.function.actual;
/* Use memcpy to do the transfer. */
tmp = build1 (ADDR_EXPR, build_pointer_type (type), tmpdecl);
- tmp = fold_convert (pvoid_type_node, tmp);
- args = gfc_chainon_list (NULL_TREE, tmp);
- tmp = fold_convert (pvoid_type_node, ptr);
- args = gfc_chainon_list (args, tmp);
- args = gfc_chainon_list (args, moldsize);
- tmp = built_in_decls[BUILT_IN_MEMCPY];
- tmp = build_function_call_expr (tmp, args);
+ tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
+ fold_convert (pvoid_type_node, tmp),
+ fold_convert (pvoid_type_node, ptr),
+ moldsize);
gfc_add_expr_to_block (&se->pre, tmp);
se->expr = tmpdecl;
gfc_se arg2se;
tree tmp2;
tree tmp;
- tree args, fndecl;
+ tree fndecl;
tree nonzero_charlen;
tree nonzero_arraylen;
gfc_ss *ss1, *ss2;
/* A pointer to an array, call library function _gfor_associated. */
gcc_assert (ss2 != gfc_ss_terminator);
- args = NULL_TREE;
arg1se.want_pointer = 1;
gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
- args = gfc_chainon_list (args, arg1se.expr);
arg2se.want_pointer = 1;
gfc_conv_expr_descriptor (&arg2se, arg2->expr, ss2);
gfc_add_block_to_block (&se->pre, &arg2se.pre);
gfc_add_block_to_block (&se->post, &arg2se.post);
- args = gfc_chainon_list (args, arg2se.expr);
fndecl = gfor_fndecl_associated;
- se->expr = build_function_call_expr (fndecl, args);
+ se->expr = build_call_expr (fndecl, 2, arg1se.expr, arg2se.expr);
se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
se->expr, nonzero_arraylen);
args = gfc_conv_intrinsic_function_args (se, expr);
args = TREE_VALUE (args);
args = build_fold_addr_expr (args);
- args = tree_cons (NULL_TREE, args, NULL_TREE);
- se->expr = build_function_call_expr (gfor_fndecl_si_kind, args);
+ se->expr = build_call_expr (gfor_fndecl_si_kind, 1, args);
}
/* Generate code for SELECTED_REAL_KIND (P, R) intrinsic function. */
/* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len,
build_int_cst (TREE_TYPE (len), 0));
- arglist = gfc_chainon_list (NULL_TREE, var);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, arglist);
+ tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
tree tmp;
tree len;
tree args;
- tree arglist;
tree ncopies;
tree var;
tree type;
+ tree cond;
args = gfc_conv_intrinsic_function_args (se, expr);
len = TREE_VALUE (args);
tmp = gfc_advance_chain (args, 2);
ncopies = TREE_VALUE (tmp);
+
+ /* Check that ncopies is not negative. */
+ ncopies = gfc_evaluate_now (ncopies, &se->pre);
+ cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies,
+ build_int_cst (TREE_TYPE (ncopies), 0));
+ gfc_trans_runtime_check (cond,
+ "Argument NCOPIES of REPEAT intrinsic is negative",
+ &se->pre, &expr->where);
+
+ /* Compute the destination length. */
len = fold_build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies);
type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
var = gfc_conv_string_tmp (se, build_pointer_type (type), len);
- arglist = NULL_TREE;
- arglist = gfc_chainon_list (arglist, var);
- arglist = chainon (arglist, args);
- tmp = build_function_call_expr (gfor_fndecl_string_repeat, arglist);
+ /* Create the argument list and generate the function call. */
+ tmp = build_call_expr (gfor_fndecl_string_repeat, 4, var,
+ TREE_VALUE (args),
+ TREE_VALUE (TREE_CHAIN (args)), ncopies);
gfc_add_expr_to_block (&se->pre, tmp);
se->expr = var;
/* Call the library function. This always returns an INTEGER(4). */
fndecl = gfor_fndecl_iargc;
- tmp = build_function_call_expr (fndecl, NULL_TREE);
+ tmp = build_call_expr (fndecl, 0);
/* Convert it to the required type. */
type = gfc_typenode_for_spec (&expr->ts);