From 989ea525bec01e16c29b69bf5194310c551d9c34 Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Mon, 5 Jul 2010 12:46:52 +0000 Subject: [PATCH] vec.h (VEC_splice, [...]): New macros. gcc/ * vec.h (VEC_splice, VEC_safe_splice): New macros. Add function implementations. gcc/fortran/ * 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. From-SVN: r161834 --- gcc/ChangeLog | 5 ++ gcc/fortran/ChangeLog | 11 +++++ gcc/fortran/trans-expr.c | 53 +++++++++++--------- gcc/fortran/trans-intrinsic.c | 31 ++++++------ gcc/fortran/trans-stmt.c | 5 +- gcc/fortran/trans.h | 2 +- gcc/vec.h | 91 +++++++++++++++++++++++++++++++++++ 7 files changed, 155 insertions(+), 43 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index d44736001f9..23d71ec8b9e 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2010-07-05 Nathan Froyd + + * vec.h (VEC_splice, VEC_safe_splice): New macros. Add function + implementations. + 2010-07-05 Bernd Schmidt * config/arm/arm.c (get_arm_condition_code): Remove CC_NOTBmode case. diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ca29477fb24..3530c8f3326 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2010-07-05 Nathan Froyd + + * 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 * gfc-internals.texi (gfc_code): Document BLOCK and ASSOCIATE. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 692b3e2f846..1a7a4a1e4e2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2653,7 +2653,6 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym, 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. @@ -2662,11 +2661,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 +2676,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 +2689,11 @@ 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 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 +3136,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 +3160,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 +3213,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 +3237,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 +3261,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 +3288,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 +3296,31 @@ 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. */ + 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); @@ -3338,7 +3344,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 +3792,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); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 06fd538d775..7f583dabe44 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -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. */ diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 15f2acb27d3..beada6a718d 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -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) { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 02361fc8466..fa2d583173a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -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); diff --git a/gcc/vec.h b/gcc/vec.h index 93a432df839..e6c42bc0a60 100644 --- a/gcc/vec.h +++ b/gcc/vec.h @@ -259,6 +259,32 @@ along with GCC; see the file COPYING3. If not see #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 @@ -589,6 +615,19 @@ static inline int VEC_OP (T,base,space) \ 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) \ { \ @@ -796,6 +835,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared) \ 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) \ { \ @@ -881,6 +933,19 @@ static inline int VEC_OP (T,base,space) \ 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) \ { \ @@ -1084,6 +1149,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared) \ 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) \ { \ @@ -1188,6 +1266,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared) \ 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) \ { \