aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/module.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/module.c')
-rw-r--r--gcc/fortran/module.c91
1 files changed, 61 insertions, 30 deletions
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 12d52c419a9..4b69b738db1 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -655,7 +655,8 @@ compare_true_names (void * _t1, void * _t2)
t1 = (true_name *) _t1;
t2 = (true_name *) _t2;
- c = strcmp (t1->sym->module, t2->sym->module);
+ c = ((t1->sym->module > t2->sym->module)
+ - (t1->sym->module < t2->sym->module));
if (c != 0)
return c;
@@ -673,8 +674,11 @@ find_true_name (const char *name, const char *module)
gfc_symbol sym;
int c;
- strcpy (sym.name, name);
- strcpy (sym.module, module);
+ sym.name = gfc_get_string (name);
+ if (module != NULL)
+ sym.module = gfc_get_string (module);
+ else
+ sym.module = NULL;
t.sym = &sym;
p = true_name_root;
@@ -1341,8 +1345,33 @@ mio_allocated_string (const char *s)
}
-/* Read or write a string that is in static memory or inside of some
- already-allocated structure. */
+/* Read or write a string that is in static memory. */
+
+static void
+mio_pool_string (const char **stringp)
+{
+ /* TODO: one could write the string only once, and refer to it via a
+ fixup pointer. */
+
+ /* As a special case we have to deal with a NULL string. This
+ happens for the 'module' member of 'gfc_symbol's that are not in a
+ module. We read / write these as the empty string. */
+ if (iomode == IO_OUTPUT)
+ {
+ const char *p = *stringp == NULL ? "" : *stringp;
+ write_atom (ATOM_STRING, p);
+ }
+ else
+ {
+ require_atom (ATOM_STRING);
+ *stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string);
+ gfc_free (atom_string);
+ }
+}
+
+
+/* Read or write a string that is inside of some already-allocated
+ structure. */
static void
mio_internal_string (char *string)
@@ -1802,7 +1831,7 @@ mio_component_ref (gfc_component ** cp, gfc_symbol * sym)
p->type = P_COMPONENT;
if (iomode == IO_OUTPUT)
- mio_internal_string ((*cp)->name);
+ mio_pool_string (&(*cp)->name);
else
{
mio_internal_string (name);
@@ -1851,7 +1880,7 @@ mio_component (gfc_component * c)
if (p->type == P_UNKNOWN)
p->type = P_COMPONENT;
- mio_internal_string (c->name);
+ mio_pool_string (&c->name);
mio_typespec (&c->ts);
mio_array_spec (&c->as);
@@ -1907,7 +1936,7 @@ mio_actual_arg (gfc_actual_arglist * a)
{
mio_lparen ();
- mio_internal_string (a->name);
+ mio_pool_string (&a->name);
mio_expr (&a->expr);
mio_rparen ();
}
@@ -2404,14 +2433,15 @@ mio_expr (gfc_expr ** ep)
switch (e->expr_type)
{
case EXPR_OP:
- e->operator = MIO_NAME(gfc_intrinsic_op) (e->operator, intrinsics);
+ e->value.op.operator
+ = MIO_NAME(gfc_intrinsic_op) (e->value.op.operator, intrinsics);
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
case INTRINSIC_NOT:
- mio_expr (&e->op1);
+ mio_expr (&e->value.op.op1);
break;
case INTRINSIC_PLUS:
@@ -2430,8 +2460,8 @@ mio_expr (gfc_expr ** ep)
case INTRINSIC_GE:
case INTRINSIC_LT:
case INTRINSIC_LE:
- mio_expr (&e->op1);
- mio_expr (&e->op2);
+ mio_expr (&e->value.op.op1);
+ mio_expr (&e->value.op.op2);
break;
default:
@@ -2598,14 +2628,14 @@ mio_interface (gfc_interface ** ip)
/* Save/restore a named operator interface. */
static void
-mio_symbol_interface (char *name, char *module,
+mio_symbol_interface (const char **name, const char **module,
gfc_interface ** ip)
{
mio_lparen ();
- mio_internal_string (name);
- mio_internal_string (module);
+ mio_pool_string (name);
+ mio_pool_string (module);
mio_interface_rest (ip);
}
@@ -2627,7 +2657,7 @@ mio_namespace_ref (gfc_namespace ** nsp)
ns = (gfc_namespace *)p->u.pointer;
if (ns == NULL)
{
- ns = gfc_get_namespace (NULL);
+ ns = gfc_get_namespace (NULL, 0);
associate_integer_pointer (p, ns);
}
else
@@ -2878,12 +2908,12 @@ load_needed (pointer_info * p)
the namespaces that hold the formal parameters of module
procedures. */
- ns = gfc_get_namespace (NULL);
+ ns = gfc_get_namespace (NULL, 0);
associate_integer_pointer (q, ns);
}
sym = gfc_new_symbol (p->u.rsym.true_name, ns);
- strcpy (sym->module, p->u.rsym.module);
+ sym->module = gfc_get_string (p->u.rsym.module);
associate_integer_pointer (p, sym);
}
@@ -3036,7 +3066,7 @@ read_module (void)
sym = info->u.rsym.sym =
gfc_new_symbol (info->u.rsym.true_name, gfc_current_ns);
- strcpy (sym->module, info->u.rsym.module);
+ sym->module = gfc_get_string (info->u.rsym.module);
}
st->n.sym = sym;
@@ -3169,7 +3199,7 @@ write_common (gfc_symtree *st)
write_common(st->right);
mio_lparen();
- mio_internal_string(st->name);
+ mio_pool_string(&st->name);
p = st->n.common;
mio_symbol_ref(&p->head);
@@ -3189,9 +3219,9 @@ write_symbol (int n, gfc_symbol * sym)
gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
mio_integer (&n);
- mio_internal_string (sym->name);
+ mio_pool_string (&sym->name);
- mio_internal_string (sym->module);
+ mio_pool_string (&sym->module);
mio_pointer_ref (&sym->ns);
mio_symbol (sym);
@@ -3216,8 +3246,8 @@ write_symbol0 (gfc_symtree * st)
write_symbol0 (st->right);
sym = st->n.sym;
- if (sym->module[0] == '\0')
- strcpy (sym->module, module_name);
+ if (sym->module == NULL)
+ sym->module = gfc_get_string (module_name);
if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
&& !sym->attr.subroutine && !sym->attr.function)
@@ -3264,8 +3294,8 @@ write_symbol1 (pointer_info * p)
/* FIXME: This shouldn't be necessary, but it works around
deficiencies in the module loader or/and symbol handling. */
- if (p->u.wsym.sym->module[0] == '\0' && p->u.wsym.sym->attr.dummy)
- strcpy (p->u.wsym.sym->module, module_name);
+ if (p->u.wsym.sym->module == NULL && p->u.wsym.sym->attr.dummy)
+ p->u.wsym.sym->module = gfc_get_string (module_name);
p->u.wsym.state = WRITTEN;
write_symbol (p->integer, p->u.wsym.sym);
@@ -3280,12 +3310,13 @@ static void
write_operator (gfc_user_op * uop)
{
static char nullstring[] = "";
+ const char *p = nullstring;
if (uop->operator == NULL
|| !gfc_check_access (uop->access, uop->ns->default_access))
return;
- mio_symbol_interface (uop->name, nullstring, &uop->operator);
+ mio_symbol_interface (&uop->name, &p, &uop->operator);
}
@@ -3299,7 +3330,7 @@ write_generic (gfc_symbol * sym)
|| !gfc_check_access (sym->attr.access, sym->ns->default_access))
return;
- mio_symbol_interface (sym->name, sym->module, &sym->generic);
+ mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
}
@@ -3322,7 +3353,7 @@ write_symtree (gfc_symtree * st)
if (p == NULL)
gfc_internal_error ("write_symtree(): Symbol not written");
- mio_internal_string (st->name);
+ mio_pool_string (&st->name);
mio_integer (&st->ambiguous);
mio_integer (&p->integer);
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-01 21:50:08 +0000