+ mio_symtree_ref (&(*f)->proc_tree);
+ (*f)->proc_sym = NULL;
+ }
+}
+
+static void
+mio_f2k_derived (gfc_namespace *f2k)
+{
+ current_f2k_derived = f2k;
+
+ /* Handle the list of finalizer procedures. */
+ mio_lparen ();
+ if (iomode == IO_OUTPUT)
+ {
+ gfc_finalizer *f;
+ for (f = f2k->finalizers; f; f = f->next)
+ mio_finalizer (&f);
+ }
+ else
+ {
+ f2k->finalizers = NULL;
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ gfc_finalizer *cur = NULL;
+ mio_finalizer (&cur);
+ cur->next = f2k->finalizers;
+ f2k->finalizers = cur;
+ }
+ }
+ mio_rparen ();
+
+ /* Handle type-bound procedures. */
+ mio_full_typebound_tree (&f2k->tb_sym_root);
+
+ /* Type-bound user operators. */
+ mio_full_typebound_tree (&f2k->tb_uop_root);
+
+ /* Type-bound intrinsic operators. */
+ mio_lparen ();
+ if (iomode == IO_OUTPUT)
+ {
+ int op;
+ for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
+ {
+ gfc_intrinsic_op realop;
+
+ if (op == INTRINSIC_USER || !f2k->tb_op[op])
+ continue;
+
+ mio_lparen ();
+ realop = (gfc_intrinsic_op) op;
+ mio_intrinsic_op (&realop);
+ mio_typebound_proc (&f2k->tb_op[op]);
+ mio_rparen ();
+ }
+ }
+ else
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ gfc_intrinsic_op op = GFC_INTRINSIC_BEGIN; /* Silence GCC. */
+
+ mio_lparen ();
+ mio_intrinsic_op (&op);
+ mio_typebound_proc (&f2k->tb_op[op]);
+ mio_rparen ();
+ }
+ mio_rparen ();
+}
+
+static void
+mio_full_f2k_derived (gfc_symbol *sym)
+{
+ mio_lparen ();
+
+ if (iomode == IO_OUTPUT)
+ {
+ if (sym->f2k_derived)
+ mio_f2k_derived (sym->f2k_derived);
+ }
+ else
+ {
+ if (peek_atom () != ATOM_RPAREN)
+ {
+ sym->f2k_derived = gfc_get_namespace (NULL, 0);
+ mio_f2k_derived (sym->f2k_derived);
+ }
+ else
+ gcc_assert (!sym->f2k_derived);
+ }
+
+ mio_rparen ();
+}
+
+
+/* Unlike most other routines, the address of the symbol node is already
+ fixed on input and the name/module has already been filled in. */
+
+static void
+mio_symbol (gfc_symbol *sym)
+{
+ int intmod = INTMOD_NONE;
+
+ mio_lparen ();
+
+ mio_symbol_attribute (&sym->attr);
+ mio_typespec (&sym->ts);
+
+ if (iomode == IO_OUTPUT)
+ mio_namespace_ref (&sym->formal_ns);
+ else
+ {
+ mio_namespace_ref (&sym->formal_ns);
+ if (sym->formal_ns)
+ {
+ sym->formal_ns->proc_name = sym;
+ sym->refs++;
+ }
+ }
+
+ /* Save/restore common block links. */
+ mio_symbol_ref (&sym->common_next);
+
+ mio_formal_arglist (&sym->formal);
+
+ if (sym->attr.flavor == FL_PARAMETER)
+ mio_expr (&sym->value);
+
+ mio_array_spec (&sym->as);
+
+ mio_symbol_ref (&sym->result);
+
+ if (sym->attr.cray_pointee)
+ mio_symbol_ref (&sym->cp_pointer);
+
+ /* Note that components are always saved, even if they are supposed
+ to be private. Component access is checked during searching. */
+
+ mio_component_list (&sym->components);
+
+ if (sym->components != NULL)
+ sym->component_access
+ = MIO_NAME (gfc_access) (sym->component_access, access_types);
+
+ /* Load/save the f2k_derived namespace of a derived-type symbol. */
+ mio_full_f2k_derived (sym);
+
+ mio_namelist (sym);
+
+ /* Add the fields that say whether this is from an intrinsic module,
+ and if so, what symbol it is within the module. */
+/* mio_integer (&(sym->from_intmod)); */
+ if (iomode == IO_OUTPUT)
+ {
+ intmod = sym->from_intmod;
+ mio_integer (&intmod);
+ }
+ else
+ {
+ mio_integer (&intmod);
+ sym->from_intmod = (intmod_id) intmod;
+ }
+
+ mio_integer (&(sym->intmod_sym_id));
+
+ if (sym->attr.flavor == FL_DERIVED)
+ mio_integer (&(sym->hash_value));
+
+ mio_rparen ();
+}
+
+
+/************************* Top level subroutines *************************/
+
+/* Given a root symtree node and a symbol, try to find a symtree that
+ references the symbol that is not a unique name. */
+
+static gfc_symtree *
+find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
+{
+ gfc_symtree *s = NULL;
+
+ if (st == NULL)
+ return s;
+
+ s = find_symtree_for_symbol (st->right, sym);
+ if (s != NULL)
+ return s;
+ s = find_symtree_for_symbol (st->left, sym);
+ if (s != NULL)
+ return s;
+
+ if (st->n.sym == sym && !check_unique_name (st->name))
+ return st;
+
+ return s;
+}
+
+
+/* A recursive function to look for a specific symbol by name and by
+ module. Whilst several symtrees might point to one symbol, its
+ is sufficient for the purposes here than one exist. Note that
+ generic interfaces are distinguished as are symbols that have been
+ renamed in another module. */
+static gfc_symtree *
+find_symbol (gfc_symtree *st, const char *name,
+ const char *module, int generic)
+{
+ int c;
+ gfc_symtree *retval, *s;
+
+ if (st == NULL || st->n.sym == NULL)
+ return NULL;
+
+ c = strcmp (name, st->n.sym->name);
+ if (c == 0 && st->n.sym->module
+ && strcmp (module, st->n.sym->module) == 0
+ && !check_unique_name (st->name))
+ {
+ s = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
+ /* Detect symbols that are renamed by use association in another
+ module by the absence of a symtree and null attr.use_rename,
+ since the latter is not transmitted in the module file. */
+ if (((!generic && !st->n.sym->attr.generic)
+ || (generic && st->n.sym->attr.generic))
+ && !(s == NULL && !st->n.sym->attr.use_rename))
+ return st;
+ }
+
+ retval = find_symbol (st->left, name, module, generic);
+
+ if (retval == NULL)
+ retval = find_symbol (st->right, name, module, generic);
+
+ return retval;
+}
+
+
+/* Skip a list between balanced left and right parens. */
+
+static void
+skip_list (void)
+{
+ int level;
+
+ level = 0;
+ do
+ {
+ switch (parse_atom ())
+ {
+ case ATOM_LPAREN:
+ level++;
+ break;
+
+ case ATOM_RPAREN:
+ level--;
+ break;
+
+ case ATOM_STRING:
+ gfc_free (atom_string);
+ break;
+
+ case ATOM_NAME:
+ case ATOM_INTEGER:
+ break;
+ }
+ }
+ while (level > 0);
+}
+
+
+/* Load operator interfaces from the module. Interfaces are unusual
+ in that they attach themselves to existing symbols. */