/* Don't put any single quote (') in MOD_VERSION,
if yout want it to be recognized. */
-#define MOD_VERSION "0"
+#define MOD_VERSION "2"
/* Structure that describes a position within a module file. */
/* Structure for holding extra info needed for pointers being read. */
+enum gfc_rsym_state
+{
+ UNUSED,
+ NEEDED,
+ USED
+};
+
+enum gfc_wsym_state
+{
+ UNREFERENCED = 0,
+ NEEDS_WRITE,
+ WRITTEN
+};
+
typedef struct pointer_info
{
BBT_HEADER (pointer_info);
{
gfc_symbol *sym;
char true_name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
- enum
- { UNUSED, NEEDED, USED }
- state;
+ enum gfc_rsym_state state;
int ns, referenced, renamed;
module_locus where;
fixup_t *stfixup;
struct
{
gfc_symbol *sym;
- enum
- { UNREFERENCED = 0, NEEDS_WRITE, WRITTEN }
- state;
+ enum gfc_wsym_state state;
}
wsym;
}
minit ("GENERIC", 1),
minit (NULL, -1)
};
-
+static const mstring binding_ppc[] =
+{
+ minit ("NO_PPC", 0),
+ minit ("PPC", 1),
+ minit (NULL, -1)
+};
/* Specialization of mio_name. */
DECL_MIO_NAME (ab_attribute)
mio_symbol_attribute (symbol_attribute *attr)
{
atom_type t;
+ unsigned ext_attr;
mio_lparen ();
attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
attr->save = MIO_NAME (save_state) (attr->save, save_status);
+ ext_attr = attr->ext_attr;
+ mio_integer ((int *) &ext_attr);
+ attr->ext_attr = ext_attr;
if (iomode == IO_OUTPUT)
{
{
if (peek_atom () != ATOM_RPAREN)
{
- cl = gfc_get_charlen ();
+ cl = gfc_new_charlen (gfc_current_ns);
mio_expr (&cl->length);
-
*clp = cl;
-
- cl->next = gfc_current_ns->cl_list;
- gfc_current_ns->cl_list = cl;
}
}
if (ts->type != BT_DERIVED)
mio_integer (&ts->kind);
else
- mio_symbol_ref (&ts->derived);
+ mio_symbol_ref (&ts->u.derived);
/* Add info for C interop and is_iso_c. */
mio_integer (&ts->is_c_interop);
if (ts->type != BT_CHARACTER)
{
- /* ts->cl is only valid for BT_CHARACTER. */
+ /* ts->u.cl is only valid for BT_CHARACTER. */
mio_lparen ();
mio_rparen ();
}
else
- mio_charlen (&ts->cl);
+ mio_charlen (&ts->u.cl);
mio_rparen ();
}
}
+static void mio_namespace_ref (gfc_namespace **nsp);
+static void mio_formal_arglist (gfc_formal_arglist **formal);
+static void mio_typebound_proc (gfc_typebound_proc** proc);
+
static void
mio_component (gfc_component *c)
{
pointer_info *p;
int n;
+ gfc_formal_arglist *formal;
mio_lparen ();
c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types);
mio_expr (&c->initializer);
+
+ if (c->attr.proc_pointer)
+ {
+ if (iomode == IO_OUTPUT)
+ {
+ formal = c->formal;
+ while (formal && !formal->sym)
+ formal = formal->next;
+
+ if (formal)
+ mio_namespace_ref (&formal->sym->ns);
+ else
+ mio_namespace_ref (&c->formal_ns);
+ }
+ else
+ {
+ mio_namespace_ref (&c->formal_ns);
+ /* TODO: if (c->formal_ns)
+ {
+ c->formal_ns->proc_name = c;
+ c->refs++;
+ }*/
+ }
+
+ mio_formal_arglist (&c->formal);
+
+ mio_typebound_proc (&c->tb);
+ }
+
mio_rparen ();
}
/* Read and write formal argument lists. */
static void
-mio_formal_arglist (gfc_symbol *sym)
+mio_formal_arglist (gfc_formal_arglist **formal)
{
gfc_formal_arglist *f, *tail;
if (iomode == IO_OUTPUT)
{
- for (f = sym->formal; f; f = f->next)
+ for (f = *formal; f; f = f->next)
mio_symbol_ref (&f->sym);
}
else
{
- sym->formal = tail = NULL;
+ *formal = tail = NULL;
while (peek_atom () != ATOM_RPAREN)
{
f = gfc_get_formal_arglist ();
mio_symbol_ref (&f->sym);
- if (sym->formal == NULL)
- sym->formal = f;
+ if (*formal == NULL)
+ *formal = f;
else
tail->next = f;
case BT_COMPLEX:
gfc_set_model_kind (e->ts.kind);
- mio_gmp_real (&e->value.complex.r);
- mio_gmp_real (&e->value.complex.i);
+ mio_gmp_real (&mpc_realref (e->value.complex));
+ mio_gmp_real (&mpc_imagref (e->value.complex));
break;
case BT_LOGICAL:
(*proc)->nopass = mio_name ((*proc)->nopass, binding_passing);
(*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic);
+ (*proc)->ppc = mio_name((*proc)->ppc, binding_ppc);
- if (iomode == IO_INPUT)
- (*proc)->pass_arg = NULL;
+ mio_pool_string (&((*proc)->pass_arg));
flag = (int) (*proc)->pass_arg_num;
mio_integer (&flag);
mio_rparen ();
}
- else
+ else if (!(*proc)->ppc)
mio_symtree_ref (&(*proc)->u.specific);
mio_rparen ();
f2k->finalizers = NULL;
while (peek_atom () != ATOM_RPAREN)
{
- gfc_finalizer *cur;
+ gfc_finalizer *cur = NULL;
mio_finalizer (&cur);
cur->next = f2k->finalizers;
f2k->finalizers = cur;
{
int intmod = INTMOD_NONE;
- gfc_formal_arglist *formal;
-
mio_lparen ();
mio_symbol_attribute (&sym->attr);
mio_typespec (&sym->ts);
- /* Contained procedures don't have formal namespaces. Instead we output the
- procedure namespace. The will contain the formal arguments. */
if (iomode == IO_OUTPUT)
- {
- formal = sym->formal;
- while (formal && !formal->sym)
- formal = formal->next;
-
- if (formal)
- mio_namespace_ref (&formal->sym->ns);
- else
- mio_namespace_ref (&sym->formal_ns);
- }
+ mio_namespace_ref (&sym->formal_ns);
else
{
mio_namespace_ref (&sym->formal_ns);
/* Save/restore common block links. */
mio_symbol_ref (&sym->common_next);
- mio_formal_arglist (sym);
+ mio_formal_arglist (&sym->formal);
if (sym->attr.flavor == FL_PARAMETER)
mio_expr (&sym->value);
module_locus operator_interfaces, user_operators;
const char *p;
char name[GFC_MAX_SYMBOL_LEN + 1];
- gfc_intrinsic_op i;
+ int i;
int ambiguous, j, nuse, symbol;
pointer_info *info, *q;
gfc_use_rename *u;
if (only_flag)
{
- u = find_use_operator (i);
+ u = find_use_operator ((gfc_intrinsic_op) i);
if (u == NULL)
{
static void
write_module (void)
{
- gfc_intrinsic_op i;
+ int i;
/* Write the operator interfaces. */
mio_lparen ();
if ((file = fopen (filename, "r")) == NULL)
return -1;
- /* Read two lines. */
+ /* Read the first line. */
if (fgets (buf, sizeof (buf) - 1, file) == NULL)
{
fclose (file);
/* The file also needs to be overwritten if the version number changed. */
n = strlen ("GFORTRAN module version '" MOD_VERSION "' created");
if (strncmp (buf, "GFORTRAN module version '" MOD_VERSION "' created", n) != 0)
- return -1;
+ {
+ fclose (file);
+ return -1;
+ }
+ /* Read a second line. */
if (fgets (buf, sizeof (buf) - 1, file) == NULL)
{
fclose (file);
if (mod_symtree == NULL)
{
/* symtree doesn't already exist in current namespace. */
- gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree);
+ gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree,
+ false);
if (mod_symtree != NULL)
mod_sym = mod_symtree->n.sym;
gfc_error ("Symbol '%s' already declared", name);
}
- gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree);
+ gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
sym = tmp_symtree->n.sym;
sym->module = gfc_get_string (modname);
mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, mod);
if (mod_symtree == NULL)
{
- gfc_get_sym_tree (mod, gfc_current_ns, &mod_symtree);
+ gfc_get_sym_tree (mod, gfc_current_ns, &mod_symtree, false);
gcc_assert (mod_symtree);
mod_sym = mod_symtree->n.sym;
OSDN Git Service
