From 6c32445bf59d1484a5b6a3aa0d99916ede70b4b1 Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Wed, 4 May 2011 13:44:48 +0000 Subject: [PATCH] tree.h (build_function_type_array): Declare. 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. From-SVN: r173375 --- gcc/ChangeLog | 9 +++++++++ gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-decl.c | 21 +++++++++---------- gcc/fortran/trans-intrinsic.c | 9 ++++----- gcc/fortran/trans-types.c | 36 +++++++++++++++++---------------- gcc/tree.c | 38 +++++++++++++++++++++++++++++++++++ gcc/tree.h | 7 +++++++ 7 files changed, 93 insertions(+), 34 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index eb6d38c6ade..1ea87106223 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,12 @@ +2011-05-04 Nathan Froyd + + * 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. + 2011-05-04 Richard Sandiford * tree-vect-loop.c (vectorizable_reduction): Check reduction cost diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ce33b049503..9544af2ed0f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-05-04 Nathan Froyd + + * 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. + 2011-05-04 Richard Guenther * trans-array.c (gfc_trans_array_constructor_value): Use diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index a5527d5f3c0..e597eb3179c 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 fd538bf76d4..6554df076d7 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 27dcf828c44..cc82037f8b1 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,14 @@ 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); - else if (sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN) - typelist = void_list_node; + if (!VEC_empty (tree, typelist) + || sym->attr.is_main_program + || sym->attr.if_source != IFSRC_UNKNOWN) + is_varargs = false; if (alternate_return) type = integer_type_node; @@ -2690,7 +2689,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 1f11838f20c..baf6f2b7ac8 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 9b4c8308e2c..5034b58545a 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); -- 2.30.2