+/* Save/restore the f2k_derived namespace of a derived-type symbol. */
+
+static gfc_namespace* current_f2k_derived;
+
+static void
+mio_typebound_proc (gfc_typebound_proc** proc)
+{
+ int flag;
+ int overriding_flag;
+
+ if (iomode == IO_INPUT)
+ {
+ *proc = gfc_get_typebound_proc ();
+ (*proc)->where = gfc_current_locus;
+ }
+ gcc_assert (*proc);
+
+ mio_lparen ();
+
+ (*proc)->access = MIO_NAME (gfc_access) ((*proc)->access, access_types);
+
+ /* IO the NON_OVERRIDABLE/DEFERRED combination. */
+ gcc_assert (!((*proc)->deferred && (*proc)->non_overridable));
+ overriding_flag = ((*proc)->deferred << 1) | (*proc)->non_overridable;
+ overriding_flag = mio_name (overriding_flag, binding_overriding);
+ (*proc)->deferred = ((overriding_flag & 2) != 0);
+ (*proc)->non_overridable = ((overriding_flag & 1) != 0);
+ gcc_assert (!((*proc)->deferred && (*proc)->non_overridable));
+
+ (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing);
+ (*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic);
+
+ if (iomode == IO_INPUT)
+ (*proc)->pass_arg = NULL;
+
+ flag = (int) (*proc)->pass_arg_num;
+ mio_integer (&flag);
+ (*proc)->pass_arg_num = (unsigned) flag;
+
+ if ((*proc)->is_generic)
+ {
+ gfc_tbp_generic* g;
+
+ mio_lparen ();
+
+ if (iomode == IO_OUTPUT)
+ for (g = (*proc)->u.generic; g; g = g->next)
+ mio_allocated_string (g->specific_st->name);
+ else
+ {
+ (*proc)->u.generic = NULL;
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ gfc_symtree** sym_root;
+
+ g = gfc_get_tbp_generic ();
+ g->specific = NULL;
+
+ require_atom (ATOM_STRING);
+ sym_root = ¤t_f2k_derived->tb_sym_root;
+ g->specific_st = gfc_get_tbp_symtree (sym_root, atom_string);
+ gfc_free (atom_string);
+
+ g->next = (*proc)->u.generic;
+ (*proc)->u.generic = g;
+ }
+ }
+
+ mio_rparen ();
+ }
+ else
+ mio_symtree_ref (&(*proc)->u.specific);
+
+ mio_rparen ();
+}
+
+static void
+mio_typebound_symtree (gfc_symtree* st)
+{
+ if (iomode == IO_OUTPUT && !st->n.tb)
+ return;
+
+ if (iomode == IO_OUTPUT)
+ {
+ mio_lparen ();
+ mio_allocated_string (st->name);
+ }
+ /* For IO_INPUT, the above is done in mio_f2k_derived. */
+
+ mio_typebound_proc (&st->n.tb);
+ mio_rparen ();
+}
+
+static void
+mio_finalizer (gfc_finalizer **f)
+{
+ if (iomode == IO_OUTPUT)
+ {
+ gcc_assert (*f);
+ gcc_assert ((*f)->proc_tree); /* Should already be resolved. */
+ mio_symtree_ref (&(*f)->proc_tree);
+ }
+ else
+ {
+ *f = gfc_get_finalizer ();
+ (*f)->where = gfc_current_locus; /* Value should not matter. */
+ (*f)->next = NULL;
+
+ 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_lparen ();
+ if (iomode == IO_OUTPUT)
+ gfc_traverse_symtree (f2k->tb_sym_root, &mio_typebound_symtree);
+ else
+ {
+ while (peek_atom () == ATOM_LPAREN)
+ {
+ gfc_symtree* st;
+
+ mio_lparen ();
+
+ require_atom (ATOM_STRING);
+ st = gfc_get_tbp_symtree (&f2k->tb_sym_root, atom_string);
+ gfc_free (atom_string);
+
+ mio_typebound_symtree (st);
+ }
+ }
+ 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 ();
+}
+
+