From patchwork Tue May 3 19:06:57 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Nathan Froyd X-Patchwork-Id: 93884 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 5D081B6F53 for ; Wed, 4 May 2011 05:07:24 +1000 (EST) Received: (qmail 6837 invoked by alias); 3 May 2011 19:07:20 -0000 Received: (qmail 6290 invoked by uid 22791); 3 May 2011 19:07:15 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL, BAYES_00, TW_FN, 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; Tue, 03 May 2011 19:07:00 +0000 Received: (qmail 21432 invoked from network); 3 May 2011 19:06:59 -0000 Received: from unknown (HELO localhost) (froydnj@127.0.0.2) by mail.codesourcery.com with ESMTPA; 3 May 2011 19:06:59 -0000 Date: Tue, 3 May 2011 12:06:57 -0700 From: Nathan Froyd To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: [PATCH] less build_function_type usage in the Fortran FE Message-ID: <20110503190654.GB23480@codesourcery.com> MIME-Version: 1.0 Content-Disposition: inline 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 The patch below eliminates almost all cases of build_function_type in the Fortran FE. (The last case uses TYPE_ARG_TYPES directly and will need to be dealt with separately.) This is accomplished by introducing two new functions, build_{,varargs_}function_type_array, which do what you think, and two small macro wrappers around them, build_{,varargs_}function_type_vec. The macro wrappers are used so that one can use heap-, gc-, or stack-allocated vectors, as necessary. Comments on the middle-end bits welcome; some sort of FUNCTION_TYPE builder with a dynamically determined number of argument types is needed for working towards the elimination of TYPE_ARG_TYPES. As a happy side-effect, the patch eliminates uses of gfc_chainon_list and makes the specific instances below of building function types linear, instead of quadratic. If the patch is approved, I will delete gfc_chainon_list as an obvious followon patch. Testing in progress on x86_64-unknown-linux-gnu. OK to commit if testing successful? -Nathan gcc/ * tree.h (build_function_type_array): Declare. (build_varargs_function_type_array): Declare. (build_function_type_vec, build_varargs_function_type_vec): Define. * tree.c (build_function_type_array_1): New function. (build_function_type_array): New function. (build_varargs_function_type_array): New function. gcc/fortran/ * trans-decl.c (build_library_function_decl_1): Call build_function_type_vec. Adjust argument list building accordingly. * trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Likewise. * trans-types.c (gfc_get_function_type): Likewise. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index f80c9db..dc381f9 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2478,8 +2478,7 @@ static tree build_library_function_decl_1 (tree name, const char *spec, tree rettype, int nargs, va_list p) { - tree arglist; - tree argtype; + VEC(tree,gc) *arglist; tree fntype; tree fndecl; int n; @@ -2488,20 +2487,18 @@ build_library_function_decl_1 (tree name, const char *spec, gcc_assert (current_function_decl == NULL_TREE); /* Create a list of the argument types. */ - for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--) + arglist = VEC_alloc (tree, gc, abs (nargs)); + for (n = abs (nargs); n > 0; n--) { - argtype = va_arg (p, tree); - arglist = gfc_chainon_list (arglist, argtype); - } - - if (nargs >= 0) - { - /* Terminate the list. */ - arglist = chainon (arglist, void_list_node); + tree argtype = va_arg (p, tree); + VEC_quick_push (tree, arglist, argtype); } /* Build the function type and decl. */ - fntype = build_function_type (rettype, arglist); + if (nargs >= 0) + fntype = build_function_type_vec (rettype, arglist); + else + fntype = build_varargs_function_type_vec (rettype, arglist); if (spec) { tree attr_args = build_tree_list (NULL_TREE, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 180aba1..360723c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -722,7 +722,7 @@ static tree gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr) { tree type; - tree argtypes; + VEC(tree,gc) *argtypes; tree fndecl; gfc_actual_arglist *actual; tree *pdecl; @@ -803,14 +803,13 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr) ts->kind); } - argtypes = NULL_TREE; + argtypes = NULL; for (actual = expr->value.function.actual; actual; actual = actual->next) { type = gfc_typenode_for_spec (&actual->expr->ts); - argtypes = gfc_chainon_list (argtypes, type); + VEC_safe_push (tree, gc, argtypes, type); } - argtypes = chainon (argtypes, void_list_node); - type = build_function_type (gfc_typenode_for_spec (ts), argtypes); + type = build_function_type_vec (gfc_typenode_for_spec (ts), argtypes); fndecl = build_decl (input_location, FUNCTION_DECL, get_identifier (name), type); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index ebc8c23..4606f68 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2534,10 +2534,11 @@ tree gfc_get_function_type (gfc_symbol * sym) { tree type; - tree typelist; + VEC(tree,gc) *typelist; gfc_formal_arglist *f; gfc_symbol *arg; int alternate_return; + bool is_varargs = true; /* Make sure this symbol is a function, a subroutine or the main program. */ @@ -2548,13 +2549,11 @@ gfc_get_function_type (gfc_symbol * sym) return TREE_TYPE (sym->backend_decl); alternate_return = 0; - typelist = NULL_TREE; + typelist = NULL; if (sym->attr.entry_master) - { - /* Additional parameter for selecting an entry point. */ - typelist = gfc_chainon_list (typelist, gfc_array_index_type); - } + /* Additional parameter for selecting an entry point. */ + VEC_safe_push (tree, gc, typelist, gfc_array_index_type); if (sym->result) arg = sym->result; @@ -2573,17 +2572,17 @@ gfc_get_function_type (gfc_symbol * sym) || arg->ts.type == BT_CHARACTER) type = build_reference_type (type); - typelist = gfc_chainon_list (typelist, type); + VEC_safe_push (tree, gc, typelist, type); if (arg->ts.type == BT_CHARACTER) { if (!arg->ts.deferred) /* Transfer by value. */ - typelist = gfc_chainon_list (typelist, gfc_charlen_type_node); + VEC_safe_push (tree, gc, typelist, gfc_charlen_type_node); else /* Deferred character lengths are transferred by reference so that the value can be returned. */ - typelist = gfc_chainon_list (typelist, - build_pointer_type (gfc_charlen_type_node)); + VEC_safe_push (tree, gc, typelist, + build_pointer_type (gfc_charlen_type_node)); } } @@ -2621,7 +2620,7 @@ gfc_get_function_type (gfc_symbol * sym) used without an explicit interface, and cannot be passed as actual parameters for a dummy procedure. */ - typelist = gfc_chainon_list (typelist, type); + VEC_safe_push (tree, gc, typelist, type); } else { @@ -2644,14 +2643,17 @@ gfc_get_function_type (gfc_symbol * sym) so that the value can be returned. */ type = build_pointer_type (gfc_charlen_type_node); - typelist = gfc_chainon_list (typelist, type); + VEC_safe_push (tree, gc, typelist, type); } } if (typelist) - typelist = chainon (typelist, void_list_node); + is_varargs = false; else if (sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN) - typelist = void_list_node; + { + VEC_free (tree, gc, typelist); + typelist = NULL; + } if (alternate_return) type = integer_type_node; @@ -2690,7 +2692,10 @@ gfc_get_function_type (gfc_symbol * sym) else type = gfc_sym_type (sym); - type = build_function_type (type, typelist); + if (is_varargs) + type = build_varargs_function_type_vec (type, typelist); + else + type = build_function_type_vec (type, typelist); type = create_fn_spec (sym, type); return type; diff --git a/gcc/tree.c b/gcc/tree.c index 1f11838..baf6f2b 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -7640,6 +7640,44 @@ build_varargs_function_type_list (tree return_type, ...) return args; } +/* Build a function type. RETURN_TYPE is the type returned by the + function; VAARGS indicates whether the function takes varargs. The + function takes N named arguments, the types of which are provided in + ARG_TYPES. */ + +static tree +build_function_type_array_1 (bool vaargs, tree return_type, int n, + tree *arg_types) +{ + int i; + tree t = vaargs ? NULL_TREE : void_list_node; + + for (i = n - 1; i >= 0; i--) + t = tree_cons (NULL_TREE, arg_types[i], t); + + return build_function_type (return_type, t); +} + +/* Build a function type. RETURN_TYPE is the type returned by the + function. The function takes N named arguments, the types of which + are provided in ARG_TYPES. */ + +tree +build_function_type_array (tree return_type, int n, tree *arg_types) +{ + return build_function_type_array_1 (false, return_type, n, arg_types); +} + +/* Build a variable argument function type. RETURN_TYPE is the type + returned by the function. The function takes N named arguments, the + types of which are provided in ARG_TYPES. */ + +tree +build_varargs_function_type_array (tree return_type, int n, tree *arg_types) +{ + return build_function_type_array_1 (true, return_type, n, arg_types); +} + /* Build a METHOD_TYPE for a member of BASETYPE. The RETTYPE (a TYPE) and ARGTYPES (a TREE_LIST) are the return type and arguments types for the method. An implicit additional parameter (of type diff --git a/gcc/tree.h b/gcc/tree.h index 37507f0..e337f60 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -4256,6 +4256,13 @@ extern tree build_function_type_list (tree, ...); extern tree build_function_type_skip_args (tree, bitmap); extern tree build_function_decl_skip_args (tree, bitmap); extern tree build_varargs_function_type_list (tree, ...); +extern tree build_function_type_array (tree, int, tree *); +extern tree build_varargs_function_type_array (tree, int, tree *); +#define build_function_type_vec(RET, V) \ + build_function_type_array (RET, VEC_length (tree, V), VEC_address (tree, V)) +#define build_varargs_function_type_vec(RET, V) \ + build_varargs_function_type_array (RET, VEC_length (tree, V), \ + VEC_address (tree, V)) extern tree build_method_type_directly (tree, tree, tree); extern tree build_method_type (tree, tree); extern tree build_offset_type (tree, tree);