/* Backend function setup
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Paul Brook
#include "debug.h"
#include "gfortran.h"
#include "pointer-set.h"
+#include "constructor.h"
#include "trans.h"
#include "trans-types.h"
#include "trans-array.h"
tree gfor_fndecl_pause_string;
tree gfor_fndecl_stop_numeric;
tree gfor_fndecl_stop_string;
+tree gfor_fndecl_error_stop_string;
tree gfor_fndecl_runtime_error;
tree gfor_fndecl_runtime_error_at;
tree gfor_fndecl_runtime_warning_at;
gfortran would typically put them in either the BSS or
initialized data segments, and only mark them as common if
they were part of common blocks. However, if they are not put
- into common space, then C cannot initialize global fortran
+ into common space, then C cannot initialize global Fortran
variables that it interoperates with and the draft says that
either Fortran or C should be able to initialize it (but not
both, of course.) (J3/04-007, section 15.3). */
if (!sym->attr.target
&& !sym->attr.pointer
+ && !sym->attr.cray_pointee
&& !sym->attr.proc_pointer)
DECL_RESTRICTED_P (decl) = 1;
}
for (dim = sym->as->rank - 1; dim >= 0; dim--)
{
- rtype = build_range_type (gfc_array_index_type,
- GFC_TYPE_ARRAY_LBOUND (type, dim),
- GFC_TYPE_ARRAY_UBOUND (type, dim));
+ tree lbound, ubound;
+ lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
+ ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
+ rtype = build_range_type (gfc_array_index_type, lbound, ubound);
gtype = build_array_type (gtype, rtype);
- /* Ensure the bound variables aren't optimized out at -O0. */
- if (!optimize)
+ /* Ensure the bound variables aren't optimized out at -O0.
+ For -O1 and above they often will be optimized out, but
+ can be tracked by VTA. Also clear the artificial
+ lbound.N or ubound.N DECL_NAME, so that it doesn't end up
+ in debug info. */
+ if (lbound && TREE_CODE (lbound) == VAR_DECL
+ && DECL_ARTIFICIAL (lbound) && DECL_IGNORED_P (lbound))
{
- if (GFC_TYPE_ARRAY_LBOUND (type, dim)
- && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL)
- DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0;
- if (GFC_TYPE_ARRAY_UBOUND (type, dim)
- && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL)
- DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0;
+ if (DECL_NAME (lbound)
+ && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound)),
+ "lbound") != 0)
+ DECL_NAME (lbound) = NULL_TREE;
+ DECL_IGNORED_P (lbound) = 0;
+ }
+ if (ubound && TREE_CODE (ubound) == VAR_DECL
+ && DECL_ARTIFICIAL (ubound) && DECL_IGNORED_P (ubound))
+ {
+ if (DECL_NAME (ubound)
+ && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound)),
+ "ubound") != 0)
+ DECL_NAME (ubound) = NULL_TREE;
+ DECL_IGNORED_P (ubound) = 0;
}
}
TYPE_NAME (type) = type_decl = build_decl (input_location,
else
byref = 0;
+ /* Make sure that the vtab for the declared type is completed. */
+ if (sym->ts.type == BT_CLASS)
+ {
+ gfc_component *c = gfc_find_component (sym->ts.u.derived,
+ "$data", true, true);
+ if (!c->ts.u.derived->backend_decl)
+ gfc_find_derived_vtab (c->ts.u.derived, true);
+ }
+
if ((sym->attr.dummy && ! sym->attr.function) || (sym->attr.result && byref))
{
/* Return via extra parameter. */
if (sym->attr.assign)
gfc_add_assign_aux_vars (sym);
- if (TREE_STATIC (decl) && !sym->attr.use_assoc)
+ if (TREE_STATIC (decl) && !sym->attr.use_assoc
+ && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
+ || gfc_option.flag_max_stack_var_size == 0
+ || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
{
- /* Add static initializer. */
+ /* Add static initializer. For procedures, it is only needed if
+ SAVE is specified otherwise they need to be reinitialized
+ every time the procedure is entered. The TREE_STATIC is
+ in this case due to -fmax-stack-var-size=. */
DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
TREE_TYPE (decl), sym->attr.dimension,
sym->attr.pointer || sym->attr.allocatable);
{
/* Add static initializer. */
DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
- TREE_TYPE (decl), sym->attr.dimension, sym->attr.proc_pointer);
+ TREE_TYPE (decl),
+ sym->attr.proc_pointer ? false : sym->attr.dimension,
+ sym->attr.proc_pointer);
}
attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
IDENTIFIER_POINTER (DECL_NAME (this_function_decl)));
if (!sym->attr.mixed_entry_master && sym->attr.function)
- decl = build_decl (input_location,
+ decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl),
VAR_DECL, get_identifier (name),
gfc_sym_type (sym));
else
- decl = build_decl (input_location,
+ decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl),
VAR_DECL, get_identifier (name),
TREE_TYPE (TREE_TYPE (this_function_decl)));
DECL_ARTIFICIAL (decl) = 1;
/* Builds a function decl. The remaining parameters are the types of the
function arguments. Negative nargs indicates a varargs function. */
-tree
-gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
+static tree
+build_library_function_decl_1 (tree name, const char *spec,
+ tree rettype, int nargs, va_list p)
{
tree arglist;
tree argtype;
tree fntype;
tree fndecl;
- va_list p;
int n;
/* Library functions must be declared with global scope. */
gcc_assert (current_function_decl == NULL_TREE);
- va_start (p, nargs);
-
-
/* Create a list of the argument types. */
for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--)
{
/* Build the function type and decl. */
fntype = build_function_type (rettype, arglist);
+ if (spec)
+ {
+ tree attr_args = build_tree_list (NULL_TREE,
+ build_string (strlen (spec), spec));
+ tree attrs = tree_cons (get_identifier ("fn spec"),
+ attr_args, TYPE_ATTRIBUTES (fntype));
+ fntype = build_type_attribute_variant (fntype, attrs);
+ }
fndecl = build_decl (input_location,
FUNCTION_DECL, name, fntype);
DECL_EXTERNAL (fndecl) = 1;
TREE_PUBLIC (fndecl) = 1;
- va_end (p);
-
pushdecl (fndecl);
rest_of_decl_compilation (fndecl, 1, 0);
return fndecl;
}
+/* Builds a function decl. The remaining parameters are the types of the
+ function arguments. Negative nargs indicates a varargs function. */
+
+tree
+gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
+{
+ tree ret;
+ va_list args;
+ va_start (args, nargs);
+ ret = build_library_function_decl_1 (name, NULL, rettype, nargs, args);
+ va_end (args);
+ return ret;
+}
+
+/* Builds a function decl. The remaining parameters are the types of the
+ function arguments. Negative nargs indicates a varargs function.
+ The SPEC parameter specifies the function argument and return type
+ specification according to the fnspec function type attribute. */
+
+static tree
+gfc_build_library_function_decl_with_spec (tree name, const char *spec,
+ tree rettype, int nargs, ...)
+{
+ tree ret;
+ va_list args;
+ va_start (args, nargs);
+ ret = build_library_function_decl_1 (name, spec, rettype, nargs, args);
+ va_end (args);
+ return ret;
+}
+
static void
gfc_build_intrinsic_function_decls (void)
{
/* Stop doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1;
+ gfor_fndecl_error_stop_string =
+ gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")),
+ void_type_node, 2, pchar_type_node,
+ gfc_int4_type_node);
+ /* ERROR STOP doesn't return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1;
+
gfor_fndecl_pause_numeric =
gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")),
void_type_node, 1, gfc_int4_type_node);
gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")),
void_type_node, 1, integer_type_node);
- gfor_fndecl_in_pack = gfc_build_library_function_decl (
- get_identifier (PREFIX("internal_pack")),
+ gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("internal_pack")), ".r",
pvoid_type_node, 1, pvoid_type_node);
- gfor_fndecl_in_unpack = gfc_build_library_function_decl (
- get_identifier (PREFIX("internal_unpack")),
+ gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("internal_unpack")), ".wR",
void_type_node, 2, pvoid_type_node, pvoid_type_node);
gfor_fndecl_associated =
/* Initialize a derived type by building an lvalue from the symbol
- and using trans_assignment to do the work. */
+ and using trans_assignment to do the work. Set dealloc to false
+ if no deallocation prior the assignment is needed. */
tree
-gfc_init_default_dt (gfc_symbol * sym, tree body)
+gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc)
{
stmtblock_t fnblock;
gfc_expr *e;
gcc_assert (!sym->attr.allocatable);
gfc_set_sym_referenced (sym);
e = gfc_lval_expr_from_sym (sym);
- tmp = gfc_trans_assignment (e, sym->value, false);
+ tmp = gfc_trans_assignment (e, sym->value, false, dealloc);
if (sym->attr.dummy && (sym->attr.optional
|| sym->ns->proc_name->attr.entry_master))
{
gfc_add_expr_to_block (&fnblock, tmp);
}
else if (f->sym->value)
- body = gfc_init_default_dt (f->sym, body);
+ body = gfc_init_default_dt (f->sym, body, true);
}
gfc_add_expr_to_block (&fnblock, body);
&& sym->value
&& !sym->attr.data
&& sym->attr.save == SAVE_NONE)
- fnbody = gfc_init_default_dt (sym, fnbody);
+ fnbody = gfc_init_default_dt (sym, fnbody, false);
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
case AS_ASSUMED_SIZE:
/* Must be a dummy parameter. */
- gcc_assert (sym->attr.dummy);
+ gcc_assert (sym->attr.dummy || sym->as->cp_was_assumed);
/* We should always pass assumed size arrays the g77 way. */
- fnbody = gfc_trans_g77_array (sym, fnbody);
+ if (sym->attr.dummy)
+ fnbody = gfc_trans_g77_array (sym, fnbody);
break;
case AS_ASSUMED_SHAPE:
if (sym_has_alloc_comp && !seen_trans_deferred_array)
fnbody = gfc_trans_deferred_array (sym, fnbody);
}
- else if (sym_has_alloc_comp)
- fnbody = gfc_trans_deferred_array (sym, fnbody);
else if (sym->attr.allocatable
|| (sym->ts.type == BT_CLASS
&& sym->ts.u.derived->components->attr.allocatable))
{
- /* Automatic deallocatation of allocatable scalars. */
- tree tmp;
- gfc_expr *e;
- gfc_se se;
- stmtblock_t block;
-
- e = gfc_lval_expr_from_sym (sym);
- if (sym->ts.type == BT_CLASS)
- gfc_add_component_ref (e, "$data");
-
- gfc_init_se (&se, NULL);
- se.want_pointer = 1;
- gfc_conv_expr (&se, e);
- gfc_free_expr (e);
-
- gfc_start_block (&block);
- gfc_add_expr_to_block (&block, fnbody);
-
- /* Note: Nullifying is not needed. */
- tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL);
- gfc_add_expr_to_block (&block, tmp);
- fnbody = gfc_finish_block (&block);
+ if (!sym->attr.save)
+ {
+ /* Nullify and automatic deallocation of allocatable
+ scalars. */
+ tree tmp;
+ gfc_expr *e;
+ gfc_se se;
+ stmtblock_t block;
+
+ e = gfc_lval_expr_from_sym (sym);
+ if (sym->ts.type == BT_CLASS)
+ gfc_add_component_ref (e, "$data");
+
+ gfc_init_se (&se, NULL);
+ se.want_pointer = 1;
+ gfc_conv_expr (&se, e);
+ gfc_free_expr (e);
+
+ /* Nullify when entering the scope. */
+ gfc_start_block (&block);
+ gfc_add_modify (&block, se.expr,
+ fold_convert (TREE_TYPE (se.expr),
+ null_pointer_node));
+ gfc_add_expr_to_block (&block, fnbody);
+
+ /* Deallocate when leaving the scope. Nullifying is not
+ needed. */
+ tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true,
+ NULL);
+ gfc_add_expr_to_block (&block, tmp);
+ fnbody = gfc_finish_block (&block);
+ }
}
+ else if (sym_has_alloc_comp)
+ fnbody = gfc_trans_deferred_array (sym, fnbody);
else if (sym->ts.type == BT_CHARACTER)
{
gfc_get_backend_locus (&loc);
&& sym->value
&& !sym->attr.data
&& sym->attr.save == SAVE_NONE)
- fnbody = gfc_init_default_dt (sym, fnbody);
+ fnbody = gfc_init_default_dt (sym, fnbody, false);
else
gcc_unreachable ();
}
{
decl = sym->backend_decl;
gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
- gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE
- || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl);
- gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE
- || DECL_CONTEXT (TYPE_STUB_DECL (decl))
- == sym->ns->proc_name->backend_decl);
+
+ /* -fwhole-file mixes up the contexts so these asserts are unnecessary. */
+ if (!(gfc_option.flag_whole_file && sym->attr.use_assoc))
+ {
+ gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE
+ || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl);
+ gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE
+ || DECL_CONTEXT (TYPE_STUB_DECL (decl))
+ == sym->ns->proc_name->backend_decl);
+ }
TYPE_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
DECL_CONTEXT (TYPE_STUB_DECL (decl)) = sym->ns->proc_name->backend_decl;
gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl));
&& (sym->equiv_built || sym->attr.in_equivalence))
return;
- if (sym->backend_decl)
+ if (sym->backend_decl && !sym->attr.vtab)
internal_error ("backend decl for module variable %s already exists",
sym->name);
tree length;
length = sym->ts.u.cl->backend_decl;
- if (!INTEGER_CST_P (length))
+ gcc_assert (length || sym->attr.proc_pointer);
+ if (length && !INTEGER_CST_P (length))
{
pushdecl (length);
rest_of_decl_compilation (length, 1, 0);
return check_constant_initializer (expr, ts, false, false);
else if (expr->expr_type != EXPR_ARRAY)
return false;
- for (c = expr->value.constructor; c; c = c->next)
+ for (c = gfc_constructor_first (expr->value.constructor);
+ c; c = gfc_constructor_next (c))
{
if (c->iterator)
return false;
if (expr->expr_type != EXPR_STRUCTURE)
return false;
cm = expr->ts.u.derived->components;
- for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
+ for (c = gfc_constructor_first (expr->value.constructor);
+ c; c = gfc_constructor_next (c), cm = cm->next)
{
if (!c->expr || cm->attr.allocatable)
continue;
else if (warn_unused_variable
&& sym->attr.dummy
&& sym->attr.intent == INTENT_OUT)
- gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) but was not set",
- sym->name, &sym->declared_at);
+ {
+ if (!(sym->ts.type == BT_DERIVED
+ && sym->ts.u.derived->components->initializer))
+ gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) "
+ "but was not set", sym->name, &sym->declared_at);
+ }
/* Specific warning for unused dummy arguments. */
else if (warn_unused_variable && sym->attr.dummy)
gfc_warning ("Unused dummy argument '%s' at %L", sym->name,
cl->passed_length,
fold_convert (gfc_charlen_type_node,
integer_zero_node));
- not_absent = fold_build2 (NE_EXPR, boolean_type_node,
- fsym->backend_decl, null_pointer_node);
+ /* The symbol needs to be referenced for gfc_get_symbol_decl. */
+ fsym->attr.referenced = 1;
+ not_absent = gfc_conv_expr_present (fsym);
absent_failed = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
not_0length, not_absent);
language standard parameters. */
{
tree array_type, array, var;
+ VEC(constructor_elt,gc) *v = NULL;
/* Passing a new option to the library requires four modifications:
+ add it to the tree_cons list below
gfor_fndecl_set_options
+ modify the library (runtime/compile_options.c)! */
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- gfc_option.warn_std), NULL_TREE);
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- gfc_option.allow_std), array);
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, pedantic),
- array);
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- gfc_option.flag_dump_core), array);
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- gfc_option.flag_backtrace), array);
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- gfc_option.flag_sign_zero), array);
-
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)), array);
-
- array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
- gfc_option.flag_range_check), array);
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ gfc_option.warn_std));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ gfc_option.allow_std));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node, pedantic));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ gfc_option.flag_dump_core));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ gfc_option.flag_backtrace));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ gfc_option.flag_sign_zero));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ (gfc_option.rtcheck
+ & GFC_RTCHECK_BOUNDS)));
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node,
+ gfc_option.flag_range_check));
array_type = build_array_type (integer_type_node,
build_index_type (build_int_cst (NULL_TREE, 7)));
- array = build_constructor_from_list (array_type, nreverse (array));
+ array = build_constructor (array_type, v);
TREE_CONSTANT (array) = 1;
TREE_STATIC (array) = 1;
stmtblock_t block;
stmtblock_t body;
tree result;
- tree recurcheckvar = NULL;
+ tree recurcheckvar = NULL_TREE;
gfc_symbol *sym;
int rank;
bool is_recursive;
is_recursive = sym->attr.recursive
|| (sym->attr.entry_master
&& sym->ns->entries->sym->attr.recursive);
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+ && !is_recursive
+ && !gfc_option.flag_recursive)
{
char * msg;
}
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
- && sym->attr.subroutine)
+ && sym->attr.subroutine)
{
tree alternate_return;
alternate_return = gfc_get_fake_result_decl (sym, 0);
/* If bounds-checking is enabled, generate code to check passed in actual
arguments against the expected dummy argument attributes (e.g. string
lengths). */
- if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
add_argument_checking (&body, sym);
tmp = gfc_trans_code (ns->code);
else
result = sym->result->backend_decl;
- if (result != NULL_TREE && sym->attr.function
- && sym->ts.type == BT_DERIVED
- && sym->ts.u.derived->attr.alloc_comp
+ if (result != NULL_TREE
+ && sym->attr.function
&& !sym->attr.pointer)
{
- rank = sym->as ? sym->as->rank : 0;
- tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
- gfc_add_expr_to_block (&block, tmp2);
+ if (sym->ts.type == BT_DERIVED
+ && sym->ts.u.derived->attr.alloc_comp)
+ {
+ rank = sym->as ? sym->as->rank : 0;
+ tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+ gfc_add_expr_to_block (&block, tmp2);
+ }
+ else if (sym->attr.allocatable && sym->attr.dimension == 0)
+ gfc_add_modify (&block, result, fold_convert (TREE_TYPE (result),
+ null_pointer_node));
}
gfc_add_expr_to_block (&block, tmp);
/* Reset recursion-check variable. */
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+ && !is_recursive
+ && !gfc_option.flag_openmp
+ && recurcheckvar != NULL_TREE)
{
gfc_add_modify (&block, recurcheckvar, boolean_false_node);
recurcheckvar = NULL;
{
gfc_add_expr_to_block (&block, tmp);
/* Reset recursion-check variable. */
- if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
- {
- gfc_add_modify (&block, recurcheckvar, boolean_false_node);
- recurcheckvar = NULL;
- }
+ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+ && !is_recursive
+ && !gfc_option.flag_openmp
+ && recurcheckvar != NULL_TREE)
+ {
+ gfc_add_modify (&block, recurcheckvar, boolean_false_node);
+ recurcheckvar = NULL_TREE;
+ }
}
return;
fnname = get_file_function_name ("I");
- type = build_function_type (void_type_node,
- gfc_chainon_list (NULL_TREE, void_type_node));
+ type = build_function_type_list (void_type_node, NULL_TREE);
fndecl = build_decl (input_location,
FUNCTION_DECL, fnname, type);