X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Ffortran%2Fdump-parse-tree.c;h=32ff298d6e0179f0d49811026faee340a961e521;hp=06322d427719695ee2b8f2cc2b7aba475a16f87a;hb=1de1b1a9e40b5aa064d5e3d032dd43ce14f6d2ad;hpb=764f11758d254e1dee25b04620786ef89ad6ccce

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 06322d42771..32ff298d6e0 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1,12 +1,13 @@
 /* Parse tree dumper
-   Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+   Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009
+   Free Software Foundation, Inc.
    Contributed by Steven Bosscher
 
 This file is part of GCC.
 
 GCC is free software; you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -15,9 +16,8 @@ FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 for more details.
 
 You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING.  If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA.  */
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
 
 
 /* Actually this is just a collection of routines that used to be
@@ -37,25 +37,30 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 /* Keep track of indentation for symbol tree dumps.  */
 static int show_level = 0;
 
+/* The file handle we're dumping to is kept in a static variable.  This
+   is not too cool, but it avoids a lot of passing it around.  */
+static FILE *dumpfile;
+
+/* Forward declaration of some of the functions.  */
+static void show_expr (gfc_expr *p);
+static void show_code_node (int, gfc_code *);
+static void show_namespace (gfc_namespace *ns);
 
-/* Forward declaration because this one needs all, and all need
-   this one.  */
-static void gfc_show_expr (gfc_expr *);
 
 /* Do indentation for a specific level.  */
 
 static inline void
-code_indent (int level, gfc_st_label * label)
+code_indent (int level, gfc_st_label *label)
 {
   int i;
 
   if (label != NULL)
-    gfc_status ("%-5d ", label->value);
+    fprintf (dumpfile, "%-5d ", label->value);
   else
-    gfc_status ("      ");
+    fputs ("      ", dumpfile);
 
   for (i = 0; i < 2 * level; i++)
-    gfc_status_char (' ');
+    fputc (' ', dumpfile);
 }
 
 
@@ -65,7 +70,7 @@ code_indent (int level, gfc_st_label * label)
 static inline void
 show_indent (void)
 {
-  gfc_status ("\n");
+  fputc ('\n', dumpfile);
   code_indent (show_level, NULL);
 }
 
@@ -73,72 +78,70 @@ show_indent (void)
 /* Show type-specific information.  */
 
 static void
-gfc_show_typespec (gfc_typespec * ts)
+show_typespec (gfc_typespec *ts)
 {
-
-  gfc_status ("(%s ", gfc_basic_typename (ts->type));
+  fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
 
   switch (ts->type)
     {
     case BT_DERIVED:
-      gfc_status ("%s", ts->derived->name);
+      fprintf (dumpfile, "%s", ts->u.derived->name);
       break;
 
     case BT_CHARACTER:
-      gfc_show_expr (ts->cl->length);
+      show_expr (ts->u.cl->length);
       break;
 
     default:
-      gfc_status ("%d", ts->kind);
+      fprintf (dumpfile, "%d", ts->kind);
       break;
     }
 
-  gfc_status (")");
+  fputc (')', dumpfile);
 }
 
 
 /* Show an actual argument list.  */
 
 static void
-gfc_show_actual_arglist (gfc_actual_arglist * a)
+show_actual_arglist (gfc_actual_arglist *a)
 {
-
-  gfc_status ("(");
+  fputc ('(', dumpfile);
 
   for (; a; a = a->next)
     {
-      gfc_status_char ('(');
+      fputc ('(', dumpfile);
       if (a->name != NULL)
-	gfc_status ("%s = ", a->name);
+	fprintf (dumpfile, "%s = ", a->name);
       if (a->expr != NULL)
-	gfc_show_expr (a->expr);
+	show_expr (a->expr);
       else
-	gfc_status ("(arg not-present)");
+	fputs ("(arg not-present)", dumpfile);
 
-      gfc_status_char (')');
+      fputc (')', dumpfile);
       if (a->next != NULL)
-	gfc_status (" ");
+	fputc (' ', dumpfile);
     }
 
-  gfc_status (")");
+  fputc (')', dumpfile);
 }
 
 
 /* Show a gfc_array_spec array specification structure.  */
 
 static void
-gfc_show_array_spec (gfc_array_spec * as)
+show_array_spec (gfc_array_spec *as)
 {
   const char *c;
   int i;
 
   if (as == NULL)
     {
-      gfc_status ("()");
+      fputs ("()", dumpfile);
       return;
     }
 
-  gfc_status ("(%d", as->rank);
+  fprintf (dumpfile, "(%d", as->rank);
 
   if (as->rank != 0)
     {
@@ -149,37 +152,37 @@ gfc_show_array_spec (gfc_array_spec * as)
 	case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
 	case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
 	default:
-	  gfc_internal_error
-		("gfc_show_array_spec(): Unhandled array shape type.");
+	  gfc_internal_error ("show_array_spec(): Unhandled array shape "
+			      "type.");
       }
-      gfc_status (" %s ", c);
+      fprintf (dumpfile, " %s ", c);
 
       for (i = 0; i < as->rank; i++)
 	{
-	  gfc_show_expr (as->lower[i]);
-	  gfc_status_char (' ');
-	  gfc_show_expr (as->upper[i]);
-	  gfc_status_char (' ');
+	  show_expr (as->lower[i]);
+	  fputc (' ', dumpfile);
+	  show_expr (as->upper[i]);
+	  fputc (' ', dumpfile);
 	}
     }
 
-  gfc_status (")");
+  fputc (')', dumpfile);
 }
 
 
 /* Show a gfc_array_ref array reference structure.  */
 
 static void
-gfc_show_array_ref (gfc_array_ref * ar)
+show_array_ref (gfc_array_ref * ar)
 {
   int i;
 
-  gfc_status_char ('(');
+  fputc ('(', dumpfile);
 
   switch (ar->type)
     {
     case AR_FULL:
-      gfc_status ("FULL");
+      fputs ("FULL", dumpfile);
       break;
 
     case AR_SECTION:
@@ -193,75 +196,74 @@ gfc_show_array_ref (gfc_array_ref * ar)
 	     bound and the stride, if they're present.  */
   
 	  if (ar->start[i] != NULL)
-	    gfc_show_expr (ar->start[i]);
+	    show_expr (ar->start[i]);
 
 	  if (ar->dimen_type[i] == DIMEN_RANGE)
 	    {
-	      gfc_status_char (':');
+	      fputc (':', dumpfile);
 
 	      if (ar->end[i] != NULL)
-		gfc_show_expr (ar->end[i]);
+		show_expr (ar->end[i]);
 
 	      if (ar->stride[i] != NULL)
 		{
-		  gfc_status_char (':');
-		  gfc_show_expr (ar->stride[i]);
+		  fputc (':', dumpfile);
+		  show_expr (ar->stride[i]);
 		}
 	    }
 
 	  if (i != ar->dimen - 1)
-	    gfc_status (" , ");
+	    fputs (" , ", dumpfile);
 	}
       break;
 
     case AR_ELEMENT:
       for (i = 0; i < ar->dimen; i++)
 	{
-	  gfc_show_expr (ar->start[i]);
+	  show_expr (ar->start[i]);
 	  if (i != ar->dimen - 1)
-	    gfc_status (" , ");
+	    fputs (" , ", dumpfile);
 	}
       break;
 
     case AR_UNKNOWN:
-      gfc_status ("UNKNOWN");
+      fputs ("UNKNOWN", dumpfile);
       break;
 
     default:
-      gfc_internal_error ("gfc_show_array_ref(): Unknown array reference");
+      gfc_internal_error ("show_array_ref(): Unknown array reference");
     }
 
-  gfc_status_char (')');
+  fputc (')', dumpfile);
 }
 
 
 /* Show a list of gfc_ref structures.  */
 
 static void
-gfc_show_ref (gfc_ref * p)
+show_ref (gfc_ref *p)
 {
-
   for (; p; p = p->next)
     switch (p->type)
       {
       case REF_ARRAY:
-	gfc_show_array_ref (&p->u.ar);
+	show_array_ref (&p->u.ar);
 	break;
 
       case REF_COMPONENT:
-	gfc_status (" %% %s", p->u.c.component->name);
+	fprintf (dumpfile, " %% %s", p->u.c.component->name);
 	break;
 
       case REF_SUBSTRING:
-	gfc_status_char ('(');
-	gfc_show_expr (p->u.ss.start);
-	gfc_status_char (':');
-	gfc_show_expr (p->u.ss.end);
-	gfc_status_char (')');
+	fputc ('(', dumpfile);
+	show_expr (p->u.ss.start);
+	fputc (':', dumpfile);
+	show_expr (p->u.ss.end);
+	fputc (')', dumpfile);
 	break;
 
       default:
-	gfc_internal_error ("gfc_show_ref(): Bad component code");
+	gfc_internal_error ("show_ref(): Bad component code");
       }
 }
 
