@@ -2653,6 +2653,19 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
return 0;
}
+/* Copy the elements in SRC to DST, starting at INDEX in DST. Return
+ the next spot at which elements are to be added. DST is assumed to
+ have sufficient space available to hold SRC's elements. */
+
+static int
+append_vec (VEC(tree,gc) *dst, VEC(tree,gc) *src, int index)
+{
+ int len = VEC_length (tree, src);
+ memcpy (VEC_address (tree, dst) + index, VEC_address (tree, src),
+ len * sizeof (tree));
+
+ return index + len;
+}
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
@@ -2662,11 +2675,11 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
int
gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg, gfc_expr * expr,
- tree append_args)
+ VEC(tree,gc) *append_args)
{
gfc_interface_mapping mapping;
- tree arglist;
- tree retargs;
+ VEC(tree,gc) *arglist;
+ VEC(tree,gc) *retargs;
tree tmp;
tree fntype;
gfc_se parmse;
@@ -2677,7 +2690,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tree type;
tree var;
tree len;
- tree stringargs;
+ VEC(tree,gc) *stringargs;
tree result = NULL;
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
@@ -2690,10 +2703,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
+ int copy_index;
+ int arglen;
- arglist = NULL_TREE;
- retargs = NULL_TREE;
- stringargs = NULL_TREE;
+ arglist = NULL;
+ retargs = NULL;
+ stringargs = NULL;
var = NULL_TREE;
len = NULL_TREE;
gfc_clear_ts (&ts);
@@ -3136,9 +3151,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Character strings are passed as two parameters, a length and a
pointer - except for Bind(c) which only passes the pointer. */
if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
- stringargs = gfc_chainon_list (stringargs, parmse.string_length);
+ VEC_safe_push (tree, gc, stringargs, parmse.string_length);
- arglist = gfc_chainon_list (arglist, parmse.expr);
+ VEC_safe_push (tree, gc, arglist, parmse.expr);
}
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
@@ -3160,7 +3175,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
For dummies, we have to look through the formal argument list for
this function and use the character length found there.*/
if (!sym->attr.dummy)
- cl.backend_decl = TREE_VALUE (stringargs);
+ cl.backend_decl = VEC_index (tree, stringargs, 0);
else
{
formal = sym->ns->proc_name->formal;
@@ -3213,7 +3228,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
result = build_fold_indirect_ref_loc (input_location,
se->expr);
- retargs = gfc_chainon_list (retargs, se->expr);
+ VEC_safe_push (tree, gc, retargs, se->expr);
}
else if (comp && comp->attr.dimension)
{
@@ -3237,7 +3252,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Pass the temporary as the first argument. */
result = info->descriptor;
tmp = gfc_build_addr_expr (NULL_TREE, result);
- retargs = gfc_chainon_list (retargs, tmp);
+ VEC_safe_push (tree, gc, retargs, tmp);
}
else if (!comp && sym->result->attr.dimension)
{
@@ -3261,7 +3276,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Pass the temporary as the first argument. */
result = info->descriptor;
tmp = gfc_build_addr_expr (NULL_TREE, result);
- retargs = gfc_chainon_list (retargs, tmp);
+ VEC_safe_push (tree, gc, retargs, tmp);
}
else if (ts.type == BT_CHARACTER)
{
@@ -3288,7 +3303,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
var = gfc_conv_string_tmp (se, type, len);
- retargs = gfc_chainon_list (retargs, var);
+ VEC_safe_push (tree, gc, retargs, var);
}
else
{
@@ -3296,25 +3311,35 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
type = gfc_get_complex_type (ts.kind);
var = gfc_build_addr_expr (NULL_TREE, gfc_create_var (type, "cmplx"));
- retargs = gfc_chainon_list (retargs, var);
+ VEC_safe_push (tree, gc, retargs, var);
}
/* Add the string length to the argument list. */
if (ts.type == BT_CHARACTER)
- retargs = gfc_chainon_list (retargs, len);
+ VEC_safe_push (tree, gc, retargs, len);
}
gfc_free_interface_mapping (&mapping);
+ /* We need to glom RETARGS + ARGLIST + STRINGARGS + APPEND_ARGS. */
+ copy_index = VEC_length (tree, retargs);
+ arglen = (VEC_length (tree, retargs) + VEC_length (tree, arglist)
+ + VEC_length (tree, stringargs) + VEC_length (tree, append_args));
+ if (retargs == NULL)
+ retargs = VEC_alloc (tree, gc, arglen);
+ if (arglen != 0)
+ VEC_safe_grow (tree, gc, retargs, arglen);
+
/* Add the return arguments. */
- arglist = chainon (retargs, arglist);
+ copy_index = append_vec (retargs, arglist, copy_index);
/* Add the hidden string length parameters to the arguments. */
- arglist = chainon (arglist, stringargs);
+ copy_index = append_vec (retargs, stringargs, copy_index);
/* We may want to append extra arguments here. This is used e.g. for
calls to libgfortran_matmul_??, which need extra information. */
- if (append_args != NULL_TREE)
- arglist = chainon (arglist, append_args);
+ if (!VEC_empty (tree, append_args))
+ copy_index = append_vec (retargs, append_args, copy_index);
+ arglist = retargs;
/* Generate the actual call. */
conv_function_val (se, sym, expr);
@@ -3338,7 +3363,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
fntype = TREE_TYPE (TREE_TYPE (se->expr));
- se->expr = build_call_list (TREE_TYPE (fntype), se->expr, arglist);
+ se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
@@ -3786,8 +3811,7 @@ gfc_conv_function_expr (gfc_se * se, gfc_expr * expr)
if (!sym)
sym = expr->symtree->n.sym;
- gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
- NULL_TREE);
+ gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL);
}
@@ -1570,7 +1570,7 @@ static void
gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
{
gfc_symbol *sym;
- tree append_args;
+ VEC(tree,gc) *append_args;
gcc_assert (!se->ss || se->ss->expr == expr);
@@ -1583,7 +1583,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
/* Calls to libgfortran_matmul need to be appended special arguments,
to be able to call the BLAS ?gemm functions if required and possible. */
- append_args = NULL_TREE;
+ append_args = NULL;
if (expr->value.function.isym->id == GFC_ISYM_MATMUL
&& sym->ts.type != BT_LOGICAL)
{
@@ -1611,19 +1611,19 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
gemm_fndecl = gfor_fndecl_zgemm;
}
- append_args = gfc_chainon_list (NULL_TREE, build_int_cst (cint, 1));
- append_args = gfc_chainon_list
- (append_args, build_int_cst
- (cint, gfc_option.blas_matmul_limit));
- append_args = gfc_chainon_list (append_args,
- gfc_build_addr_expr (NULL_TREE,
- gemm_fndecl));
+ append_args = VEC_alloc (tree, gc, 3);
+ VEC_quick_push (tree, append_args, build_int_cst (cint, 1));
+ VEC_quick_push (tree, append_args,
+ build_int_cst (cint, gfc_option.blas_matmul_limit));
+ VEC_quick_push (tree, append_args,
+ gfc_build_addr_expr (NULL_TREE, gemm_fndecl));
}
else
{
- append_args = gfc_chainon_list (NULL_TREE, build_int_cst (cint, 0));
- append_args = gfc_chainon_list (append_args, build_int_cst (cint, 0));
- append_args = gfc_chainon_list (append_args, null_pointer_node);
+ append_args = VEC_alloc (tree, gc, 3);
+ VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
+ VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
+ VEC_quick_push (tree, append_args, null_pointer_node);
}
}
@@ -3285,7 +3285,7 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
unsigned cur_pos;
gfc_actual_arglist* arg;
gfc_symbol* sym;
- tree append_args;
+ VEC(tree,gc) *append_args;
/* Find the two arguments given as position. */
cur_pos = 0;
@@ -3309,13 +3309,14 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
/* If we do have type CHARACTER and the optional argument is really absent,
append a dummy 0 as string length. */
- append_args = NULL_TREE;
+ append_args = NULL;
if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr)
{
tree dummy;
dummy = build_int_cst (gfc_charlen_type_node, 0);
- append_args = gfc_chainon_list (append_args, dummy);
+ append_args = VEC_alloc (tree, gc, 1);
+ VEC_quick_push (tree, append_args, dummy);
}
/* Build the call itself. */
@@ -373,7 +373,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
/* Translate the call. */
has_alternate_specifier
= gfc_conv_procedure_call (&se, code->resolved_sym, code->ext.actual,
- code->expr1, NULL_TREE);
+ code->expr1, NULL);
/* A subroutine without side-effect, by definition, does nothing! */
TREE_SIDE_EFFECTS (se.expr) = 1;
@@ -457,8 +457,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
/* Add the subroutine call to the block. */
gfc_conv_procedure_call (&loopse, code->resolved_sym,
- code->ext.actual, code->expr1,
- NULL_TREE);
+ code->ext.actual, code->expr1, NULL);
if (mask && count1)
{
@@ -314,7 +314,7 @@ int gfc_is_intrinsic_libcall (gfc_expr *);
/* Used to call ordinary functions/subroutines
and procedure pointer components. */
int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
- gfc_expr *, tree);
+ gfc_expr *, VEC(tree,gc) *);
void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);