static void show_symtree (gfc_symtree *st) { int len, i; show_indent (); len = strlen(st->name); fprintf (dumpfile, "symtree: '%s'", st->name); for (i=len; i<12; i++) fputc(' ', dumpfile); if (st->ambiguous) fputs( " Ambiguous", dumpfile); if (st->n.sym->ns != gfc_current_ns) fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name, st->n.sym->ns->proc_name->name); else show_symbol (st->n.sym); }
static int dump_section (FILE * f, struct ConfigVTable * h, SectionHandle s, unsigned int indent) { unsigned int sectionsize; size_t count; unsigned int i; int ret = 1; SectionEntry * entries = 0; ret = mymin (ret, cf_getSectionSize (h, s, §ionsize)); if (ret < 0) return ret; count = sectionsize; entries = (SectionEntry*)malloc (sizeof (SectionEntry) * sectionsize); ret = mymin(ret, cf_listSection (h, s, &entries[0], &count)); if (ret < 0) goto fail; assert(sectionsize == count); for (i=0; i<count; ++i) { show_indent (f,indent); if (ret >= 0) { ret = mymin (ret, dump_entry (f, h, s, indent, &entries[i])); } free ((void*)entries[i].name); } fail: free (entries); return ret; }
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_namespace (gfc_namespace *ns) { gfc_interface *intr; gfc_namespace *save; int op; gfc_equiv *eq; int i; gcc_assert (ns); save = gfc_current_ns; show_indent (); fputs ("Namespace:", dumpfile); i = 0; do { int l = i; while (i < GFC_LETTERS - 1 && gfc_compare_types (&ns->default_type[i+1], &ns->default_type[l])) i++; if (i > l) fprintf (dumpfile, " %c-%c: ", l+'A', i+'A'); else fprintf (dumpfile, " %c: ", l+'A'); show_typespec(&ns->default_type[l]); i++; } while (i < GFC_LETTERS); if (ns->proc_name != NULL) { show_indent (); fprintf (dumpfile, "procedure name = %s", ns->proc_name->name); } ++show_level; gfc_current_ns = ns; gfc_traverse_symtree (ns->common_root, show_common); gfc_traverse_symtree (ns->sym_root, show_symtree); for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++) { /* User operator interfaces */ intr = ns->op[op]; if (intr == NULL) continue; show_indent (); fprintf (dumpfile, "Operator interfaces for %s:", gfc_op2string ((gfc_intrinsic_op) op)); for (; intr; intr = intr->next) fprintf (dumpfile, " %s", intr->sym->name); } if (ns->uop_root != NULL) { show_indent (); fputs ("User operators:\n", dumpfile); gfc_traverse_user_op (ns, show_uop); } for (eq = ns->equiv; eq; eq = eq->next) show_equiv (eq); fputc ('\n', dumpfile); show_indent (); fputs ("code:", dumpfile); show_code (show_level, ns->code); --show_level; for (ns = ns->contained; ns; ns = ns->sibling) { fputs ("\nCONTAINS\n", dumpfile); ++show_level; show_namespace (ns); --show_level; } fputc ('\n', dumpfile); gfc_current_ns = save; }
static void show_code_node (int level, gfc_code *c) { gfc_forall_iterator *fa; gfc_open *open; gfc_case *cp; gfc_alloc *a; gfc_code *d; gfc_close *close; gfc_filepos *fp; gfc_inquire *i; gfc_dt *dt; gfc_namespace *ns; if (c->here) { fputc ('\n', dumpfile); code_indent (level, c->here); } else show_indent (); switch (c->op) { case EXEC_END_PROCEDURE: break; case EXEC_NOP: fputs ("NOP", dumpfile); break; case EXEC_CONTINUE: fputs ("CONTINUE", dumpfile); break; case EXEC_ENTRY: fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name); break; case EXEC_INIT_ASSIGN: case EXEC_ASSIGN: fputs ("ASSIGN ", dumpfile); show_expr (c->expr1); fputc (' ', dumpfile); show_expr (c->expr2); break; case EXEC_LABEL_ASSIGN: fputs ("LABEL ASSIGN ", dumpfile); show_expr (c->expr1); fprintf (dumpfile, " %d", c->label1->value); break; case EXEC_POINTER_ASSIGN: fputs ("POINTER ASSIGN ", dumpfile); show_expr (c->expr1); fputc (' ', dumpfile); show_expr (c->expr2); break; case EXEC_GOTO: fputs ("GOTO ", dumpfile); if (c->label1) fprintf (dumpfile, "%d", c->label1->value); else { show_expr (c->expr1); d = c->block; if (d != NULL) { fputs (", (", dumpfile); for (; d; d = d ->block) { code_indent (level, d->label1); if (d->block != NULL) fputc (',', dumpfile); else fputc (')', dumpfile); } } } break; case EXEC_CALL: case EXEC_ASSIGN_CALL: if (c->resolved_sym) fprintf (dumpfile, "CALL %s ", c->resolved_sym->name); else if (c->symtree) fprintf (dumpfile, "CALL %s ", c->symtree->name); else fputs ("CALL ?? ", dumpfile); show_actual_arglist (c->ext.actual); break; case EXEC_COMPCALL: fputs ("CALL ", dumpfile); show_compcall (c->expr1); break; case EXEC_CALL_PPC: fputs ("CALL ", dumpfile); show_expr (c->expr1); show_actual_arglist (c->ext.actual); break; case EXEC_RETURN: fputs ("RETURN ", dumpfile); if (c->expr1) show_expr (c->expr1); break; case EXEC_PAUSE: fputs ("PAUSE ", dumpfile); if (c->expr1 != NULL) show_expr (c->expr1); else fprintf (dumpfile, "%d", c->ext.stop_code); break; case EXEC_ERROR_STOP: fputs ("ERROR ", dumpfile); /* Fall through. */ case EXEC_STOP: fputs ("STOP ", dumpfile); if (c->expr1 != NULL) show_expr (c->expr1); else fprintf (dumpfile, "%d", c->ext.stop_code); break; case EXEC_SYNC_ALL: fputs ("SYNC ALL ", dumpfile); if (c->expr2 != NULL) { fputs (" stat=", dumpfile); show_expr (c->expr2); } if (c->expr3 != NULL) { fputs (" errmsg=", dumpfile); show_expr (c->expr3); } break; case EXEC_SYNC_MEMORY: fputs ("SYNC MEMORY ", dumpfile); if (c->expr2 != NULL) { fputs (" stat=", dumpfile); show_expr (c->expr2); } if (c->expr3 != NULL) { fputs (" errmsg=", dumpfile); show_expr (c->expr3); } break; case EXEC_SYNC_IMAGES: fputs ("SYNC IMAGES image-set=", dumpfile); if (c->expr1 != NULL) show_expr (c->expr1); else fputs ("* ", dumpfile); if (c->expr2 != NULL) { fputs (" stat=", dumpfile); show_expr (c->expr2); } if (c->expr3 != NULL) { fputs (" errmsg=", dumpfile); show_expr (c->expr3); } break; case EXEC_LOCK: case EXEC_UNLOCK: if (c->op == EXEC_LOCK) fputs ("LOCK ", dumpfile); else fputs ("UNLOCK ", dumpfile); fputs ("lock-variable=", dumpfile); if (c->expr1 != NULL) show_expr (c->expr1); if (c->expr4 != NULL) { fputs (" acquired_lock=", dumpfile); show_expr (c->expr4); } if (c->expr2 != NULL) { fputs (" stat=", dumpfile); show_expr (c->expr2); } if (c->expr3 != NULL) { fputs (" errmsg=", dumpfile); show_expr (c->expr3); } break; case EXEC_ARITHMETIC_IF: fputs ("IF ", dumpfile); show_expr (c->expr1); fprintf (dumpfile, " %d, %d, %d", c->label1->value, c->label2->value, c->label3->value); break; case EXEC_IF: d = c->block; fputs ("IF ", dumpfile); show_expr (d->expr1); ++show_level; show_code (level + 1, d->next); --show_level; d = d->block; for (; d; d = d->block) { code_indent (level, 0); if (d->expr1 == NULL) fputs ("ELSE", dumpfile); else { fputs ("ELSE IF ", dumpfile); show_expr (d->expr1); } ++show_level; show_code (level + 1, d->next); --show_level; } if (c->label1) code_indent (level, c->label1); else show_indent (); fputs ("ENDIF", dumpfile); break; case EXEC_BLOCK: { const char* blocktype; gfc_namespace *saved_ns; if (c->ext.block.assoc) blocktype = "ASSOCIATE"; else blocktype = "BLOCK"; show_indent (); fprintf (dumpfile, "%s ", blocktype); ++show_level; ns = c->ext.block.ns; saved_ns = gfc_current_ns; gfc_current_ns = ns; gfc_traverse_symtree (ns->sym_root, show_symtree); gfc_current_ns = saved_ns; show_code (show_level, ns->code); --show_level; show_indent (); fprintf (dumpfile, "END %s ", blocktype); break; } case EXEC_SELECT: d = c->block; fputs ("SELECT CASE ", dumpfile); show_expr (c->expr1); fputc ('\n', dumpfile); for (; d; d = d->block) { code_indent (level, 0); fputs ("CASE ", dumpfile); for (cp = d->ext.block.case_list; cp; cp = cp->next) { fputc ('(', dumpfile); show_expr (cp->low); fputc (' ', dumpfile); show_expr (cp->high); fputc (')', dumpfile); fputc (' ', dumpfile); } fputc ('\n', dumpfile); show_code (level + 1, d->next); } code_indent (level, c->label1); fputs ("END SELECT", dumpfile); break; case EXEC_WHERE: fputs ("WHERE ", dumpfile); d = c->block; show_expr (d->expr1); fputc ('\n', dumpfile); show_code (level + 1, d->next); for (d = d->block; d; d = d->block) { code_indent (level, 0); fputs ("ELSE WHERE ", dumpfile); show_expr (d->expr1); fputc ('\n', dumpfile); show_code (level + 1, d->next); } code_indent (level, 0); fputs ("END WHERE", dumpfile); break; case EXEC_FORALL: fputs ("FORALL ", dumpfile); for (fa = c->ext.forall_iterator; fa; fa = fa->next) { show_expr (fa->var); fputc (' ', dumpfile); show_expr (fa->start); fputc (':', dumpfile); show_expr (fa->end); fputc (':', dumpfile); show_expr (fa->stride); if (fa->next != NULL) fputc (',', dumpfile); } if (c->expr1 != NULL) { fputc (',', dumpfile); show_expr (c->expr1); } fputc ('\n', dumpfile); show_code (level + 1, c->block->next); code_indent (level, 0); fputs ("END FORALL", dumpfile); break; case EXEC_CRITICAL: fputs ("CRITICAL\n", dumpfile); show_code (level + 1, c->block->next); code_indent (level, 0); fputs ("END CRITICAL", dumpfile); break; case EXEC_DO: fputs ("DO ", dumpfile); if (c->label1) fprintf (dumpfile, " %-5d ", c->label1->value); show_expr (c->ext.iterator->var); fputc ('=', dumpfile); show_expr (c->ext.iterator->start); fputc (' ', dumpfile); show_expr (c->ext.iterator->end); fputc (' ', dumpfile); show_expr (c->ext.iterator->step); ++show_level; show_code (level + 1, c->block->next); --show_level; if (c->label1) break; show_indent (); fputs ("END DO", dumpfile); break; case EXEC_DO_CONCURRENT: fputs ("DO CONCURRENT ", dumpfile); for (fa = c->ext.forall_iterator; fa; fa = fa->next) { show_expr (fa->var); fputc (' ', dumpfile); show_expr (fa->start); fputc (':', dumpfile); show_expr (fa->end); fputc (':', dumpfile); show_expr (fa->stride); if (fa->next != NULL) fputc (',', dumpfile); } show_expr (c->expr1); show_code (level + 1, c->block->next); code_indent (level, c->label1); fputs ("END DO", dumpfile); break; case EXEC_DO_WHILE: fputs ("DO WHILE ", dumpfile); show_expr (c->expr1); fputc ('\n', dumpfile); show_code (level + 1, c->block->next); code_indent (level, c->label1); fputs ("END DO", dumpfile); break; case EXEC_CYCLE: fputs ("CYCLE", dumpfile); if (c->symtree) fprintf (dumpfile, " %s", c->symtree->n.sym->name); break; case EXEC_EXIT: fputs ("EXIT", dumpfile); if (c->symtree) fprintf (dumpfile, " %s", c->symtree->n.sym->name); break; case EXEC_ALLOCATE: fputs ("ALLOCATE ", dumpfile); if (c->expr1) { fputs (" STAT=", dumpfile); show_expr (c->expr1); } if (c->expr2) { fputs (" ERRMSG=", dumpfile); show_expr (c->expr2); } if (c->expr3) { if (c->expr3->mold) fputs (" MOLD=", dumpfile); else fputs (" SOURCE=", dumpfile); show_expr (c->expr3); } for (a = c->ext.alloc.list; a; a = a->next) { fputc (' ', dumpfile); show_expr (a->expr); } break; case EXEC_DEALLOCATE: fputs ("DEALLOCATE ", dumpfile); if (c->expr1) { fputs (" STAT=", dumpfile); show_expr (c->expr1); } if (c->expr2) { fputs (" ERRMSG=", dumpfile); show_expr (c->expr2); } for (a = c->ext.alloc.list; a; a = a->next) { fputc (' ', dumpfile); show_expr (a->expr); } break; case EXEC_OPEN: fputs ("OPEN", dumpfile); open = c->ext.open; if (open->unit) { fputs (" UNIT=", dumpfile); show_expr (open->unit); } if (open->iomsg) { fputs (" IOMSG=", dumpfile); show_expr (open->iomsg); } if (open->iostat) { fputs (" IOSTAT=", dumpfile); show_expr (open->iostat); } if (open->file) { fputs (" FILE=", dumpfile); show_expr (open->file); } if (open->status) { fputs (" STATUS=", dumpfile); show_expr (open->status); } if (open->access) { fputs (" ACCESS=", dumpfile); show_expr (open->access); } if (open->form) { fputs (" FORM=", dumpfile); show_expr (open->form); } if (open->recl) { fputs (" RECL=", dumpfile); show_expr (open->recl); } if (open->blank) { fputs (" BLANK=", dumpfile); show_expr (open->blank); } if (open->position) { fputs (" POSITION=", dumpfile); show_expr (open->position); } if (open->action) { fputs (" ACTION=", dumpfile); show_expr (open->action); } if (open->delim) { fputs (" DELIM=", dumpfile); show_expr (open->delim); } if (open->pad) { fputs (" PAD=", dumpfile); show_expr (open->pad); } if (open->decimal) { fputs (" DECIMAL=", dumpfile); show_expr (open->decimal); } if (open->encoding) { fputs (" ENCODING=", dumpfile); show_expr (open->encoding); } if (open->round) { fputs (" ROUND=", dumpfile); show_expr (open->round); } if (open->sign) { fputs (" SIGN=", dumpfile); show_expr (open->sign); } if (open->convert) { fputs (" CONVERT=", dumpfile); show_expr (open->convert); } if (open->asynchronous) { fputs (" ASYNCHRONOUS=", dumpfile); show_expr (open->asynchronous); } if (open->err != NULL) fprintf (dumpfile, " ERR=%d", open->err->value); break; case EXEC_CLOSE: fputs ("CLOSE", dumpfile); close = c->ext.close; if (close->unit) { fputs (" UNIT=", dumpfile); show_expr (close->unit); } if (close->iomsg) { fputs (" IOMSG=", dumpfile); show_expr (close->iomsg); } if (close->iostat) { fputs (" IOSTAT=", dumpfile); show_expr (close->iostat); } if (close->status) { fputs (" STATUS=", dumpfile); show_expr (close->status); } if (close->err != NULL) fprintf (dumpfile, " ERR=%d", close->err->value); break; case EXEC_BACKSPACE: fputs ("BACKSPACE", dumpfile); goto show_filepos; case EXEC_ENDFILE: fputs ("ENDFILE", dumpfile); goto show_filepos; case EXEC_REWIND: fputs ("REWIND", dumpfile); goto show_filepos; case EXEC_FLUSH: fputs ("FLUSH", dumpfile); show_filepos: fp = c->ext.filepos; if (fp->unit) { fputs (" UNIT=", dumpfile); show_expr (fp->unit); } if (fp->iomsg) { fputs (" IOMSG=", dumpfile); show_expr (fp->iomsg); } if (fp->iostat) { fputs (" IOSTAT=", dumpfile); show_expr (fp->iostat); } if (fp->err != NULL) fprintf (dumpfile, " ERR=%d", fp->err->value); break; case EXEC_INQUIRE: fputs ("INQUIRE", dumpfile); i = c->ext.inquire; if (i->unit) { fputs (" UNIT=", dumpfile); show_expr (i->unit); } if (i->file) { fputs (" FILE=", dumpfile); show_expr (i->file); } if (i->iomsg) { fputs (" IOMSG=", dumpfile); show_expr (i->iomsg); } if (i->iostat) { fputs (" IOSTAT=", dumpfile); show_expr (i->iostat); } if (i->exist) { fputs (" EXIST=", dumpfile); show_expr (i->exist); } if (i->opened) { fputs (" OPENED=", dumpfile); show_expr (i->opened); } if (i->number) { fputs (" NUMBER=", dumpfile); show_expr (i->number); } if (i->named) { fputs (" NAMED=", dumpfile); show_expr (i->named); } if (i->name) { fputs (" NAME=", dumpfile); show_expr (i->name); } if (i->access) { fputs (" ACCESS=", dumpfile); show_expr (i->access); } if (i->sequential) { fputs (" SEQUENTIAL=", dumpfile); show_expr (i->sequential); } if (i->direct) { fputs (" DIRECT=", dumpfile); show_expr (i->direct); } if (i->form) { fputs (" FORM=", dumpfile); show_expr (i->form); } if (i->formatted) { fputs (" FORMATTED", dumpfile); show_expr (i->formatted); } if (i->unformatted) { fputs (" UNFORMATTED=", dumpfile); show_expr (i->unformatted); } if (i->recl) { fputs (" RECL=", dumpfile); show_expr (i->recl); } if (i->nextrec) { fputs (" NEXTREC=", dumpfile); show_expr (i->nextrec); } if (i->blank) { fputs (" BLANK=", dumpfile); show_expr (i->blank); } if (i->position) { fputs (" POSITION=", dumpfile); show_expr (i->position); } if (i->action) { fputs (" ACTION=", dumpfile); show_expr (i->action); } if (i->read) { fputs (" READ=", dumpfile); show_expr (i->read); } if (i->write) { fputs (" WRITE=", dumpfile); show_expr (i->write); } if (i->readwrite) { fputs (" READWRITE=", dumpfile); show_expr (i->readwrite); } if (i->delim) { fputs (" DELIM=", dumpfile); show_expr (i->delim); } if (i->pad) { fputs (" PAD=", dumpfile); show_expr (i->pad); } if (i->convert) { fputs (" CONVERT=", dumpfile); show_expr (i->convert); } if (i->asynchronous) { fputs (" ASYNCHRONOUS=", dumpfile); show_expr (i->asynchronous); } if (i->decimal) { fputs (" DECIMAL=", dumpfile); show_expr (i->decimal); } if (i->encoding) { fputs (" ENCODING=", dumpfile); show_expr (i->encoding); } if (i->pending) { fputs (" PENDING=", dumpfile); show_expr (i->pending); } if (i->round) { fputs (" ROUND=", dumpfile); show_expr (i->round); } if (i->sign) { fputs (" SIGN=", dumpfile); show_expr (i->sign); } if (i->size) { fputs (" SIZE=", dumpfile); show_expr (i->size); } if (i->id) { fputs (" ID=", dumpfile); show_expr (i->id); } if (i->err != NULL) fprintf (dumpfile, " ERR=%d", i->err->value); break; case EXEC_IOLENGTH: fputs ("IOLENGTH ", dumpfile); show_expr (c->expr1); goto show_dt_code; break; case EXEC_READ: fputs ("READ", dumpfile); goto show_dt; case EXEC_WRITE: fputs ("WRITE", dumpfile); show_dt: dt = c->ext.dt; if (dt->io_unit) { fputs (" UNIT=", dumpfile); show_expr (dt->io_unit); } if (dt->format_expr) { fputs (" FMT=", dumpfile); show_expr (dt->format_expr); } if (dt->format_label != NULL) fprintf (dumpfile, " FMT=%d", dt->format_label->value); if (dt->namelist) fprintf (dumpfile, " NML=%s", dt->namelist->name); if (dt->iomsg) { fputs (" IOMSG=", dumpfile); show_expr (dt->iomsg); } if (dt->iostat) { fputs (" IOSTAT=", dumpfile); show_expr (dt->iostat); } if (dt->size) { fputs (" SIZE=", dumpfile); show_expr (dt->size); } if (dt->rec) { fputs (" REC=", dumpfile); show_expr (dt->rec); } if (dt->advance) { fputs (" ADVANCE=", dumpfile); show_expr (dt->advance); } if (dt->id) { fputs (" ID=", dumpfile); show_expr (dt->id); } if (dt->pos) { fputs (" POS=", dumpfile); show_expr (dt->pos); } if (dt->asynchronous) { fputs (" ASYNCHRONOUS=", dumpfile); show_expr (dt->asynchronous); } if (dt->blank) { fputs (" BLANK=", dumpfile); show_expr (dt->blank); } if (dt->decimal) { fputs (" DECIMAL=", dumpfile); show_expr (dt->decimal); } if (dt->delim) { fputs (" DELIM=", dumpfile); show_expr (dt->delim); } if (dt->pad) { fputs (" PAD=", dumpfile); show_expr (dt->pad); } if (dt->round) { fputs (" ROUND=", dumpfile); show_expr (dt->round); } if (dt->sign) { fputs (" SIGN=", dumpfile); show_expr (dt->sign); } show_dt_code: for (c = c->block->next; c; c = c->next) show_code_node (level + (c->next != NULL), c); return; case EXEC_TRANSFER: fputs ("TRANSFER ", dumpfile); show_expr (c->expr1); break; case EXEC_DT_END: fputs ("DT_END", dumpfile); dt = c->ext.dt; if (dt->err != NULL) fprintf (dumpfile, " ERR=%d", dt->err->value); if (dt->end != NULL) fprintf (dumpfile, " END=%d", dt->end->value); if (dt->eor != NULL) fprintf (dumpfile, " EOR=%d", dt->eor->value); break; case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: case EXEC_OMP_DO: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: show_omp_node (level, c); break; default: gfc_internal_error ("show_code_node(): Bad statement code"); } }
static void gfc_show_symbol (gfc_symbol * sym) { gfc_formal_arglist *formal; gfc_interface *intr; if (sym == NULL) return; show_indent (); gfc_status ("symbol %s ", sym->name); gfc_show_typespec (&sym->ts); gfc_show_attr (&sym->attr); if (sym->value) { show_indent (); gfc_status ("value: "); gfc_show_expr (sym->value); } if (sym->as) { show_indent (); gfc_status ("Array spec:"); gfc_show_array_spec (sym->as); } if (sym->generic) { show_indent (); gfc_status ("Generic interfaces:"); for (intr = sym->generic; intr; intr = intr->next) gfc_status (" %s", intr->sym->name); } if (sym->result) { show_indent (); gfc_status ("result: %s", sym->result->name); } if (sym->components) { show_indent (); gfc_status ("components: "); gfc_show_components (sym); } if (sym->formal) { show_indent (); gfc_status ("Formal arglist:"); for (formal = sym->formal; formal; formal = formal->next) { if (formal->sym != NULL) gfc_status (" %s", formal->sym->name); else gfc_status (" [Alt Return]"); } } if (sym->formal_ns) { show_indent (); gfc_status ("Formal namespace"); gfc_show_namespace (sym->formal_ns); } gfc_status_char ('\n'); }
void gfc_show_namespace (gfc_namespace * ns) { gfc_interface *intr; gfc_namespace *save; gfc_intrinsic_op op; gfc_equiv *eq; int i; save = gfc_current_ns; show_level++; show_indent (); gfc_status ("Namespace:"); if (ns != NULL) { i = 0; do { int l = i; while (i < GFC_LETTERS - 1 && gfc_compare_types(&ns->default_type[i+1], &ns->default_type[l])) i++; if (i > l) gfc_status(" %c-%c: ", l+'A', i+'A'); else gfc_status(" %c: ", l+'A'); gfc_show_typespec(&ns->default_type[l]); i++; } while (i < GFC_LETTERS); if (ns->proc_name != NULL) { show_indent (); gfc_status ("procedure name = %s", ns->proc_name->name); } gfc_current_ns = ns; gfc_traverse_symtree (ns->common_root, show_common); gfc_traverse_symtree (ns->sym_root, show_symtree); for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++) { /* User operator interfaces */ intr = ns->operator[op]; if (intr == NULL) continue; show_indent (); gfc_status ("Operator interfaces for %s:", gfc_op2string (op)); for (; intr; intr = intr->next) gfc_status (" %s", intr->sym->name); } if (ns->uop_root != NULL) { show_indent (); gfc_status ("User operators:\n"); gfc_traverse_user_op (ns, show_uop); } } for (eq = ns->equiv; eq; eq = eq->next) gfc_show_equiv (eq); gfc_status_char ('\n'); gfc_status_char ('\n'); gfc_show_code (0, ns->code); for (ns = ns->contained; ns; ns = ns->sibling) { show_indent (); gfc_status ("CONTAINS\n"); gfc_show_namespace (ns); } show_level--; gfc_status_char ('\n'); gfc_current_ns = save; }
void g95_show_namespace(g95_namespace *ns) { g95_interface *intr; g95_namespace *save; int i; if (ns == NULL) return; save = g95_current_ns; show_indent(); g95_status("ns("); for(i=0; i<G95_LETTERS; i++) { g95_status("%c=", i+'A'); show_typespec(&ns->default_type[i]); if (i != G95_LETTERS-1) g95_status_char(','); g95_status_char((i % 3 == 2) ? '\n' : ' '); } if (ns->proc_name != NULL) g95_status(", name='%s'", ns->proc_name->name); g95_status(")\n"); for(i=0; i<G95_INTRINSIC_OPS; i++) { /* User operator interfaces */ intr = ns->operator[i]; if (intr == NULL) continue; g95_status("operator('%s', [", g95_op2string(i)); for(; intr; intr=intr->next) g95_status(" '%s',", intr->sym->name); g95_status("])\n"); } g95_traverse_user_op(ns, show_uop); g95_traverse_symtree(ns, g95_clear_sym_mark); g95_current_ns = ns; g95_traverse_symtree(ns, show_symtree); g95_status("\n\n"); show_code(0, ns->code); show_level++; for(ns=ns->contained; ns; ns=ns->sibling) { g95_status("# Contains\n"); g95_show_namespace(ns); } show_level--; g95_status_char('\n'); g95_current_ns = save; }
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"); }