@@ -269,82 +271,104 @@ gfc_show_ref (gfc_ref * p)
 /* Display a constructor.  Works recursively for array constructors.  */
 
 static void
-gfc_show_constructor (gfc_constructor * c)
+show_constructor (gfc_constructor *c)
 {
-
   for (; c; c = c->next)
     {
       if (c->iterator == NULL)
-	gfc_show_expr (c->expr);
+	show_expr (c->expr);
       else
 	{
-	  gfc_status_char ('(');
-	  gfc_show_expr (c->expr);
+	  fputc ('(', dumpfile);
+	  show_expr (c->expr);
 
-	  gfc_status_char (' ');
-	  gfc_show_expr (c->iterator->var);
-	  gfc_status_char ('=');
-	  gfc_show_expr (c->iterator->start);
-	  gfc_status_char (',');
-	  gfc_show_expr (c->iterator->end);
-	  gfc_status_char (',');
-	  gfc_show_expr (c->iterator->step);
+	  fputc (' ', dumpfile);
+	  show_expr (c->iterator->var);
+	  fputc ('=', dumpfile);
+	  show_expr (c->iterator->start);
+	  fputc (',', dumpfile);
+	  show_expr (c->iterator->end);
+	  fputc (',', dumpfile);
+	  show_expr (c->iterator->step);
 
-	  gfc_status_char (')');
+	  fputc (')', dumpfile);
 	}
 
       if (c->next != NULL)
-	gfc_status (" , ");
+	fputs (" , ", dumpfile);
     }
 }
 
 
