@@ -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,
@@ -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);
@@ -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;
@@ -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
@@ -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);