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"); }