+static void
+show_char_const (const gfc_char_t *c, int length)
+{
+  int i;
+
+  fputc ('\'', dumpfile);
+  for (i = 0; i < length; i++)
+    {
+      if (c[i] == '\'')
+	fputs ("''", dumpfile);
+      else
+	fputs (gfc_print_wide_char (c[i]), 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
-gfc_show_expr (gfc_expr * p)
+show_expr (gfc_expr *p)
 {
   const char *c;
   int i;
 
   if (p == NULL)
     {
-      gfc_status ("()");
+      fputs ("()", dumpfile);
       return;
     }
 
   switch (p->expr_type)
     {
     case EXPR_SUBSTRING:
-      c = p->value.character.string;
-
-      for (i = 0; i < p->value.character.length; i++, c++)
-	{
-	  if (*c == '\'')
-	    gfc_status ("''");
-	  else
-	    gfc_status ("%c", *c);
-	}
-
-      gfc_show_ref (p->ref);
+      show_char_const (p->value.character.string, p->value.character.length);
+      show_ref (p->ref);
       break;
 
     case EXPR_STRUCTURE:
-      gfc_status ("%s(", p->ts.derived->name);
-      gfc_show_constructor (p->value.constructor);
-      gfc_status_char (')');
+      fprintf (dumpfile, "%s(", p->ts.u.derived->name);
+      show_constructor (p->value.constructor);
+      fputc (')', dumpfile);
       break;
 
     case EXPR_ARRAY:
-      gfc_status ("(/ ");
-      gfc_show_constructor (p->value.constructor);
-      gfc_status (" /)");
+      fputs ("(/ ", dumpfile);
+      show_constructor (p->value.constructor);
+      fputs (" /)", dumpfile);
 
-      gfc_show_ref (p->ref);
+      show_ref (p->ref);
       break;
 
     case EXPR_NULL:
-      gfc_status ("NULL()");
+      fputs ("NULL()", dumpfile);
       break;
 
     case EXPR_CONSTANT:
@@ -354,270 +378,404 @@ gfc_show_expr (gfc_expr * p)
 	  mpz_out_str (stdout, 10, p->value.integer);
 
 	  if (p->ts.kind != gfc_default_integer_kind)
-	    gfc_status ("_%d", p->ts.kind);
+	    fprintf (dumpfile, "_%d", p->ts.kind);
 	  break;
 
 	case BT_LOGICAL:
 	  if (p->value.logical)
-	    gfc_status (".true.");
+	    fputs (".true.", dumpfile);
 	  else
-	    gfc_status (".false.");
+	    fputs (".false.", dumpfile);
 	  break;
 
 	case BT_REAL:
 	  mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
 	  if (p->ts.kind != gfc_default_real_kind)
-	    gfc_status ("_%d", p->ts.kind);
+	    fprintf (dumpfile, "_%d", p->ts.kind);
 	  break;
 
 	case BT_CHARACTER:
-	  c = p->value.character.string;
-
-	  gfc_status_char ('\'');
-
-	  for (i = 0; i < p->value.character.length; i++, c++)
-	    {
-	      if (*c == '\'')
-		gfc_status ("''");
-	      else
-		gfc_status_char (*c);
-	    }
-
-	  gfc_status_char ('\'');
-
+	  show_char_const (p->value.character.string, 
+			   p->value.character.length);
 	  break;
 
 	case BT_COMPLEX:
-	  gfc_status ("(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)
-	    gfc_status ("_%d", p->ts.kind);
+	    fprintf (dumpfile, "_%d", p->ts.kind);
 
-	  gfc_status (" ");
+	  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)
-	    gfc_status ("_%d", p->ts.kind);
+	    fprintf (dumpfile, "_%d", p->ts.kind);
+
+	  fputc (')', dumpfile);
+	  break;
 
-	  gfc_status (")");
+	case BT_HOLLERITH:
+	  fprintf (dumpfile, "%dH", p->representation.length);
+	  c = p->representation.string;
+	  for (i = 0; i < p->representation.length; i++, c++)
+	    {
+	      fputc (*c, dumpfile);
+	    }
 	  break;
 
 	default:
-	  gfc_status ("???");
+	  fputs ("???", dumpfile);
 	  break;
 	}
 
+      if (p->representation.string)
+	{
+	  fputs (" {", dumpfile);
+	  c = p->representation.string;
+	  for (i = 0; i < p->representation.length; i++, c++)
+	    {
+	      fprintf (dumpfile, "%.2x", (unsigned int) *c);
+	      if (i < p->representation.length - 1)
+		fputc (',', dumpfile);
+	    }
+	  fputc ('}', dumpfile);
+	}
+
       break;
 
     case EXPR_VARIABLE:
       if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
-	gfc_status ("%s:", p->symtree->n.sym->ns->proc_name->name);
-      gfc_status ("%s", p->symtree->n.sym->name);
-      gfc_show_ref (p->ref);
+	fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
+      fprintf (dumpfile, "%s", p->symtree->n.sym->name);
+      show_ref (p->ref);
       break;
 
     case EXPR_OP:
-      gfc_status ("(");
-      switch (p->value.op.operator)
+      fputc ('(', dumpfile);
+      switch (p->value.op.op)
 	{
 	case INTRINSIC_UPLUS:
-	  gfc_status ("U+ ");
+	  fputs ("U+ ", dumpfile);
 	  break;
 	case INTRINSIC_UMINUS:
-	  gfc_status ("U- ");
+	  fputs ("U- ", dumpfile);
 	  break;
 	case INTRINSIC_PLUS:
-	  gfc_status ("+ ");
+	  fputs ("+ ", dumpfile);
 	  break;
 	case INTRINSIC_MINUS:
-	  gfc_status ("- ");
+	  fputs ("- ", dumpfile);
 	  break;
 	case INTRINSIC_TIMES:
-	  gfc_status ("* ");
+	  fputs ("* ", dumpfile);
 	  break;
 	case INTRINSIC_DIVIDE:
-	  gfc_status ("/ ");
+	  fputs ("/ ", dumpfile);
 	  break;
 	case INTRINSIC_POWER:
-	  gfc_status ("** ");
+	  fputs ("** ", dumpfile);
 	  break;
 	case INTRINSIC_CONCAT:
-	  gfc_status ("// ");
+	  fputs ("// ", dumpfile);
 	  break;
 	case INTRINSIC_AND:
-	  gfc_status ("AND ");
+	  fputs ("AND ", dumpfile);
 	  break;
 	case INTRINSIC_OR:
-	  gfc_status ("OR ");
+	  fputs ("OR ", dumpfile);
 	  break;
 	case INTRINSIC_EQV:
-	  gfc_status ("EQV ");
+	  fputs ("EQV ", dumpfile);
 	  break;
 	case INTRINSIC_NEQV:
-	  gfc_status ("NEQV ");
+	  fputs ("NEQV ", dumpfile);
 	  break;
 	case INTRINSIC_EQ:
-	  gfc_status ("= ");
+	case INTRINSIC_EQ_OS:
+	  fputs ("= ", dumpfile);
 	  break;
 	case INTRINSIC_NE:
-	  gfc_status ("<> ");
+	case INTRINSIC_NE_OS:
+	  fputs ("/= ", dumpfile);
 	  break;
 	case INTRINSIC_GT:
-	  gfc_status ("> ");
+	case INTRINSIC_GT_OS:
+	  fputs ("> ", dumpfile);
 	  break;
 	case INTRINSIC_GE:
-	  gfc_status (">= ");
+	case INTRINSIC_GE_OS:
+	  fputs (">= ", dumpfile);
 	  break;
 	case INTRINSIC_LT:
-	  gfc_status ("< ");
+	case INTRINSIC_LT_OS:
+	  fputs ("< ", dumpfile);
 	  break;
 	case INTRINSIC_LE:
-	  gfc_status ("<= ");
+	case INTRINSIC_LE_OS:
+	  fputs ("<= ", dumpfile);
 	  break;
 	case INTRINSIC_NOT:
-	  gfc_status ("NOT ");
+	  fputs ("NOT ", dumpfile);
 	  break;
 	case INTRINSIC_PARENTHESES:
-	  gfc_status ("parens");
+	  fputs ("parens", dumpfile);
 	  break;
 
 	default:
 	  gfc_internal_error
-	    ("gfc_show_expr(): Bad intrinsic in expression!");
+	    ("show_expr(): Bad intrinsic in expression!");
 	}
 
-      gfc_show_expr (p->value.op.op1);
+      show_expr (p->value.op.op1);
 
       if (p->value.op.op2)
 	{
-	  gfc_status (" ");
-	  gfc_show_expr (p->value.op.op2);
+	  fputc (' ', dumpfile);
+	  show_expr (p->value.op.op2);
 	}
 
-      gfc_status (")");
+      fputc (')', dumpfile);
       break;
 
     case EXPR_FUNCTION:
       if (p->value.function.name == NULL)
 	{
-	  gfc_status ("%s[", p->symtree->n.sym->name);
-	  gfc_show_actual_arglist (p->value.function.actual);
-	  gfc_status_char (']');
+	  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
 	{
-	  gfc_status ("%s[[", p->value.function.name);
-	  gfc_show_actual_arglist (p->value.function.actual);
-	  gfc_status_char (']');
-	  gfc_status_char (']');
+	  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 ("gfc_show_expr(): Don't know how to show expr");
+      gfc_internal_error ("show_expr(): Don't know how to show expr");
     }
 }
 
-
 /* Show symbol attributes.  The flavor and intent are followed by
    whatever single bit attributes are present.  */
 
 static void
-gfc_show_attr (symbol_attribute * attr)
+show_attr (symbol_attribute *attr)
 {
 
-  gfc_status ("(%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));
+  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->allocatable)
-    gfc_status (" ALLOCATABLE");
+    fputs (" ALLOCATABLE", dumpfile);
   if (attr->dimension)
-    gfc_status (" DIMENSION");
+    fputs (" DIMENSION", dumpfile);
   if (attr->external)
-    gfc_status (" EXTERNAL");
+    fputs (" EXTERNAL", dumpfile);
   if (attr->intrinsic)
-    gfc_status (" INTRINSIC");
+    fputs (" INTRINSIC", dumpfile);
   if (attr->optional)
-    gfc_status (" OPTIONAL");
+    fputs (" OPTIONAL", dumpfile);
   if (attr->pointer)
-    gfc_status (" POINTER");
-  if (attr->save)
-    gfc_status (" SAVE");
+    fputs (" POINTER", dumpfile);
+  if (attr->is_protected)
+    fputs (" PROTECTED", dumpfile);
+  if (attr->value)
+    fputs (" VALUE", dumpfile);
+  if (attr->volatile_)
+    fputs (" VOLATILE", dumpfile);
   if (attr->threadprivate)
-    gfc_status (" THREADPRIVATE");
+    fputs (" THREADPRIVATE", dumpfile);
   if (attr->target)
-    gfc_status (" TARGET");
+    fputs (" TARGET", dumpfile);
   if (attr->dummy)
-    gfc_status (" DUMMY");
+    fputs (" DUMMY", dumpfile);
   if (attr->result)
-    gfc_status (" RESULT");
+    fputs (" RESULT", dumpfile);
   if (attr->entry)
-    gfc_status (" ENTRY");
+    fputs (" ENTRY", dumpfile);
+  if (attr->is_bind_c)
+    fputs (" BIND(C)", dumpfile);
 
   if (attr->data)
-    gfc_status (" DATA");
+    fputs (" DATA", dumpfile);
   if (attr->use_assoc)
-    gfc_status (" USE-ASSOC");
+    fputs (" USE-ASSOC", dumpfile);
   if (attr->in_namelist)
-    gfc_status (" IN-NAMELIST");
+    fputs (" IN-NAMELIST", dumpfile);
   if (attr->in_common)
-    gfc_status (" IN-COMMON");
+    fputs (" IN-COMMON", dumpfile);
 
+  if (attr->abstract)
+    fputs (" ABSTRACT", dumpfile);
   if (attr->function)
-    gfc_status (" FUNCTION");
+    fputs (" FUNCTION", dumpfile);
   if (attr->subroutine)
-    gfc_status (" SUBROUTINE");
+    fputs (" SUBROUTINE", dumpfile);
   if (attr->implicit_type)
-    gfc_status (" IMPLICIT-TYPE");
+    fputs (" IMPLICIT-TYPE", dumpfile);
 
   if (attr->sequence)
-    gfc_status (" SEQUENCE");
+    fputs (" SEQUENCE", dumpfile);
   if (attr->elemental)
-    gfc_status (" ELEMENTAL");
+    fputs (" ELEMENTAL", dumpfile);
   if (attr->pure)
-    gfc_status (" PURE");
+    fputs (" PURE", dumpfile);
   if (attr->recursive)
-    gfc_status (" RECURSIVE");
+    fputs (" RECURSIVE", dumpfile);
 
-  gfc_status (")");
+  fputc (')', dumpfile);
 }
 
 
 /* Show components of a derived type.  */
 
 static void
-gfc_show_components (gfc_symbol * sym)
+show_components (gfc_symbol *sym)
 {
   gfc_component *c;
 
   for (c = sym->components; c; c = c->next)
     {
-      gfc_status ("(%s ", c->name);
-      gfc_show_typespec (&c->ts);
-      if (c->pointer)
-	gfc_status (" POINTER");
-      if (c->dimension)
-	gfc_status (" DIMENSION");
-      gfc_status_char (' ');
-      gfc_show_array_spec (c->as);
-      gfc_status (")");
+      fprintf (dumpfile, "(%s ", c->name);
+      show_typespec (&c->ts);
+      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)
-	gfc_status_char (' ');
+	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
    that symbol.  */
 
 static void
-gfc_show_symbol (gfc_symbol * sym)
+show_symbol (gfc_symbol *sym)
 {
   gfc_formal_arglist *formal;
   gfc_interface *intr;
@@ -627,67 +785,75 @@ gfc_show_symbol (gfc_symbol * sym)
 
   show_indent ();
 
-  gfc_status ("symbol %s ", sym->name);
-  gfc_show_typespec (&sym->ts);
-  gfc_show_attr (&sym->attr);
+  fprintf (dumpfile, "symbol %s ", sym->name);
+  show_typespec (&sym->ts);
+  show_attr (&sym->attr);
 
   if (sym->value)
     {
       show_indent ();
-      gfc_status ("value: ");
-      gfc_show_expr (sym->value);
+      fputs ("value: ", dumpfile);
+      show_expr (sym->value);
     }
 
   if (sym->as)
     {
       show_indent ();
-      gfc_status ("Array spec:");
-      gfc_show_array_spec (sym->as);
+      fputs ("Array spec:", dumpfile);
+      show_array_spec (sym->as);
     }
 
   if (sym->generic)
     {
       show_indent ();
-      gfc_status ("Generic interfaces:");
+      fputs ("Generic interfaces:", dumpfile);
       for (intr = sym->generic; intr; intr = intr->next)
-	gfc_status (" %s", intr->sym->name);
+	fprintf (dumpfile, " %s", intr->sym->name);
     }
 
   if (sym->result)
     {
       show_indent ();
-      gfc_status ("result: %s", sym->result->name);
+      fprintf (dumpfile, "result: %s", sym->result->name);
     }
 
   if (sym->components)
     {
       show_indent ();
-      gfc_status ("components: ");
-      gfc_show_components (sym);
+      fputs ("components: ", dumpfile);
+      show_components (sym);
+    }
+
+  if (sym->f2k_derived)
+    {
+      show_indent ();
+      if (sym->vindex)
+	fprintf (dumpfile, "vindex: %d", sym->vindex);
+      show_f2k_derived (sym->f2k_derived);
     }
 
   if (sym->formal)
     {
       show_indent ();
-      gfc_status ("Formal arglist:");
+      fputs ("Formal arglist:", dumpfile);
 
       for (formal = sym->formal; formal; formal = formal->next)
-        {
-          if (formal->sym != NULL)
-            gfc_status (" %s", formal->sym->name);
-          else
-            gfc_status (" [Alt Return]");
-        }
+	{
+	  if (formal->sym != NULL)
+	    fprintf (dumpfile, " %s", formal->sym->name);
+	  else
+	    fputs (" [Alt Return]", dumpfile);
+	}
     }
 
   if (sym->formal_ns)
     {
       show_indent ();
-      gfc_status ("Formal namespace");
-      gfc_show_namespace (sym->formal_ns);
+      fputs ("Formal namespace", dumpfile);
+      show_namespace (sym->formal_ns);
     }
 
-  gfc_status_char ('\n');
+  fputc ('\n', dumpfile);
 }
 
 
@@ -695,24 +861,23 @@ gfc_show_symbol (gfc_symbol * sym)
    and the name of the associated subroutine, really.  */
 
 static void
-show_uop (gfc_user_op * uop)
+show_uop (gfc_user_op *uop)
 {
   gfc_interface *intr;
 
   show_indent ();
-  gfc_status ("%s:", uop->name);
+  fprintf (dumpfile, "%s:", uop->name);
 
-  for (intr = uop->operator; intr; intr = intr->next)
-    gfc_status (" %s", intr->sym->name);
+  for (intr = uop->op; intr; intr = intr->next)
+    fprintf (dumpfile, " %s", intr->sym->name);
 }
 
 
 /* Workhorse function for traversing the user operator symtree.  */
 
 static void
-traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
+traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
 {
-
   if (st == NULL)
     return;
 
@@ -726,9 +891,8 @@ traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
 /* Traverse the tree of user operator nodes.  */
 
 void
-gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
+gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
 {
-
   traverse_uop (ns->uop_root, func);
 }
 
@@ -736,71 +900,66 @@ gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
 /* Function to display a common block.  */
 
 static void
-show_common (gfc_symtree * st)
+show_common (gfc_symtree *st)
 {
   gfc_symbol *s;
 
   show_indent ();
-  gfc_status ("common: /%s/ ", st->name);
+  fprintf (dumpfile, "common: /%s/ ", st->name);
 
   s = st->n.common->head;
   while (s)
     {
-      gfc_status ("%s", s->name);
+      fprintf (dumpfile, "%s", s->name);
       s = s->common_next;
       if (s)
-	gfc_status (", ");
+	fputs (", ", dumpfile);
     }
-  gfc_status_char ('\n');
+  fputc ('\n', dumpfile);
 }    
 
 
 /* Worker function to display the symbol tree.  */
 
 static void
-show_symtree (gfc_symtree * st)
+show_symtree (gfc_symtree *st)
 {
-
   show_indent ();
-  gfc_status ("symtree: %s  Ambig %d", st->name, st->ambiguous);
+  fprintf (dumpfile, "symtree: %s  Ambig %d", st->name, st->ambiguous);
 
   if (st->n.sym->ns != gfc_current_ns)
-    gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name);
+    fprintf (dumpfile, " from namespace %s", st->n.sym->ns->proc_name->name);
   else
-    gfc_show_symbol (st->n.sym);
+    show_symbol (st->n.sym);
 }
 
 
 /******************* Show gfc_code structures **************/
 
 
-
-static void gfc_show_code_node (int level, gfc_code * c);
-
 /* Show a list of code structures.  Mutually recursive with
-   gfc_show_code_node().  */
+   show_code_node().  */
 
 static void
-gfc_show_code (int level, gfc_code * c)
+show_code (int level, gfc_code *c)
 {
-
   for (; c; c = c->next)
-    gfc_show_code_node (level, c);
+    show_code_node (level, c);
 }
 
 static void
-gfc_show_namelist (gfc_namelist *n)
+show_namelist (gfc_namelist *n)
 {
   for (; n->next; n = n->next)
-    gfc_status ("%s,", n->sym->name);
-  gfc_status ("%s", n->sym->name);
+    fprintf (dumpfile, "%s,", n->sym->name);
+  fprintf (dumpfile, "%s", n->sym->name);
 }
 
 /* Show a single OpenMP directive node and everything underneath it
    if necessary.  */
 
 static void
-gfc_show_omp_node (int level, gfc_code * c)
+show_omp_node (int level, gfc_code *c)
 {
   gfc_omp_clauses *omp_clauses = NULL;
   const char *name = NULL;
@@ -820,11 +979,13 @@ gfc_show_omp_node (int level, gfc_code * c)
     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
     case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
     case EXEC_OMP_SINGLE: name = "SINGLE"; break;
+    case EXEC_OMP_TASK: name = "TASK"; break;
+    case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
     case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
     default:
       gcc_unreachable ();
     }
-  gfc_status ("!$OMP %s", name);
+  fprintf (dumpfile, "!$OMP %s", name);
   switch (c->op)
     {
     case EXEC_OMP_DO:
@@ -835,21 +996,23 @@ gfc_show_omp_node (int level, gfc_code * c)
     case EXEC_OMP_SINGLE:
     case EXEC_OMP_WORKSHARE:
     case EXEC_OMP_PARALLEL_WORKSHARE:
+    case EXEC_OMP_TASK:
       omp_clauses = c->ext.omp_clauses;
       break;
     case EXEC_OMP_CRITICAL:
       if (c->ext.omp_name)
-	gfc_status (" (%s)", c->ext.omp_name);
+	fprintf (dumpfile, " (%s)", c->ext.omp_name);
       break;
     case EXEC_OMP_FLUSH:
       if (c->ext.omp_namelist)
 	{
-	  gfc_status (" (");
-	  gfc_show_namelist (c->ext.omp_namelist);
-	  gfc_status_char (')');
+	  fputs (" (", dumpfile);
+	  show_namelist (c->ext.omp_namelist);
+	  fputc (')', dumpfile);
 	}
       return;
     case EXEC_OMP_BARRIER:
+    case EXEC_OMP_TASKWAIT:
       return;
     default:
       break;
@@ -860,15 +1023,15 @@ gfc_show_omp_node (int level, gfc_code * c)
 
       if (omp_clauses->if_expr)
 	{
-	  gfc_status (" IF(");
-	  gfc_show_expr (omp_clauses->if_expr);
-	  gfc_status_char (')');
+	  fputs (" IF(", dumpfile);
+	  show_expr (omp_clauses->if_expr);
+	  fputc (')', dumpfile);
 	}
       if (omp_clauses->num_threads)
 	{
-	  gfc_status (" NUM_THREADS(");
-	  gfc_show_expr (omp_clauses->num_threads);
-	  gfc_status_char (')');
+	  fputs (" NUM_THREADS(", dumpfile);
+	  show_expr (omp_clauses->num_threads);
+	  fputc (')', dumpfile);
 	}
       if (omp_clauses->sched_kind != OMP_SCHED_NONE)
 	{
@@ -879,16 +1042,17 @@ gfc_show_omp_node (int level, gfc_code * c)
 	    case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
 	    case OMP_SCHED_GUIDED: type = "GUIDED"; break;
 	    case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
+	    case OMP_SCHED_AUTO: type = "AUTO"; break;
 	    default:
 	      gcc_unreachable ();
 	    }
-	  gfc_status (" SCHEDULE (%s", type);
+	  fprintf (dumpfile, " SCHEDULE (%s", type);
 	  if (omp_clauses->chunk_size)
 	    {
-	      gfc_status_char (',');
-	      gfc_show_expr (omp_clauses->chunk_size);
+	      fputc (',', dumpfile);
+	      show_expr (omp_clauses->chunk_size);
 	    }
-	  gfc_status_char (')');
+	  fputc (')', dumpfile);
 	}
       if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
 	{
@@ -898,14 +1062,18 @@ gfc_show_omp_node (int level, gfc_code * c)
 	    case OMP_DEFAULT_NONE: type = "NONE"; break;
 	    case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
 	    case OMP_DEFAULT_SHARED: type = "SHARED"; break;
-	    case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
+	    case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
 	    default:
 	      gcc_unreachable ();
 	    }
-	  gfc_status (" DEFAULT(%s)", type);
+	  fprintf (dumpfile, " DEFAULT(%s)", type);
 	}
       if (omp_clauses->ordered)
-	gfc_status (" ORDERED");
+	fputs (" ORDERED", dumpfile);
+      if (omp_clauses->untied)
+	fputs (" UNTIED", dumpfile);
+      if (omp_clauses->collapse)
+	fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
       for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
 	if (omp_clauses->lists[list_type] != NULL
 	    && list_type != OMP_LIST_COPYPRIVATE)
@@ -930,7 +1098,7 @@ gfc_show_omp_node (int level, gfc_code * c)
 		  default:
 		    gcc_unreachable ();
 		  }
-		gfc_status (" REDUCTION(%s:", type);
+		fprintf (dumpfile, " REDUCTION(%s:", type);
 	      }
 	    else
 	      {
@@ -944,51 +1112,52 @@ gfc_show_omp_node (int level, gfc_code * c)
 		  default:
 		    gcc_unreachable ();
 		  }
-		gfc_status (" %s(", type);
+		fprintf (dumpfile, " %s(", type);
 	      }
-	    gfc_show_namelist (omp_clauses->lists[list_type]);
-	    gfc_status_char (')');
+	    show_namelist (omp_clauses->lists[list_type]);
+	    fputc (')', dumpfile);
 	  }
     }
