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 show_f2k_derived (gfc_namespace* f2k) { gfc_finalizer* f; int op; show_indent (); fputs ("Procedure bindings:", dumpfile); ++show_level; /* Finalizer bindings. */ for (f = f2k->finalizers; f; f = f->next) { show_indent (); fprintf (dumpfile, "FINAL %s", f->proc_tree->n.sym->name); } /* Type-bound procedures. */ gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree); --show_level; show_indent (); fputs ("Operator bindings:", dumpfile); ++show_level; /* User-defined operators. */ gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree); /* Intrinsic operators. */ for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op) if (f2k->tb_op[op]) show_typebound_proc (f2k->tb_op[op], gfc_op2string ((gfc_intrinsic_op) op)); --show_level; }
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 (); }
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"); } }
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; }