static void
show_components (gfc_symbol *sym)
{
gfc_component *c;
for (c = sym->components; c; c = c->next)
{
fprintf (dumpfile, "(%s ", c->name);
show_typespec (&c->ts);
if (c->attr.allocatable)
fputs (" ALLOCATABLE", dumpfile);
if (c->attr.pointer)
fputs (" POINTER", dumpfile);
if (c->attr.proc_pointer)
fputs (" PPC", dumpfile);
if (c->attr.dimension)
fputs (" DIMENSION", dumpfile);
fputc (' ', dumpfile);
show_array_spec (c->as);
if (c->attr.access)
fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
fputc (')', dumpfile);
if (c->next != NULL)
fputc (' ', dumpfile);
}
}
static void show_component(g95_component *c) {
g95_status("comp(%s, ts=", c->name);
show_typespec(&c->ts);
if (c->pointer)
g95_status(", pointer=1");
if (c->dimension)
g95_status(", dimension=1");
if (c->allocatable)
g95_status(", allocatable=1");
if (c->as != NULL) {
g95_status(", as=");
show_array_spec(c->as);
}
g95_status(")");
}
static void
show_symbol (gfc_symbol *sym)
{
gfc_formal_arglist *formal;
gfc_interface *intr;
int i,len;
if (sym == NULL)
return;
fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
len = strlen (sym->name);
for (i=len; i<12; i++)
fputc(' ', dumpfile);
++show_level;
show_indent ();
fputs ("type spec : ", dumpfile);
show_typespec (&sym->ts);
show_indent ();
fputs ("attributes: ", dumpfile);
show_attr (&sym->attr, sym->module);
if (sym->value)
{
show_indent ();
fputs ("value: ", dumpfile);
show_expr (sym->value);
}
if (sym->as)
{
show_indent ();
fputs ("Array spec:", dumpfile);
show_array_spec (sym->as);
}
if (sym->generic)
{
show_indent ();
fputs ("Generic interfaces:", dumpfile);
for (intr = sym->generic; intr; intr = intr->next)
fprintf (dumpfile, " %s", intr->sym->name);
}
if (sym->result)
{
show_indent ();
fprintf (dumpfile, "result: %s", sym->result->name);
}
if (sym->components)
{
show_indent ();
fputs ("components: ", dumpfile);
show_components (sym);
}
if (sym->f2k_derived)
{
show_indent ();
if (sym->hash_value)
fprintf (dumpfile, "hash: %d", sym->hash_value);
show_f2k_derived (sym->f2k_derived);
}
if (sym->formal)
{
show_indent ();
fputs ("Formal arglist:", dumpfile);
for (formal = sym->formal; formal; formal = formal->next)
{
if (formal->sym != NULL)
fprintf (dumpfile, " %s", formal->sym->name);
else
fputs (" [Alt Return]", dumpfile);
}
}
if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
&& sym->attr.proc != PROC_ST_FUNCTION
&& !sym->attr.entry)
{
show_indent ();
fputs ("Formal namespace", dumpfile);
show_namespace (sym->formal_ns);
}
--show_level;
}
static void show_symbol(g95_symbol *sym) {
g95_formal_arglist *formal;
symbol_attribute *attr;
g95_component *c;
if (sym == NULL)
return;
show_indent();
g95_status("symbol(%s, ts=", g95_symbol_name(sym));
show_typespec(&sym->ts);
attr = &sym->attr;
g95_status(", flavor='%s'", g95_flavor_string(attr->flavor));
if (attr->intent != INTENT_UNKNOWN)
g95_status(", intent='%s'", g95_intent_string(attr->intent));
if (attr->access != ACCESS_UNKNOWN)
g95_status(", access='%s'", g95_access_string(attr->access));
if (attr->proc != PROC_UNKNOWN)
g95_status(", proc='%s'", g95_procedure_string(attr->proc));
if (attr->allocatable)
g95_status(", allocatable=1");
if (attr->dimension)
g95_status(", dimension=1");
if (attr->external)
g95_status(", external=1");
if (attr->intrinsic)
g95_status(", intrinsic=1");
if (attr->optional)
g95_status(", optional=1");
if (attr->pointer)
g95_status(", pointer=1");
if (attr->save)
g95_status(", save=1");
if (attr->target)
g95_status(", target=1");
if (attr->dummy)
g95_status(", dummy=1");
if (attr->result_var)
g95_status(", result=1");
if (attr->entry)
g95_status(", entry=1");
if (attr->data)
g95_status(", data=1");
if (attr->use_assoc)
g95_status(", use_assoc=1");
if (attr->in_namelist)
g95_status(", in_namelist=1");
if (attr->in_common)
g95_status(", in_common=1");
if (attr->function)
g95_status(", function=1");
if (attr->subroutine)
g95_status(", subroutine=1");
if (attr->sequence)
g95_status(", sequence=1");
if (attr->elemental)
g95_status(", elemental=1");
if (attr->pure)
g95_status(", pure=1");
if (attr->recursive)
g95_status(", recursive=1");
if (attr->artificial)
g95_status(", artificial=1");
if (sym->value) {
g95_status(", value=");
g95_show_expr(sym->value);
}
if (sym->as != NULL) {
g95_status(", as=");
show_array_spec(sym->as);
}
if (sym->result)
g95_status(", result=%s", g95_symbol_name(sym->result));
if (sym->components) {
g95_status(", components=[");
for(c=sym->components; c; c=c->next)
show_component(c);
g95_status("]");
}
if (sym->formal) {
show_indent();
g95_status("formal=[");
for(formal=sym->formal; formal; formal=formal->next)
if (formal->sym == NULL)
g95_status("*");
else
g95_status("'%s', ", formal->sym->name);
g95_status("]");
}
g95_status(")\n");
}