-  gfc_status_char ('\n');
+  fputc ('\n', dumpfile);
   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
     {
       gfc_code *d = c->block;
       while (d != NULL)
 	{
-	  gfc_show_code (level + 1, d->next);
+	  show_code (level + 1, d->next);
 	  if (d->block == NULL)
 	    break;
 	  code_indent (level, 0);
-	  gfc_status ("!$OMP SECTION\n");
+	  fputs ("!$OMP SECTION\n", dumpfile);
 	  d = d->block;
 	}
     }
   else
-    gfc_show_code (level + 1, c->block->next);
+    show_code (level + 1, c->block->next);
   if (c->op == EXEC_OMP_ATOMIC)
     return;
   code_indent (level, 0);
-  gfc_status ("!$OMP END %s", name);
+  fprintf (dumpfile, "!$OMP END %s", name);
   if (omp_clauses != NULL)
     {
       if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
 	{
-	  gfc_status (" COPYPRIVATE(");
-	  gfc_show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
-	  gfc_status_char (')');
+	  fputs (" COPYPRIVATE(", dumpfile);
+	  show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
+	  fputc (')', dumpfile);
 	}
       else if (omp_clauses->nowait)
-	gfc_status (" NOWAIT");
+	fputs (" NOWAIT", dumpfile);
     }
   else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
