+2010-07-05 Nathan Froyd <froydnj@codesourcery.com>
+
+ * vec.h (VEC_splice, VEC_safe_splice): New macros. Add function
+ implementations.
+
2010-07-05 Bernd Schmidt <bernds@codesourcery.com>
* config/arm/arm.c (get_arm_condition_code): Remove CC_NOTBmode case.
+2010-07-05 Nathan Froyd <froydnj@codesourcery.com>
+
+ * trans.h (gfc_conv_procedure_call): Take a VEC instead of a tree.
+ * trans-intrinsic.c (gfc_conv_intrinsic_funcall): Adjust for new
+ type of gfc_conv_procedure_call.
+ (conv_generic_with_optional_char_arg): Likewise.
+ * trans-stmt.c (gfc_trans_call): Likewise.
+ * trans-expr.c (gfc_conv_function_expr): Likewise.
+ (gfc_conv_procedure_call): Use build_call_vec instead of
+ build_call_list.
+
2010-07-04 Daniel Kraft <d@domob.eu>
* gfc-internals.texi (gfc_code): Document BLOCK and ASSOCIATE.
return 0;
}
-
/* 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.
Return nonzero, if the call has alternate specifiers.
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;
tree type;
tree var;
tree len;
- tree stringargs;
+ VEC(tree,gc) *stringargs;
tree result = NULL;
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
+ 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);
/* 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);
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;
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)
{
/* 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)
{
/* 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)
{
else
var = gfc_conv_string_tmp (se, type, len);
- retargs = gfc_chainon_list (retargs, var);
+ VEC_safe_push (tree, gc, retargs, var);
}
else
{
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. */
+ arglen = (VEC_length (tree, arglist)
+ + VEC_length (tree, stringargs) + VEC_length (tree, append_args));
+ VEC_reserve_exact (tree, gc, retargs, arglen);
+
/* Add the return arguments. */
- arglist = chainon (retargs, arglist);
+ VEC_splice (tree, retargs, arglist);
/* Add the hidden string length parameters to the arguments. */
- arglist = chainon (arglist, stringargs);
+ VEC_splice (tree, retargs, stringargs);
/* 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))
+ VEC_splice (tree, retargs, append_args);
+ arglist = retargs;
/* Generate the actual call. */
conv_function_val (se, sym, expr);
}
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
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);
}
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);
/* 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)
{
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);
}
}
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;
/* 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. */
/* 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;
/* 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)
{
/* 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);
#define VEC_reserve_exact(T,A,V,R) \
(VEC_OP(T,A,reserve_exact)(&(V),R VEC_CHECK_INFO MEM_STAT_INFO))
+/* Copy elements with no reallocation
+ void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Integer
+ void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Pointer
+ void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Object
+
+ Copy the elements in SRC to the end of DST as if by memcpy. DST and
+ SRC need not be allocated with the same mechanism, although they most
+ often will be. DST is assumed to have sufficient headroom
+ available. */
+
+#define VEC_splice(T,DST,SRC) \
+ (VEC_OP(T,base,splice)(VEC_BASE(DST), VEC_BASE(SRC) VEC_CHECK_INFO))
+
+/* Copy elements with reallocation
+ void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Integer
+ void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Pointer
+ void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Object
+
+ Copy the elements in SRC to the end of DST as if by memcpy. DST and
+ SRC need not be allocated with the same mechanism, although they most
+ often will be. DST need not have sufficient headroom and will be
+ reallocated if needed. */
+
+#define VEC_safe_splice(T,A,DST,SRC) \
+ (VEC_OP(T,A,safe_splice)(&(DST), VEC_BASE(SRC) VEC_CHECK_INFO MEM_STAT_INFO))
+
/* Push object with no reallocation
T *VEC_T_quick_push (VEC(T) *v, T obj); // Integer
T *VEC_T_quick_push (VEC(T) *v, T obj); // Pointer
return vec_ ? vec_->alloc - vec_->num >= (unsigned)alloc_ : !alloc_; \
} \
\
+static inline void VEC_OP(T,base,splice) \
+ (VEC(T,base) *dst_, VEC(T,base) *src_ VEC_CHECK_DECL) \
+{ \
+ if (src_) \
+ { \
+ unsigned len_ = src_->num; \
+ VEC_ASSERT (dst_->num + len_ <= dst_->alloc, "splice", T, base); \
+ \
+ memcpy (&dst_->vec[dst_->num], &src_->vec[0], len_ * sizeof (T)); \
+ dst_->num += len_; \
+ } \
+} \
+ \
static inline T *VEC_OP (T,base,quick_push) \
(VEC(T,base) *vec_, T obj_ VEC_CHECK_DECL) \
{ \
sizeof (T) * (size_ - oldsize)); \
} \
\
+static inline void VEC_OP(T,A,safe_splice) \
+ (VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL) \
+{ \
+ if (src_) \
+ { \
+ VEC_OP (T,A,reserve_exact) (dst_, src_->num \
+ VEC_CHECK_PASS MEM_STAT_INFO); \
+ \
+ VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_ \
+ VEC_CHECK_PASS); \
+ } \
+} \
+ \
static inline T *VEC_OP (T,A,safe_push) \
(VEC(T,A) **vec_, T obj_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
return vec_ ? vec_->alloc - vec_->num >= (unsigned)alloc_ : !alloc_; \
} \
\
+static inline void VEC_OP(T,base,splice) \
+ (VEC(T,base) *dst_, VEC(T,base) *src_ VEC_CHECK_DECL) \
+{ \
+ if (src_) \
+ { \
+ unsigned len_ = src_->num; \
+ VEC_ASSERT (dst_->num + len_ <= dst_->alloc, "splice", T, base); \
+ \
+ memcpy (&dst_->vec[dst_->num], &src_->vec[0], len_ * sizeof (T)); \
+ dst_->num += len_; \
+ } \
+} \
+ \
static inline T *VEC_OP (T,base,quick_push) \
(VEC(T,base) *vec_, const T *obj_ VEC_CHECK_DECL) \
{ \
sizeof (T) * (size_ - oldsize)); \
} \
\
+static inline void VEC_OP(T,A,safe_splice) \
+ (VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL) \
+{ \
+ if (src_) \
+ { \
+ VEC_OP (T,A,reserve_exact) (dst_, src_->num \
+ VEC_CHECK_PASS MEM_STAT_INFO); \
+ \
+ VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_ \
+ VEC_CHECK_PASS); \
+ } \
+} \
+ \
static inline T *VEC_OP (T,A,safe_push) \
(VEC(T,A) **vec_, const T *obj_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
sizeof (T) * (size_ - oldsize)); \
} \
\
+static inline void VEC_OP(T,A,safe_splice) \
+ (VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL) \
+{ \
+ if (src_) \
+ { \
+ VEC_OP (T,A,reserve_exact) (dst_, src_->num \
+ VEC_CHECK_PASS MEM_STAT_INFO); \
+ \
+ VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_ \
+ VEC_CHECK_PASS); \
+ } \
+} \
+ \
static inline T *VEC_OP (T,A,safe_push) \
(VEC(T,A) **vec_, const T obj_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
OSDN Git Service
