/* Parse tree dumper
- Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Steven Bosscher
TODO: Dump DATA. */
#include "config.h"
+#include "system.h"
#include "gfortran.h"
+#include "constructor.h"
/* Keep track of indentation for symbol tree dumps. */
static int show_level = 0;
static void show_namespace (gfc_namespace *ns);
+/* Allow dumping of an expression in the debugger. */
+void gfc_debug_expr (gfc_expr *);
+
+void
+gfc_debug_expr (gfc_expr *e)
+{
+ FILE *tmp = dumpfile;
+ dumpfile = stderr;
+ show_expr (e);
+ fputc ('\n', dumpfile);
+ dumpfile = tmp;
+}
+
+
/* Do indentation for a specific level. */
static inline void
if (label != NULL)
fprintf (dumpfile, "%-5d ", label->value);
- else
- fputs (" ", dumpfile);
- for (i = 0; i < 2 * level; i++)
+ for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
fputc (' ', dumpfile);
}
switch (ts->type)
{
case BT_DERIVED:
- fprintf (dumpfile, "%s", ts->derived->name);
+ case BT_CLASS:
+ fprintf (dumpfile, "%s", ts->u.derived->name);
break;
case BT_CHARACTER:
- show_expr (ts->cl->length);
+ show_expr (ts->u.cl->length);
+ fprintf(dumpfile, " %d", ts->kind);
break;
default:
return;
}
- fprintf (dumpfile, "(%d", as->rank);
+ fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
- if (as->rank != 0)
+ if (as->rank + as->corank > 0)
{
switch (as->type)
{
}
fprintf (dumpfile, " %s ", c);
- for (i = 0; i < as->rank; i++)
+ for (i = 0; i < as->rank + as->corank; i++)
{
show_expr (as->lower[i]);
fputc (' ', dumpfile);
/* Display a constructor. Works recursively for array constructors. */
static void
-show_constructor (gfc_constructor *c)
+show_constructor (gfc_constructor_base base)
{
- for (; c; c = c->next)
+ gfc_constructor *c;
+ for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
{
if (c->iterator == NULL)
show_expr (c->expr);
fputc (')', dumpfile);
}
- if (c->next != NULL)
+ if (gfc_constructor_next (c) != NULL)
fputs (" , ", dumpfile);
}
}
fputc ('\'', dumpfile);
}
+
+/* Show a component-call expression. */
+
+static void
+show_compcall (gfc_expr* p)
+{
+ gcc_assert (p->expr_type == EXPR_COMPCALL);
+
+ fprintf (dumpfile, "%s", p->symtree->n.sym->name);
+ show_ref (p->ref);
+ fprintf (dumpfile, "%s", p->value.compcall.name);
+
+ show_actual_arglist (p->value.compcall.actual);
+}
+
+
/* Show an expression. */
static void
break;
case EXPR_STRUCTURE:
- fprintf (dumpfile, "%s(", p->ts.derived->name);
+ fprintf (dumpfile, "%s(", p->ts.u.derived->name);
show_constructor (p->value.constructor);
fputc (')', dumpfile);
break;
case BT_COMPLEX:
fputs ("(complex ", dumpfile);
- mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE);
+ mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
+ GFC_RND_MODE);
if (p->ts.kind != gfc_default_complex_kind)
fprintf (dumpfile, "_%d", p->ts.kind);
fputc (' ', dumpfile);
- mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE);
+ mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
+ GFC_RND_MODE);
if (p->ts.kind != gfc_default_complex_kind)
fprintf (dumpfile, "_%d", p->ts.kind);
fputs ("NOT ", dumpfile);
break;
case INTRINSIC_PARENTHESES:
- fputs ("parens", dumpfile);
+ fputs ("parens ", dumpfile);
break;
default:
case EXPR_FUNCTION:
if (p->value.function.name == NULL)
{
- fprintf (dumpfile, "%s[", p->symtree->n.sym->name);
+ fprintf (dumpfile, "%s", p->symtree->n.sym->name);
+ if (gfc_is_proc_ptr_comp (p, NULL))
+ show_ref (p->ref);
+ fputc ('[', dumpfile);
show_actual_arglist (p->value.function.actual);
fputc (']', dumpfile);
}
else
{
- fprintf (dumpfile, "%s[[", p->value.function.name);
+ fprintf (dumpfile, "%s", p->value.function.name);
+ if (gfc_is_proc_ptr_comp (p, NULL))
+ show_ref (p->ref);
+ fputc ('[', dumpfile);
+ fputc ('[', dumpfile);
show_actual_arglist (p->value.function.actual);
fputc (']', dumpfile);
fputc (']', dumpfile);
break;
+ case EXPR_COMPCALL:
+ show_compcall (p);
+ break;
+
default:
gfc_internal_error ("show_expr(): Don't know how to show expr");
}
whatever single bit attributes are present. */
static void
-show_attr (symbol_attribute *attr)
+show_attr (symbol_attribute *attr, const char * module)
{
-
- fprintf (dumpfile, "(%s %s %s %s %s",
- gfc_code2string (flavors, attr->flavor),
- gfc_intent_string (attr->intent),
- gfc_code2string (access_types, attr->access),
- gfc_code2string (procedures, attr->proc),
- gfc_code2string (save_status, attr->save));
+ if (attr->flavor != FL_UNKNOWN)
+ fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
+ if (attr->access != ACCESS_UNKNOWN)
+ fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
+ if (attr->proc != PROC_UNKNOWN)
+ fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
+ if (attr->save != SAVE_NONE)
+ fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
if (attr->allocatable)
fputs (" ALLOCATABLE", dumpfile);
+ if (attr->asynchronous)
+ fputs (" ASYNCHRONOUS", dumpfile);
+ if (attr->codimension)
+ fputs (" CODIMENSION", dumpfile);
if (attr->dimension)
fputs (" DIMENSION", dumpfile);
+ if (attr->contiguous)
+ fputs (" CONTIGUOUS", dumpfile);
if (attr->external)
fputs (" EXTERNAL", dumpfile);
if (attr->intrinsic)
if (attr->target)
fputs (" TARGET", dumpfile);
if (attr->dummy)
- fputs (" DUMMY", dumpfile);
+ {
+ fputs (" DUMMY", dumpfile);
+ if (attr->intent != INTENT_UNKNOWN)
+ fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
+ }
+
if (attr->result)
fputs (" RESULT", dumpfile);
if (attr->entry)
if (attr->data)
fputs (" DATA", dumpfile);
if (attr->use_assoc)
- fputs (" USE-ASSOC", dumpfile);
+ {
+ fputs (" USE-ASSOC", dumpfile);
+ if (module != NULL)
+ fprintf (dumpfile, "(%s)", module);
+ }
+
if (attr->in_namelist)
fputs (" IN-NAMELIST", dumpfile);
if (attr->in_common)
fputs (" IN-COMMON", dumpfile);
if (attr->abstract)
- fputs (" ABSTRACT INTERFACE", dumpfile);
+ fputs (" ABSTRACT", dumpfile);
if (attr->function)
fputs (" FUNCTION", dumpfile);
if (attr->subroutine)
{
fprintf (dumpfile, "(%s ", c->name);
show_typespec (&c->ts);
- if (c->pointer)
+ if (c->attr.allocatable)
+ fputs (" ALLOCATABLE", dumpfile);
+ if (c->attr.pointer)
fputs (" POINTER", dumpfile);
- if (c->dimension)
+ if (c->attr.proc_pointer)
+ fputs (" PPC", dumpfile);
+ if (c->attr.dimension)
fputs (" DIMENSION", dumpfile);
fputc (' ', dumpfile);
show_array_spec (c->as);
- if (c->access)
- fprintf (dumpfile, " %s", gfc_code2string (access_types, c->access));
+ if (c->attr.access)
+ fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
fputc (')', dumpfile);
if (c->next != NULL)
fputc (' ', dumpfile);
}
+/* Show the f2k_derived namespace with procedure bindings. */
+
+static void
+show_typebound_proc (gfc_typebound_proc* tb, const char* name)
+{
+ show_indent ();
+
+ if (tb->is_generic)
+ fputs ("GENERIC", dumpfile);
+ else
+ {
+ fputs ("PROCEDURE, ", dumpfile);
+ if (tb->nopass)
+ fputs ("NOPASS", dumpfile);
+ else
+ {
+ if (tb->pass_arg)
+ fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
+ else
+ fputs ("PASS", dumpfile);
+ }
+ if (tb->non_overridable)
+ fputs (", NON_OVERRIDABLE", dumpfile);
+ }
+
+ if (tb->access == ACCESS_PUBLIC)
+ fputs (", PUBLIC", dumpfile);
+ else
+ fputs (", PRIVATE", dumpfile);
+
+ fprintf (dumpfile, " :: %s => ", name);
+
+ if (tb->is_generic)
+ {
+ gfc_tbp_generic* g;
+ for (g = tb->u.generic; g; g = g->next)
+ {
+ fputs (g->specific_st->name, dumpfile);
+ if (g->next)
+ fputs (", ", dumpfile);
+ }
+ }
+ else
+ fputs (tb->u.specific->n.sym->name, dumpfile);
+}
+
+static void
+show_typebound_symtree (gfc_symtree* st)
+{
+ gcc_assert (st->n.tb);
+ show_typebound_proc (st->n.tb, st->name);
+}
+
+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_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;
+}
+
+
/* Show a symbol. If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
show the interface. Information needed to reconstruct the list of
specific interfaces associated with a generic symbol is done within
{
gfc_formal_arglist *formal;
gfc_interface *intr;
+ int i,len;
if (sym == NULL)
return;
- show_indent ();
+ fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
+ len = strlen (sym->name);
+ for (i=len; i<12; i++)
+ fputc(' ', dumpfile);
- fprintf (dumpfile, "symbol %s ", sym->name);
+ ++show_level;
+
+ show_indent ();
+ fputs ("type spec : ", dumpfile);
show_typespec (&sym->ts);
- show_attr (&sym->attr);
+
+ show_indent ();
+ fputs ("attributes: ", dumpfile);
+ show_attr (&sym->attr, sym->module);
if (sym->value)
{
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 ();
}
}
- if (sym->formal_ns)
+ if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
+ && sym->attr.proc != PROC_ST_FUNCTION)
{
show_indent ();
fputs ("Formal namespace", dumpfile);
show_namespace (sym->formal_ns);
}
-
- fputc ('\n', dumpfile);
+ --show_level;
}
static void
show_symtree (gfc_symtree *st)
{
+ int len, i;
+
show_indent ();
- fprintf (dumpfile, "symtree: %s Ambig %d", st->name, st->ambiguous);
+
+ 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, " from namespace %s", st->n.sym->ns->proc_name->name);
+ fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
+ st->n.sym->ns->proc_name->name);
else
show_symbol (st->n.sym);
}
gfc_filepos *fp;
gfc_inquire *i;
gfc_dt *dt;
+ gfc_namespace *ns;
- code_indent (level, c->here);
+ 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_INIT_ASSIGN:
case EXEC_ASSIGN:
fputs ("ASSIGN ", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
fputc (' ', dumpfile);
show_expr (c->expr2);
break;
case EXEC_LABEL_ASSIGN:
fputs ("LABEL ASSIGN ", dumpfile);
- show_expr (c->expr);
- fprintf (dumpfile, " %d", c->label->value);
+ show_expr (c->expr1);
+ fprintf (dumpfile, " %d", c->label1->value);
break;
case EXEC_POINTER_ASSIGN:
fputs ("POINTER ASSIGN ", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
fputc (' ', dumpfile);
show_expr (c->expr2);
break;
case EXEC_GOTO:
fputs ("GOTO ", dumpfile);
- if (c->label)
- fprintf (dumpfile, "%d", c->label->value);
+ if (c->label1)
+ fprintf (dumpfile, "%d", c->label1->value);
else
{
- show_expr (c->expr);
+ show_expr (c->expr1);
d = c->block;
if (d != NULL)
{
fputs (", (", dumpfile);
for (; d; d = d ->block)
{
- code_indent (level, d->label);
+ code_indent (level, d->label1);
if (d->block != NULL)
fputc (',', dumpfile);
else
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->expr)
- show_expr (c->expr);
+ if (c->expr1)
+ show_expr (c->expr1);
break;
case EXEC_PAUSE:
fputs ("PAUSE ", dumpfile);
- if (c->expr != NULL)
- show_expr (c->expr);
+ 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->expr != NULL)
- show_expr (c->expr);
+ 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_ARITHMETIC_IF:
fputs ("IF ", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
fprintf (dumpfile, " %d, %d, %d",
- c->label->value, c->label2->value, c->label3->value);
+ c->label1->value, c->label2->value, c->label3->value);
break;
case EXEC_IF:
d = c->block;
fputs ("IF ", dumpfile);
- show_expr (d->expr);
- fputc ('\n', 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->expr == NULL)
- fputs ("ELSE\n", dumpfile);
+ if (d->expr1 == NULL)
+ fputs ("ELSE", dumpfile);
else
{
fputs ("ELSE IF ", dumpfile);
- show_expr (d->expr);
- fputc ('\n', dumpfile);
+ show_expr (d->expr1);
}
+ ++show_level;
show_code (level + 1, d->next);
+ --show_level;
}
- code_indent (level, c->label);
+ if (c->label1)
+ code_indent (level, c->label1);
+ else
+ show_indent ();
fputs ("ENDIF", dumpfile);
break;
+ case EXEC_BLOCK:
+ {
+ const char* blocktype;
+ if (c->ext.block.assoc)
+ blocktype = "ASSOCIATE";
+ else
+ blocktype = "BLOCK";
+ show_indent ();
+ fprintf (dumpfile, "%s ", blocktype);
+ ++show_level;
+ ns = c->ext.block.ns;
+ gfc_traverse_symtree (ns->sym_root, show_symtree);
+ 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->expr);
+ show_expr (c->expr1);
fputc ('\n', dumpfile);
for (; d; d = d->block)
code_indent (level, 0);
fputs ("CASE ", dumpfile);
- for (cp = d->ext.case_list; cp; cp = cp->next)
+ for (cp = d->ext.block.case_list; cp; cp = cp->next)
{
fputc ('(', dumpfile);
show_expr (cp->low);
show_code (level + 1, d->next);
}
- code_indent (level, c->label);
+ code_indent (level, c->label1);
fputs ("END SELECT", dumpfile);
break;
fputs ("WHERE ", dumpfile);
d = c->block;
- show_expr (d->expr);
+ show_expr (d->expr1);
fputc ('\n', dumpfile);
show_code (level + 1, d->next);
{
code_indent (level, 0);
fputs ("ELSE WHERE ", dumpfile);
- show_expr (d->expr);
+ show_expr (d->expr1);
fputc ('\n', dumpfile);
show_code (level + 1, d->next);
}
fputc (',', dumpfile);
}
- if (c->expr != NULL)
+ if (c->expr1 != NULL)
{
fputc (',', dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
}
fputc ('\n', dumpfile);
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->end);
fputc (' ', dumpfile);
show_expr (c->ext.iterator->step);
- fputc ('\n', dumpfile);
+ ++show_level;
show_code (level + 1, c->block->next);
+ --show_level;
- code_indent (level, 0);
+ if (c->label1)
+ break;
+
+ show_indent ();
fputs ("END DO", dumpfile);
break;
case EXEC_DO_WHILE:
fputs ("DO WHILE ", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
fputc ('\n', dumpfile);
show_code (level + 1, c->block->next);
- code_indent (level, c->label);
+ code_indent (level, c->label1);
fputs ("END DO", dumpfile);
break;
case EXEC_ALLOCATE:
fputs ("ALLOCATE ", dumpfile);
- if (c->expr)
+ if (c->expr1)
{
fputs (" STAT=", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
+ }
+
+ if (c->expr2)
+ {
+ fputs (" ERRMSG=", dumpfile);
+ show_expr (c->expr2);
}
- for (a = c->ext.alloc_list; a; a = a->next)
+ for (a = c->ext.alloc.list; a; a = a->next)
{
fputc (' ', dumpfile);
show_expr (a->expr);
case EXEC_DEALLOCATE:
fputs ("DEALLOCATE ", dumpfile);
- if (c->expr)
+ if (c->expr1)
{
fputs (" STAT=", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
}
- for (a = c->ext.alloc_list; a; a = a->next)
+ 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);
case EXEC_IOLENGTH:
fputs ("IOLENGTH ", dumpfile);
- show_expr (c->expr);
+ show_expr (c->expr1);
goto show_dt_code;
break;
}
show_dt_code:
- fputc ('\n', dumpfile);
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->expr);
+ show_expr (c->expr1);
break;
case EXEC_DT_END:
default:
gfc_internal_error ("show_code_node(): Bad statement code");
}
-
- fputc ('\n', dumpfile);
}
{
gfc_interface *intr;
gfc_namespace *save;
- gfc_intrinsic_op op;
+ int op;
gfc_equiv *eq;
int i;
save = gfc_current_ns;
- show_level++;
show_indent ();
fputs ("Namespace:", dumpfile);
fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
}
+ ++show_level;
gfc_current_ns = ns;
gfc_traverse_symtree (ns->common_root, show_common);
show_indent ();
fprintf (dumpfile, "Operator interfaces for %s:",
- gfc_op2string (op));
+ gfc_op2string ((gfc_intrinsic_op) op));
for (; intr; intr = intr->next)
fprintf (dumpfile, " %s", intr->sym->name);
gfc_traverse_user_op (ns, show_uop);
}
}
+ else
+ ++show_level;
for (eq = ns->equiv; eq; eq = eq->next)
show_equiv (eq);
fputc ('\n', dumpfile);
- fputc ('\n', dumpfile);
-
- show_code (0, ns->code);
+ show_indent ();
+ fputs ("code:", dumpfile);
+ show_code (show_level, ns->code);
+ --show_level;
for (ns = ns->contained; ns; ns = ns->sibling)
{
- show_indent ();
- fputs ("CONTAINS\n", dumpfile);
+ fputs ("\nCONTAINS\n", dumpfile);
+ ++show_level;
show_namespace (ns);
+ --show_level;
}
- show_level--;
fputc ('\n', dumpfile);
gfc_current_ns = save;
}
OSDN Git Service