-    gfc_status (" (%s)", c->ext.omp_name);
+    fprintf (dumpfile, " (%s)", c->ext.omp_name);
 }
 
+
 /* Show a single code node and everything underneath it if necessary.  */
 
 static void
-gfc_show_code_node (int level, gfc_code * c)
+show_code_node (int level, gfc_code *c)
 {
   gfc_forall_iterator *fa;
   gfc_open *open;
@@ -1004,646 +1173,790 @@ gfc_show_code_node (int level, gfc_code * c)
 
   switch (c->op)
     {
+    case EXEC_END_PROCEDURE:
+      break;
+
     case EXEC_NOP:
-      gfc_status ("NOP");
+      fputs ("NOP", dumpfile);
       break;
 
     case EXEC_CONTINUE:
-      gfc_status ("CONTINUE");
+      fputs ("CONTINUE", dumpfile);
       break;
 
     case EXEC_ENTRY:
-      gfc_status ("ENTRY %s", c->ext.entry->sym->name);
+      fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
       break;
 
+    case EXEC_INIT_ASSIGN:
     case EXEC_ASSIGN:
-      gfc_status ("ASSIGN ");
-      gfc_show_expr (c->expr);
-      gfc_status_char (' ');
-      gfc_show_expr (c->expr2);
+      fputs ("ASSIGN ", dumpfile);
+      show_expr (c->expr1);
+      fputc (' ', dumpfile);
+      show_expr (c->expr2);
       break;
 
     case EXEC_LABEL_ASSIGN:
-      gfc_status ("LABEL ASSIGN ");
-      gfc_show_expr (c->expr);
-      gfc_status (" %d", c->label->value);
+      fputs ("LABEL ASSIGN ", dumpfile);
+      show_expr (c->expr1);
+      fprintf (dumpfile, " %d", c->label1->value);
       break;
 
     case EXEC_POINTER_ASSIGN:
-      gfc_status ("POINTER ASSIGN ");
-      gfc_show_expr (c->expr);
-      gfc_status_char (' ');
-      gfc_show_expr (c->expr2);
+      fputs ("POINTER ASSIGN ", dumpfile);
+      show_expr (c->expr1);
+      fputc (' ', dumpfile);
+      show_expr (c->expr2);
       break;
 
     case EXEC_GOTO:
-      gfc_status ("GOTO ");
-      if (c->label)
-        gfc_status ("%d", c->label->value);
+      fputs ("GOTO ", dumpfile);
+      if (c->label1)
+	fprintf (dumpfile, "%d", c->label1->value);
       else
-        {
-          gfc_show_expr (c->expr);
-          d = c->block;
-          if (d != NULL)
-            {
-              gfc_status (", (");
-              for (; d; d = d ->block)
-                {
-                  code_indent (level, d->label);
-                  if (d->block != NULL)
-                    gfc_status_char (',');
-                  else
-                    gfc_status_char (')');
-                }
-            }
-        }
+	{
+	  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:
-      gfc_status ("CALL %s ", c->resolved_sym->name);
-      gfc_show_actual_arglist (c->ext.actual);
+    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:
-      gfc_status ("RETURN ");
-      if (c->expr)
-	gfc_show_expr (c->expr);
+      fputs ("RETURN ", dumpfile);
+      if (c->expr1)
+	show_expr (c->expr1);
       break;
 
     case EXEC_PAUSE:
-      gfc_status ("PAUSE ");
+      fputs ("PAUSE ", dumpfile);
 
-      if (c->expr != NULL)
-        gfc_show_expr (c->expr);
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
       else
-        gfc_status ("%d", c->ext.stop_code);
+	fprintf (dumpfile, "%d", c->ext.stop_code);
 
       break;
 
     case EXEC_STOP:
-      gfc_status ("STOP ");
+      fputs ("STOP ", dumpfile);
 
-      if (c->expr != NULL)
-        gfc_show_expr (c->expr);
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
       else
-        gfc_status ("%d", c->ext.stop_code);
+	fprintf (dumpfile, "%d", c->ext.stop_code);
 
       break;
 
     case EXEC_ARITHMETIC_IF:
-      gfc_status ("IF ");
-      gfc_show_expr (c->expr);
-      gfc_status (" %d, %d, %d",
-		  c->label->value, c->label2->value, c->label3->value);
+      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;
-      gfc_status ("IF ");
-      gfc_show_expr (d->expr);
-      gfc_status_char ('\n');
-      gfc_show_code (level + 1, d->next);
+      fputs ("IF ", dumpfile);
+      show_expr (d->expr1);
+      fputc ('\n', dumpfile);
+      show_code (level + 1, d->next);
 
       d = d->block;
       for (; d; d = d->block)
 	{
 	  code_indent (level, 0);
 
-	  if (d->expr == NULL)
-	    gfc_status ("ELSE\n");
+	  if (d->expr1 == NULL)
+	    fputs ("ELSE\n", dumpfile);
 	  else
 	    {
-	      gfc_status ("ELSE IF ");
-	      gfc_show_expr (d->expr);
-	      gfc_status_char ('\n');
+	      fputs ("ELSE IF ", dumpfile);
+	      show_expr (d->expr1);
+	      fputc ('\n', dumpfile);
 	    }
 
-	  gfc_show_code (level + 1, d->next);
+	  show_code (level + 1, d->next);
 	}
 
-      code_indent (level, c->label);
+      code_indent (level, c->label1);
 
-      gfc_status ("ENDIF");
+      fputs ("ENDIF", dumpfile);
       break;
 
     case EXEC_SELECT:
       d = c->block;
-      gfc_status ("SELECT CASE ");
-      gfc_show_expr (c->expr);
-      gfc_status_char ('\n');
+      fputs ("SELECT CASE ", dumpfile);
+      show_expr (c->expr1);
+      fputc ('\n', dumpfile);
 
       for (; d; d = d->block)
 	{
 	  code_indent (level, 0);
 
-	  gfc_status ("CASE ");
+	  fputs ("CASE ", dumpfile);
 	  for (cp = d->ext.case_list; cp; cp = cp->next)
 	    {
-	      gfc_status_char ('(');
-	      gfc_show_expr (cp->low);
-	      gfc_status_char (' ');
-	      gfc_show_expr (cp->high);
-	      gfc_status_char (')');
-	      gfc_status_char (' ');
+	      fputc ('(', dumpfile);
+	      show_expr (cp->low);
+	      fputc (' ', dumpfile);
+	      show_expr (cp->high);
+	      fputc (')', dumpfile);
+	      fputc (' ', dumpfile);
 	    }
-	  gfc_status_char ('\n');
+	  fputc ('\n', dumpfile);
 
-	  gfc_show_code (level + 1, d->next);
+	  show_code (level + 1, d->next);
 	}
 
-      code_indent (level, c->label);
-      gfc_status ("END SELECT");
+      code_indent (level, c->label1);
+      fputs ("END SELECT", dumpfile);
       break;
 
     case EXEC_WHERE:
-      gfc_status ("WHERE ");
+      fputs ("WHERE ", dumpfile);
 
       d = c->block;
-      gfc_show_expr (d->expr);
-      gfc_status_char ('\n');
+      show_expr (d->expr1);
+      fputc ('\n', dumpfile);
 
-      gfc_show_code (level + 1, d->next);
+      show_code (level + 1, d->next);
 
       for (d = d->block; d; d = d->block)
 	{
 	  code_indent (level, 0);
-	  gfc_status ("ELSE WHERE ");
-	  gfc_show_expr (d->expr);
-	  gfc_status_char ('\n');
-	  gfc_show_code (level + 1, d->next);
+	  fputs ("ELSE WHERE ", dumpfile);
+	  show_expr (d->expr1);
+	  fputc ('\n', dumpfile);
+	  show_code (level + 1, d->next);
 	}
 
       code_indent (level, 0);
-      gfc_status ("END WHERE");
+      fputs ("END WHERE", dumpfile);
       break;
 
 
     case EXEC_FORALL:
-      gfc_status ("FORALL ");
+      fputs ("FORALL ", dumpfile);
       for (fa = c->ext.forall_iterator; fa; fa = fa->next)
 	{
-	  gfc_show_expr (fa->var);
-	  gfc_status_char (' ');
-	  gfc_show_expr (fa->start);
-	  gfc_status_char (':');
-	  gfc_show_expr (fa->end);
-	  gfc_status_char (':');
-	  gfc_show_expr (fa->stride);
+	  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)
-	    gfc_status_char (',');
+	    fputc (',', dumpfile);
 	}
 
-      if (c->expr != NULL)
+      if (c->expr1 != NULL)
 	{
-	  gfc_status_char (',');
-	  gfc_show_expr (c->expr);
+	  fputc (',', dumpfile);
+	  show_expr (c->expr1);
 	}
-      gfc_status_char ('\n');
+      fputc ('\n', dumpfile);
 
-      gfc_show_code (level + 1, c->block->next);
+      show_code (level + 1, c->block->next);
 
       code_indent (level, 0);
-      gfc_status ("END FORALL");
+      fputs ("END FORALL", dumpfile);
       break;
 
     case EXEC_DO:
-      gfc_status ("DO ");
+      fputs ("DO ", dumpfile);
 
-      gfc_show_expr (c->ext.iterator->var);
-      gfc_status_char ('=');
-      gfc_show_expr (c->ext.iterator->start);
-      gfc_status_char (' ');
-      gfc_show_expr (c->ext.iterator->end);
-      gfc_status_char (' ');
-      gfc_show_expr (c->ext.iterator->step);
-      gfc_status_char ('\n');
+      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);
+      fputc ('\n', dumpfile);
 
-      gfc_show_code (level + 1, c->block->next);
+      show_code (level + 1, c->block->next);
 
       code_indent (level, 0);
-      gfc_status ("END DO");
+      fputs ("END DO", dumpfile);
       break;
 
     case EXEC_DO_WHILE:
-      gfc_status ("DO WHILE ");
-      gfc_show_expr (c->expr);
-      gfc_status_char ('\n');
+      fputs ("DO WHILE ", dumpfile);
+      show_expr (c->expr1);
+      fputc ('\n', dumpfile);
 
-      gfc_show_code (level + 1, c->block->next);
+      show_code (level + 1, c->block->next);
 
-      code_indent (level, c->label);
-      gfc_status ("END DO");
+      code_indent (level, c->label1);
+      fputs ("END DO", dumpfile);
       break;
 
     case EXEC_CYCLE:
-      gfc_status ("CYCLE");
+      fputs ("CYCLE", dumpfile);
       if (c->symtree)
-	gfc_status (" %s", c->symtree->n.sym->name);
+	fprintf (dumpfile, " %s", c->symtree->n.sym->name);
       break;
 
     case EXEC_EXIT:
-      gfc_status ("EXIT");
+      fputs ("EXIT", dumpfile);
       if (c->symtree)
-	gfc_status (" %s", c->symtree->n.sym->name);
+	fprintf (dumpfile, " %s", c->symtree->n.sym->name);
       break;
 
     case EXEC_ALLOCATE:
-      gfc_status ("ALLOCATE ");
-      if (c->expr)
+      fputs ("ALLOCATE ", dumpfile);
+      if (c->expr1)
+	{
+	  fputs (" STAT=", dumpfile);
+	  show_expr (c->expr1);
+	}
+
+      if (c->expr2)
 	{
-	  gfc_status (" STAT=");
-	  gfc_show_expr (c->expr);
+	  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)
 	{
-	  gfc_status_char (' ');
-	  gfc_show_expr (a->expr);
+	  fputc (' ', dumpfile);
+	  show_expr (a->expr);
 	}
 
       break;
 
     case EXEC_DEALLOCATE:
-      gfc_status ("DEALLOCATE ");
-      if (c->expr)
+      fputs ("DEALLOCATE ", dumpfile);
+      if (c->expr1)
 	{
-	  gfc_status (" STAT=");
-	  gfc_show_expr (c->expr);
+	  fputs (" STAT=", dumpfile);
+	  show_expr (c->expr1);
 	}
 
-      for (a = c->ext.alloc_list; a; a = a->next)
+      if (c->expr2)
 	{
-	  gfc_status_char (' ');
-	  gfc_show_expr (a->expr);
+	  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:
-      gfc_status ("OPEN");
+      fputs ("OPEN", dumpfile);
       open = c->ext.open;
 
       if (open->unit)
 	{
-	  gfc_status (" UNIT=");
-	  gfc_show_expr (open->unit);
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (open->unit);
 	}
       if (open->iomsg)
 	{
-	  gfc_status (" IOMSG=");
-	  gfc_show_expr (open->iomsg);
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (open->iomsg);
 	}
       if (open->iostat)
 	{
-	  gfc_status (" IOSTAT=");
-	  gfc_show_expr (open->iostat);
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (open->iostat);
 	}
       if (open->file)
 	{
-	  gfc_status (" FILE=");
-	  gfc_show_expr (open->file);
+	  fputs (" FILE=", dumpfile);
+	  show_expr (open->file);
 	}
       if (open->status)
 	{
-	  gfc_status (" STATUS=");
-	  gfc_show_expr (open->status);
+	  fputs (" STATUS=", dumpfile);
+	  show_expr (open->status);
 	}
       if (open->access)
 	{
-	  gfc_status (" ACCESS=");
-	  gfc_show_expr (open->access);
+	  fputs (" ACCESS=", dumpfile);
+	  show_expr (open->access);
 	}
       if (open->form)
 	{
-	  gfc_status (" FORM=");
-	  gfc_show_expr (open->form);
+	  fputs (" FORM=", dumpfile);
+	  show_expr (open->form);
 	}
       if (open->recl)
 	{
-	  gfc_status (" RECL=");
-	  gfc_show_expr (open->recl);
+	  fputs (" RECL=", dumpfile);
+	  show_expr (open->recl);
 	}
       if (open->blank)
 	{
-	  gfc_status (" BLANK=");
-	  gfc_show_expr (open->blank);
+	  fputs (" BLANK=", dumpfile);
+	  show_expr (open->blank);
 	}
       if (open->position)
 	{
-	  gfc_status (" POSITION=");
-	  gfc_show_expr (open->position);
+	  fputs (" POSITION=", dumpfile);
+	  show_expr (open->position);
 	}
       if (open->action)
 	{
-	  gfc_status (" ACTION=");
-	  gfc_show_expr (open->action);
+	  fputs (" ACTION=", dumpfile);
+	  show_expr (open->action);
 	}
       if (open->delim)
 	{
-	  gfc_status (" DELIM=");
-	  gfc_show_expr (open->delim);
+	  fputs (" DELIM=", dumpfile);
+	  show_expr (open->delim);
 	}
       if (open->pad)
 	{
-	  gfc_status (" PAD=");
-	  gfc_show_expr (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)
 	{
-	  gfc_status (" CONVERT=");
-	  gfc_show_expr (open->convert);
+	  fputs (" CONVERT=", dumpfile);
+	  show_expr (open->convert);
+	}
+      if (open->asynchronous)
+	{
+	  fputs (" ASYNCHRONOUS=", dumpfile);
+	  show_expr (open->asynchronous);
 	}
       if (open->err != NULL)
-	gfc_status (" ERR=%d", open->err->value);
+	fprintf (dumpfile, " ERR=%d", open->err->value);
 
       break;
 
     case EXEC_CLOSE:
-      gfc_status ("CLOSE");
+      fputs ("CLOSE", dumpfile);
       close = c->ext.close;
 
       if (close->unit)
 	{
-	  gfc_status (" UNIT=");
-	  gfc_show_expr (close->unit);
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (close->unit);
 	}
       if (close->iomsg)
 	{
-	  gfc_status (" IOMSG=");
-	  gfc_show_expr (close->iomsg);
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (close->iomsg);
 	}
       if (close->iostat)
 	{
-	  gfc_status (" IOSTAT=");
-	  gfc_show_expr (close->iostat);
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (close->iostat);
 	}
       if (close->status)
 	{
-	  gfc_status (" STATUS=");
-	  gfc_show_expr (close->status);
+	  fputs (" STATUS=", dumpfile);
+	  show_expr (close->status);
 	}
       if (close->err != NULL)
-	gfc_status (" ERR=%d", close->err->value);
+	fprintf (dumpfile, " ERR=%d", close->err->value);
       break;
 
     case EXEC_BACKSPACE:
-      gfc_status ("BACKSPACE");
+      fputs ("BACKSPACE", dumpfile);
       goto show_filepos;
 
     case EXEC_ENDFILE:
-      gfc_status ("ENDFILE");
+      fputs ("ENDFILE", dumpfile);
       goto show_filepos;
 
     case EXEC_REWIND:
-      gfc_status ("REWIND");
+      fputs ("REWIND", dumpfile);
       goto show_filepos;
 
     case EXEC_FLUSH:
-      gfc_status ("FLUSH");
+      fputs ("FLUSH", dumpfile);
 
     show_filepos:
       fp = c->ext.filepos;
 
       if (fp->unit)
 	{
-	  gfc_status (" UNIT=");
-	  gfc_show_expr (fp->unit);
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (fp->unit);
 	}
       if (fp->iomsg)
 	{
-	  gfc_status (" IOMSG=");
-	  gfc_show_expr (fp->iomsg);
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (fp->iomsg);
 	}
       if (fp->iostat)
 	{
-	  gfc_status (" IOSTAT=");
-	  gfc_show_expr (fp->iostat);
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (fp->iostat);
 	}
       if (fp->err != NULL)
-	gfc_status (" ERR=%d", fp->err->value);
+	fprintf (dumpfile, " ERR=%d", fp->err->value);
       break;
 
     case EXEC_INQUIRE:
-      gfc_status ("INQUIRE");
+      fputs ("INQUIRE", dumpfile);
       i = c->ext.inquire;
 
       if (i->unit)
 	{
-	  gfc_status (" UNIT=");
-	  gfc_show_expr (i->unit);
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (i->unit);
 	}
       if (i->file)
 	{
-	  gfc_status (" FILE=");
-	  gfc_show_expr (i->file);
+	  fputs (" FILE=", dumpfile);
+	  show_expr (i->file);
 	}
 
       if (i->iomsg)
 	{
-	  gfc_status (" IOMSG=");
-	  gfc_show_expr (i->iomsg);
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (i->iomsg);
 	}
       if (i->iostat)
 	{
-	  gfc_status (" IOSTAT=");
-	  gfc_show_expr (i->iostat);
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (i->iostat);
 	}
       if (i->exist)
 	{
-	  gfc_status (" EXIST=");
-	  gfc_show_expr (i->exist);
+	  fputs (" EXIST=", dumpfile);
+	  show_expr (i->exist);
 	}
       if (i->opened)
 	{
-	  gfc_status (" OPENED=");
-	  gfc_show_expr (i->opened);
+	  fputs (" OPENED=", dumpfile);
+	  show_expr (i->opened);
 	}
       if (i->number)
 	{
-	  gfc_status (" NUMBER=");
-	  gfc_show_expr (i->number);
+	  fputs (" NUMBER=", dumpfile);
+	  show_expr (i->number);
 	}
       if (i->named)
 	{
-	  gfc_status (" NAMED=");
-	  gfc_show_expr (i->named);
+	  fputs (" NAMED=", dumpfile);
+	  show_expr (i->named);
 	}
       if (i->name)
 	{
-	  gfc_status (" NAME=");
-	  gfc_show_expr (i->name);
+	  fputs (" NAME=", dumpfile);
+	  show_expr (i->name);
 	}
       if (i->access)
 	{
-	  gfc_status (" ACCESS=");
-	  gfc_show_expr (i->access);
+	  fputs (" ACCESS=", dumpfile);
+	  show_expr (i->access);
 	}
       if (i->sequential)
 	{
-	  gfc_status (" SEQUENTIAL=");
-	  gfc_show_expr (i->sequential);
+	  fputs (" SEQUENTIAL=", dumpfile);
+	  show_expr (i->sequential);
 	}
 
       if (i->direct)
 	{
-	  gfc_status (" DIRECT=");
-	  gfc_show_expr (i->direct);
+	  fputs (" DIRECT=", dumpfile);
+	  show_expr (i->direct);
 	}
       if (i->form)
 	{
-	  gfc_status (" FORM=");
-	  gfc_show_expr (i->form);
+	  fputs (" FORM=", dumpfile);
+	  show_expr (i->form);
 	}
       if (i->formatted)
 	{
-	  gfc_status (" FORMATTED");
-	  gfc_show_expr (i->formatted);
+	  fputs (" FORMATTED", dumpfile);
+	  show_expr (i->formatted);
 	}
       if (i->unformatted)
 	{
-	  gfc_status (" UNFORMATTED=");
-	  gfc_show_expr (i->unformatted);
+	  fputs (" UNFORMATTED=", dumpfile);
+	  show_expr (i->unformatted);
 	}
       if (i->recl)
 	{
-	  gfc_status (" RECL=");
-	  gfc_show_expr (i->recl);
+	  fputs (" RECL=", dumpfile);
+	  show_expr (i->recl);
 	}
       if (i->nextrec)
 	{
-	  gfc_status (" NEXTREC=");
-	  gfc_show_expr (i->nextrec);
+	  fputs (" NEXTREC=", dumpfile);
+	  show_expr (i->nextrec);
 	}
       if (i->blank)
 	{
-	  gfc_status (" BLANK=");
-	  gfc_show_expr (i->blank);
+	  fputs (" BLANK=", dumpfile);
+	  show_expr (i->blank);
 	}
       if (i->position)
 	{
-	  gfc_status (" POSITION=");
-	  gfc_show_expr (i->position);
+	  fputs (" POSITION=", dumpfile);
+	  show_expr (i->position);
 	}
       if (i->action)
 	{
-	  gfc_status (" ACTION=");
-	  gfc_show_expr (i->action);
+	  fputs (" ACTION=", dumpfile);
+	  show_expr (i->action);
 	}
       if (i->read)
 	{
-	  gfc_status (" READ=");
-	  gfc_show_expr (i->read);
+	  fputs (" READ=", dumpfile);
+	  show_expr (i->read);
 	}
       if (i->write)
 	{
-	  gfc_status (" WRITE=");
-	  gfc_show_expr (i->write);
+	  fputs (" WRITE=", dumpfile);
+	  show_expr (i->write);
 	}
       if (i->readwrite)
 	{
-	  gfc_status (" READWRITE=");
-	  gfc_show_expr (i->readwrite);
+	  fputs (" READWRITE=", dumpfile);
+	  show_expr (i->readwrite);
 	}
       if (i->delim)
 	{
-	  gfc_status (" DELIM=");
-	  gfc_show_expr (i->delim);
+	  fputs (" DELIM=", dumpfile);
+	  show_expr (i->delim);
 	}
       if (i->pad)
 	{
-	  gfc_status (" PAD=");
-	  gfc_show_expr (i->pad);
+	  fputs (" PAD=", dumpfile);
+	  show_expr (i->pad);
 	}
       if (i->convert)
 	{
-	  gfc_status (" CONVERT=");
-	  gfc_show_expr (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)
-	gfc_status (" ERR=%d", i->err->value);
+	fprintf (dumpfile, " ERR=%d", i->err->value);
       break;
 
     case EXEC_IOLENGTH:
-      gfc_status ("IOLENGTH ");
-      gfc_show_expr (c->expr);
+      fputs ("IOLENGTH ", dumpfile);
+      show_expr (c->expr1);
       goto show_dt_code;
       break;
 
     case EXEC_READ:
-      gfc_status ("READ");
+      fputs ("READ", dumpfile);
       goto show_dt;
 
     case EXEC_WRITE:
-      gfc_status ("WRITE");
+      fputs ("WRITE", dumpfile);
 
     show_dt:
       dt = c->ext.dt;
       if (dt->io_unit)
 	{
-	  gfc_status (" UNIT=");
-	  gfc_show_expr (dt->io_unit);
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (dt->io_unit);
 	}
 
       if (dt->format_expr)
 	{
-	  gfc_status (" FMT=");
-	  gfc_show_expr (dt->format_expr);
+	  fputs (" FMT=", dumpfile);
+	  show_expr (dt->format_expr);
 	}
 
       if (dt->format_label != NULL)
-	gfc_status (" FMT=%d", dt->format_label->value);
+	fprintf (dumpfile, " FMT=%d", dt->format_label->value);
       if (dt->namelist)
-	gfc_status (" NML=%s", dt->namelist->name);
+	fprintf (dumpfile, " NML=%s", dt->namelist->name);
 
       if (dt->iomsg)
 	{
-	  gfc_status (" IOMSG=");
-	  gfc_show_expr (dt->iomsg);
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (dt->iomsg);
 	}
       if (dt->iostat)
 	{
-	  gfc_status (" IOSTAT=");
-	  gfc_show_expr (dt->iostat);
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (dt->iostat);
 	}
       if (dt->size)
 	{
-	  gfc_status (" SIZE=");
-	  gfc_show_expr (dt->size);
+	  fputs (" SIZE=", dumpfile);
+	  show_expr (dt->size);
 	}
       if (dt->rec)
 	{
-	  gfc_status (" REC=");
-	  gfc_show_expr (dt->rec);
+	  fputs (" REC=", dumpfile);
+	  show_expr (dt->rec);
 	}
       if (dt->advance)
 	{
-	  gfc_status (" ADVANCE=");
-	  gfc_show_expr (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:
-      gfc_status_char ('\n');
+      fputc ('\n', dumpfile);
       for (c = c->block->next; c; c = c->next)
-	gfc_show_code_node (level + (c->next != NULL), c);
+	show_code_node (level + (c->next != NULL), c);
       return;
 
     case EXEC_TRANSFER:
-      gfc_status ("TRANSFER ");
-      gfc_show_expr (c->expr);
+      fputs ("TRANSFER ", dumpfile);
+      show_expr (c->expr1);
       break;
 
     case EXEC_DT_END:
-      gfc_status ("DT_END");
+      fputs ("DT_END", dumpfile);
       dt = c->ext.dt;
 
       if (dt->err != NULL)
-	gfc_status (" ERR=%d", dt->err->value);
+	fprintf (dumpfile, " ERR=%d", dt->err->value);
       if (dt->end != NULL)
-	gfc_status (" END=%d", dt->end->value);
+	fprintf (dumpfile, " END=%d", dt->end->value);
       if (dt->eor != NULL)
-	gfc_status (" EOR=%d", dt->eor->value);
+	fprintf (dumpfile, " EOR=%d", dt->eor->value);
       break;
 
     case EXEC_OMP_ATOMIC:
@@ -1659,43 +1972,45 @@ gfc_show_code_node (int level, gfc_code * c)
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SECTIONS:
     case EXEC_OMP_SINGLE:
+    case EXEC_OMP_TASK:
+    case EXEC_OMP_TASKWAIT:
     case EXEC_OMP_WORKSHARE:
-      gfc_show_omp_node (level, c);
+      show_omp_node (level, c);
       break;
 
     default:
-      gfc_internal_error ("gfc_show_code_node(): Bad statement code");
+      gfc_internal_error ("show_code_node(): Bad statement code");
     }
 
-  gfc_status_char ('\n');
+  fputc ('\n', dumpfile);
 }
 
 
 /* Show an equivalence chain.  */
 
 static void
-gfc_show_equiv (gfc_equiv *eq)
+show_equiv (gfc_equiv *eq)
 {
   show_indent ();
-  gfc_status ("Equivalence: ");
+  fputs ("Equivalence: ", dumpfile);
   while (eq)
     {
-      gfc_show_expr (eq->expr);
+      show_expr (eq->expr);
       eq = eq->eq;
       if (eq)
-	gfc_status (", ");
+	fputs (", ", dumpfile);
     }
 }
 
-    
+
 /* Show a freakin' whole namespace.  */
 
-void
-gfc_show_namespace (gfc_namespace * ns)
+static void
+show_namespace (gfc_namespace *ns)
 {
   gfc_interface *intr;
   gfc_namespace *save;
-  gfc_intrinsic_op op;
+  int op;
   gfc_equiv *eq;
   int i;
 
@@ -1703,7 +2018,7 @@ gfc_show_namespace (gfc_namespace * ns)
   show_level++;
 
   show_indent ();
-  gfc_status ("Namespace:");
+  fputs ("Namespace:", dumpfile);
 
   if (ns != NULL)
     {
@@ -1717,18 +2032,18 @@ gfc_show_namespace (gfc_namespace * ns)
 	    i++;
 
 	  if (i > l)
-	    gfc_status(" %c-%c: ", l+'A', i+'A');
+	    fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
 	  else
-	    gfc_status(" %c: ", l+'A');
+	    fprintf (dumpfile, " %c: ", l+'A');
 
-	  gfc_show_typespec(&ns->default_type[l]);
+	  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);
+	  fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
 	}
 
       gfc_current_ns = ns;
@@ -1739,41 +2054,52 @@ gfc_show_namespace (gfc_namespace * ns)
       for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
 	{
 	  /* User operator interfaces */
-	  intr = ns->operator[op];
+	  intr = ns->op[op];
 	  if (intr == NULL)
 	    continue;
 
 	  show_indent ();
-	  gfc_status ("Operator interfaces for %s:", gfc_op2string (op));
+	  fprintf (dumpfile, "Operator interfaces for %s:",
+		   gfc_op2string ((gfc_intrinsic_op) op));
 
 	  for (; intr; intr = intr->next)
-	    gfc_status (" %s", intr->sym->name);
+	    fprintf (dumpfile, " %s", intr->sym->name);
 	}
 
       if (ns->uop_root != NULL)
 	{
 	  show_indent ();
-	  gfc_status ("User operators:\n");
+	  fputs ("User operators:\n", dumpfile);
 	  gfc_traverse_user_op (ns, show_uop);
 	}
     }
   
   for (eq = ns->equiv; eq; eq = eq->next)
-    gfc_show_equiv (eq);
+    show_equiv (eq);
 
-  gfc_status_char ('\n');
-  gfc_status_char ('\n');
+  fputc ('\n', dumpfile);
+  fputc ('\n', dumpfile);
 
-  gfc_show_code (0, ns->code);
+  show_code (0, ns->code);
 
   for (ns = ns->contained; ns; ns = ns->sibling)
     {
       show_indent ();
-      gfc_status ("CONTAINS\n");
-      gfc_show_namespace (ns);
+      fputs ("CONTAINS\n", dumpfile);
+      show_namespace (ns);
     }
 
   show_level--;
-  gfc_status_char ('\n');
+  fputc ('\n', dumpfile);
   gfc_current_ns = save;
 }
+
+
+/* Main function for dumping a parse tree.  */
+
+void
+gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
+{
+  dumpfile = file;
+  show_namespace (ns);
+}