This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH] less build_function_type usage in the Fortran FE
- From: Nathan Froyd <froydnj at codesourcery dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Tue, 3 May 2011 12:06:57 -0700
- Subject: [PATCH] less build_function_type usage in the Fortran FE
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);