From patchwork Mon Jul 5 12:48:58 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Nathan Froyd X-Patchwork-Id: 57906 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 0C606B6F1A for ; Mon, 5 Jul 2010 22:49:11 +1000 (EST) Received: (qmail 4719 invoked by alias); 5 Jul 2010 12:49:08 -0000 Received: (qmail 4699 invoked by uid 22791); 5 Jul 2010 12:49:05 -0000 X-SWARE-Spam-Status: No, hits=-0.1 required=5.0 tests=AWL, BAYES_05, KAM_STOCKGEN, TW_CP, TW_FN, TW_TM, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mail.codesourcery.com (HELO mail.codesourcery.com) (38.113.113.100) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 05 Jul 2010 12:48:59 +0000 Received: (qmail 18845 invoked from network); 5 Jul 2010 12:48:58 -0000 Received: from unknown (HELO localhost) (froydnj@127.0.0.2) by mail.codesourcery.com with ESMTPA; 5 Jul 2010 12:48:58 -0000 Date: Mon, 5 Jul 2010 05:48:58 -0700 From: Nathan Froyd To: Tobias Burnus Cc: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: Re: [PATCH] remove build_call_list from Fortran FE Message-ID: <20100705124857.GI17877@codesourcery.com> References: <20100701145033.GA17877@codesourcery.com> <4C2CBC5E.4030204@net-b.de> MIME-Version: 1.0 Content-Disposition: inline In-Reply-To: <4C2CBC5E.4030204@net-b.de> User-Agent: Mutt/1.5.17+20080114 (2008-01-14) X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org On Thu, Jul 01, 2010 at 06:03:42PM +0200, Tobias Burnus wrote: > On 07/01/2010 04:50 PM, Nathan Froyd wrote: > > The patch below removes build_call_list from the Fortran FE by making > > gfc_conv_procedure_call use build_call_vec. > > Tested on x86_64-unknown-linux-gnu. OK to commit? > > > > OK. Thanks for the patch. Thanks, committed as r161834. > (By the way, I like Richard's idea of adding VEC_splice to vec.{c,h}, > replacing append_vec.) Me too; I committed my VEC_{,safe_}splice implementation along with the patch and changed the patch in the obvious way, see below. -Nathan 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. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 692b3e2..1a7a4a1 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 06fd538..7f583da 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 6fa84b9..50ad650 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 02361fc..fa2d583 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 93a432d..3f3386c 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) \ { \