void
gfc_trans_common (gfc_namespace *ns)
{
gfc_common_head *c;
/* Translate the blank common block. */
if (ns->blank_common.head != NULL)
{
c = gfc_get_common_head ();
/* We've lost the real location, so use the location of the
enclosing procedure. */
c->where = ns->proc_name->declared_at;
strcpy (c->name, BLANK_COMMON_NAME);
translate_common (c, ns->blank_common.head);
}
/* Translate all named common blocks. */
gfc_traverse_symtree (ns->common_root, named_common);
/* Commit the newly created symbols for common blocks. */
gfc_commit_symbols ();
/* Translate local equivalence. */
finish_equivalences (ns);
}
static void
finish_equivalences (gfc_namespace *ns)
{
gfc_equiv *z, *y;
gfc_symbol *sym;
gfc_common_head * c;
HOST_WIDE_INT offset;
unsigned HOST_WIDE_INT align;
bool dummy;
for (z = ns->equiv; z; z = z->next)
for (y = z->eq; y; y = y->eq)
{
if (y->used)
continue;
sym = z->expr->symtree->n.sym;
current_segment = get_segment_info (sym, 0);
/* All objects directly or indirectly equivalenced with this
symbol. */
add_equivalences (&dummy);
/* Align the block. */
offset = align_segment (&align);
/* Ensure all offsets are positive. */
offset -= current_segment->offset & ~(align - 1);
apply_segment_offset (current_segment, offset);
/* Create the decl. If this is a module equivalence, it has a
unique name, pointed to by z->module. This is written to a
gfc_common_header to push create_common into using
build_common_decl, so that the equivalence appears as an
external symbol. Otherwise, a local declaration is built using
build_equiv_decl. */
if (z->module)
{
c = gfc_get_common_head ();
/* We've lost the real location, so use the location of the
enclosing procedure. */
c->where = ns->proc_name->declared_at;
strcpy (c->name, z->module);
}
else
c = NULL;
create_common (c, current_segment, true);
break;
}
}
void
gfc_trans_common (gfc_namespace *ns)
{
gfc_common_head *c;
/* Translate the blank common block. */
if (ns->blank_common.head != NULL)
{
c = gfc_get_common_head ();
c->where = ns->blank_common.head->common_head->where;
strcpy (c->name, BLANK_COMMON_NAME);
translate_common (c, ns->blank_common.head);
}
/* Translate all named common blocks. */
gfc_traverse_symtree (ns->common_root, named_common);
/* Translate local equivalence. */
finish_equivalences (ns);
/* Commit the newly created symbols for common blocks and module
equivalences. */
gfc_commit_symbols ();
}
