gcc/fortran/dump-parse-tree.c

   1 /* Parse tree dumper
   2    Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
   3    Free Software Foundation, Inc.
   4    Contributed by Steven Bosscher
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 3, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22
  23 /* Actually this is just a collection of routines that used to be
  24    scattered around the sources.  Now that they are all in a single
  25    file, almost all of them can be static, and the other files don't
  26    have this mess in them.
  27
  28    As a nice side-effect, this file can act as documentation of the
  29    gfc_code and gfc_expr structures and all their friends and
  30    relatives.
  31
  32    TODO: Dump DATA.  */
  33
  34 #include "config.h"
  35 #include "system.h"
  36 #include "gfortran.h"
  37 #include "constructor.h"
  38
  39 /* Keep track of indentation for symbol tree dumps.  */
  40 static int show_level = 0;
  41
  42 /* The file handle we're dumping to is kept in a static variable.  This
  43    is not too cool, but it avoids a lot of passing it around.  */
  44 static FILE *dumpfile;
  45
  46 /* Forward declaration of some of the functions.  */
  47 static void show_expr (gfc_expr *p);
  48 static void show_code_node (int, gfc_code *);
  49 static void show_namespace (gfc_namespace *ns);
  50
  51
  52 /* Allow dumping of an expression in the debugger.  */
  53 void gfc_debug_expr (gfc_expr *);
  54
  55 void
  56 gfc_debug_expr (gfc_expr *e)
  57 {
  58   FILE *tmp = dumpfile;
  59   dumpfile = stderr;
  60   show_expr (e);
  61   fputc ('\n', dumpfile);
  62   dumpfile = tmp;
  63 }
  64
  65
  66 /* Do indentation for a specific level.  */
  67
  68 static inline void
  69 code_indent (int level, gfc_st_label *label)
  70 {
  71   int i;
  72
  73   if (label != NULL)
  74     fprintf (dumpfile, "%-5d ", label->value);
  75
  76   for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
  77     fputc (' ', dumpfile);
  78 }
  79
  80
  81 /* Simple indentation at the current level.  This one
  82    is used to show symbols.  */
  83
  84 static inline void
  85 show_indent (void)
  86 {
  87   fputc ('\n', dumpfile);
  88   code_indent (show_level, NULL);
  89 }
  90
  91
  92 /* Show type-specific information.  */
  93
  94 static void
  95 show_typespec (gfc_typespec *ts)
  96 {
  97   fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
  98
  99   switch (ts->type)
 100     {
 101     case BT_DERIVED:
 102     case BT_CLASS:
 103       fprintf (dumpfile, "%s", ts->u.derived->name);
 104       break;
 105
 106     case BT_CHARACTER:
 107       show_expr (ts->u.cl->length);
 108       fprintf(dumpfile, " %d", ts->kind);
 109       break;
 110
 111     default:
 112       fprintf (dumpfile, "%d", ts->kind);
 113       break;
 114     }
 115
 116   fputc (')', dumpfile);
 117 }
 118
 119
 120 /* Show an actual argument list.  */
 121
 122 static void
 123 show_actual_arglist (gfc_actual_arglist *a)
 124 {
 125   fputc ('(', dumpfile);
 126
 127   for (; a; a = a->next)
 128     {
 129       fputc ('(', dumpfile);
 130       if (a->name != NULL)
 131         fprintf (dumpfile, "%s = ", a->name);
 132       if (a->expr != NULL)
 133         show_expr (a->expr);
 134       else
 135         fputs ("(arg not-present)", dumpfile);
 136
 137       fputc (')', dumpfile);
 138       if (a->next != NULL)
 139         fputc (' ', dumpfile);
 140     }
 141
 142   fputc (')', dumpfile);
 143 }
 144
 145
 146 /* Show a gfc_array_spec array specification structure.  */
 147
 148 static void
 149 show_array_spec (gfc_array_spec *as)
 150 {
 151   const char *c;
 152   int i;
 153
 154   if (as == NULL)
 155     {
 156       fputs ("()", dumpfile);
 157       return;
 158     }
 159
 160   fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
 161
 162   if (as->rank + as->corank > 0)
 163     {
 164       switch (as->type)
 165       {
 166         case AS_EXPLICIT:      c = "AS_EXPLICIT";      break;
 167         case AS_DEFERRED:      c = "AS_DEFERRED";      break;
 168         case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
 169         case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
 170         default:
 171           gfc_internal_error ("show_array_spec(): Unhandled array shape "
 172                               "type.");
 173       }
 174       fprintf (dumpfile, " %s ", c);
 175
 176       for (i = 0; i < as->rank + as->corank; i++)
 177         {
 178           show_expr (as->lower[i]);
 179           fputc (' ', dumpfile);
 180           show_expr (as->upper[i]);
 181           fputc (' ', dumpfile);
 182         }
 183     }
 184
 185   fputc (')', dumpfile);
 186 }
 187
 188
 189 /* Show a gfc_array_ref array reference structure.  */
 190
 191 static void
 192 show_array_ref (gfc_array_ref * ar)
 193 {
 194   int i;
 195
 196   fputc ('(', dumpfile);
 197
 198   switch (ar->type)
 199     {
 200     case AR_FULL:
 201       fputs ("FULL", dumpfile);
 202       break;
 203
 204     case AR_SECTION:
 205       for (i = 0; i < ar->dimen; i++)
 206         {
 207           /* There are two types of array sections: either the
 208              elements are identified by an integer array ('vector'),
 209              or by an index range. In the former case we only have to
 210              print the start expression which contains the vector, in
 211              the latter case we have to print any of lower and upper
 212              bound and the stride, if they're present.  */
 213
 214           if (ar->start[i] != NULL)
 215             show_expr (ar->start[i]);
 216
 217           if (ar->dimen_type[i] == DIMEN_RANGE)
 218             {
 219               fputc (':', dumpfile);
 220
 221               if (ar->end[i] != NULL)
 222                 show_expr (ar->end[i]);
 223
 224               if (ar->stride[i] != NULL)
 225                 {
 226                   fputc (':', dumpfile);
 227                   show_expr (ar->stride[i]);
 228                 }
 229             }
 230
 231           if (i != ar->dimen - 1)
 232             fputs (" , ", dumpfile);
 233         }
 234       break;
 235
 236     case AR_ELEMENT:
 237       for (i = 0; i < ar->dimen; i++)
 238         {
 239           show_expr (ar->start[i]);
 240           if (i != ar->dimen - 1)
 241             fputs (" , ", dumpfile);
 242         }
 243       break;
 244
 245     case AR_UNKNOWN:
 246       fputs ("UNKNOWN", dumpfile);
 247       break;
 248
 249     default:
 250       gfc_internal_error ("show_array_ref(): Unknown array reference");
 251     }
 252
 253   fputc (')', dumpfile);
 254 }
 255
 256
 257 /* Show a list of gfc_ref structures.  */
 258
 259 static void
 260 show_ref (gfc_ref *p)
 261 {
 262   for (; p; p = p->next)
 263     switch (p->type)
 264       {
 265       case REF_ARRAY:
 266         show_array_ref (&p->u.ar);
 267         break;
 268
 269       case REF_COMPONENT:
 270         fprintf (dumpfile, " %% %s", p->u.c.component->name);
 271         break;
 272
 273       case REF_SUBSTRING:
 274         fputc ('(', dumpfile);
 275         show_expr (p->u.ss.start);
 276         fputc (':', dumpfile);
 277         show_expr (p->u.ss.end);
 278         fputc (')', dumpfile);
 279         break;
 280
 281       default:
 282         gfc_internal_error ("show_ref(): Bad component code");
 283       }
 284 }
 285
 286
 287 /* Display a constructor.  Works recursively for array constructors.  */
 288
 289 static void
 290 show_constructor (gfc_constructor_base base)
 291 {
 292   gfc_constructor *c;
 293   for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
 294     {
 295       if (c->iterator == NULL)
 296         show_expr (c->expr);
 297       else
 298         {
 299           fputc ('(', dumpfile);
 300           show_expr (c->expr);
 301
 302           fputc (' ', dumpfile);
 303           show_expr (c->iterator->var);
 304           fputc ('=', dumpfile);
 305           show_expr (c->iterator->start);
 306           fputc (',', dumpfile);
 307           show_expr (c->iterator->end);
 308           fputc (',', dumpfile);
 309           show_expr (c->iterator->step);
 310
 311           fputc (')', dumpfile);
 312         }
 313
 314       if (gfc_constructor_next (c) != NULL)
 315         fputs (" , ", dumpfile);
 316     }
 317 }
 318
 319
 320 static void
 321 show_char_const (const gfc_char_t *c, int length)
 322 {
 323   int i;
 324
 325   fputc ('\'', dumpfile);
 326   for (i = 0; i < length; i++)
 327     {
 328       if (c[i] == '\'')
 329         fputs ("''", dumpfile);
 330       else
 331         fputs (gfc_print_wide_char (c[i]), dumpfile);
 332     }
 333   fputc ('\'', dumpfile);
 334 }
 335
 336
 337 /* Show a component-call expression.  */
 338
 339 static void
 340 show_compcall (gfc_expr* p)
 341 {
 342   gcc_assert (p->expr_type == EXPR_COMPCALL);
 343
 344   fprintf (dumpfile, "%s", p->symtree->n.sym->name);
 345   show_ref (p->ref);
 346   fprintf (dumpfile, "%s", p->value.compcall.name);
 347
 348   show_actual_arglist (p->value.compcall.actual);
 349 }
 350
 351
 352 /* Show an expression.  */
 353
 354 static void
 355 show_expr (gfc_expr *p)
 356 {
 357   const char *c;
 358   int i;
 359
 360   if (p == NULL)
 361     {
 362       fputs ("()", dumpfile);
 363       return;
 364     }
 365
 366   switch (p->expr_type)
 367     {
 368     case EXPR_SUBSTRING:
 369       show_char_const (p->value.character.string, p->value.character.length);
 370       show_ref (p->ref);
 371       break;
 372
 373     case EXPR_STRUCTURE:
 374       fprintf (dumpfile, "%s(", p->ts.u.derived->name);
 375       show_constructor (p->value.constructor);
 376       fputc (')', dumpfile);
 377       break;
 378
 379     case EXPR_ARRAY:
 380       fputs ("(/ ", dumpfile);
 381       show_constructor (p->value.constructor);
 382       fputs (" /)", dumpfile);
 383
 384       show_ref (p->ref);
 385       break;
 386
 387     case EXPR_NULL:
 388       fputs ("NULL()", dumpfile);
 389       break;
 390
 391     case EXPR_CONSTANT:
 392       switch (p->ts.type)
 393         {
 394         case BT_INTEGER:
 395           mpz_out_str (stdout, 10, p->value.integer);
 396
 397           if (p->ts.kind != gfc_default_integer_kind)
 398             fprintf (dumpfile, "_%d", p->ts.kind);
 399           break;
 400
 401         case BT_LOGICAL:
 402           if (p->value.logical)
 403             fputs (".true.", dumpfile);
 404           else
 405             fputs (".false.", dumpfile);
 406           break;
 407
 408         case BT_REAL:
 409           mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
 410           if (p->ts.kind != gfc_default_real_kind)
 411             fprintf (dumpfile, "_%d", p->ts.kind);
 412           break;
 413
 414         case BT_CHARACTER:
 415           show_char_const (p->value.character.string,
 416                            p->value.character.length);
 417           break;
 418
 419         case BT_COMPLEX:
 420           fputs ("(complex ", dumpfile);
 421
 422           mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
 423                         GFC_RND_MODE);
 424           if (p->ts.kind != gfc_default_complex_kind)
 425             fprintf (dumpfile, "_%d", p->ts.kind);
 426
 427           fputc (' ', dumpfile);
 428
 429           mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
 430                         GFC_RND_MODE);
 431           if (p->ts.kind != gfc_default_complex_kind)
 432             fprintf (dumpfile, "_%d", p->ts.kind);
 433
 434           fputc (')', dumpfile);
 435           break;
 436
 437         case BT_HOLLERITH:
 438           fprintf (dumpfile, "%dH", p->representation.length);
 439           c = p->representation.string;
 440           for (i = 0; i < p->representation.length; i++, c++)
 441             {
 442               fputc (*c, dumpfile);
 443             }
 444           break;
 445
 446         default:
 447           fputs ("???", dumpfile);
 448           break;
 449         }
 450
 451       if (p->representation.string)
 452         {
 453           fputs (" {", dumpfile);
 454           c = p->representation.string;
 455           for (i = 0; i < p->representation.length; i++, c++)
 456             {
 457               fprintf (dumpfile, "%.2x", (unsigned int) *c);
 458               if (i < p->representation.length - 1)
 459                 fputc (',', dumpfile);
 460             }
 461           fputc ('}', dumpfile);
 462         }
 463
 464       break;
 465
 466     case EXPR_VARIABLE:
 467       if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
 468         fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
 469       fprintf (dumpfile, "%s", p->symtree->n.sym->name);
 470       show_ref (p->ref);
 471       break;
 472
 473     case EXPR_OP:
 474       fputc ('(', dumpfile);
 475       switch (p->value.op.op)
 476         {
 477         case INTRINSIC_UPLUS:
 478           fputs ("U+ ", dumpfile);
 479           break;
 480         case INTRINSIC_UMINUS:
 481           fputs ("U- ", dumpfile);
 482           break;
 483         case INTRINSIC_PLUS:
 484           fputs ("+ ", dumpfile);
 485           break;
 486         case INTRINSIC_MINUS:
 487           fputs ("- ", dumpfile);
 488           break;
 489         case INTRINSIC_TIMES:
 490           fputs ("* ", dumpfile);
 491           break;
 492         case INTRINSIC_DIVIDE:
 493           fputs ("/ ", dumpfile);
 494           break;
 495         case INTRINSIC_POWER:
 496           fputs ("** ", dumpfile);
 497           break;
 498         case INTRINSIC_CONCAT:
 499           fputs ("// ", dumpfile);
 500           break;
 501         case INTRINSIC_AND:
 502           fputs ("AND ", dumpfile);
 503           break;
 504         case INTRINSIC_OR:
 505           fputs ("OR ", dumpfile);
 506           break;
 507         case INTRINSIC_EQV:
 508           fputs ("EQV ", dumpfile);
 509           break;
 510         case INTRINSIC_NEQV:
 511           fputs ("NEQV ", dumpfile);
 512           break;
 513         case INTRINSIC_EQ:
 514         case INTRINSIC_EQ_OS:
 515           fputs ("= ", dumpfile);
 516           break;
 517         case INTRINSIC_NE:
 518         case INTRINSIC_NE_OS:
 519           fputs ("/= ", dumpfile);
 520           break;
 521         case INTRINSIC_GT:
 522         case INTRINSIC_GT_OS:
 523           fputs ("> ", dumpfile);
 524           break;
 525         case INTRINSIC_GE:
 526         case INTRINSIC_GE_OS:
 527           fputs (">= ", dumpfile);
 528           break;
 529         case INTRINSIC_LT:
 530         case INTRINSIC_LT_OS:
 531           fputs ("< ", dumpfile);
 532           break;
 533         case INTRINSIC_LE:
 534         case INTRINSIC_LE_OS:
 535           fputs ("<= ", dumpfile);
 536           break;
 537         case INTRINSIC_NOT:
 538           fputs ("NOT ", dumpfile);
 539           break;
 540         case INTRINSIC_PARENTHESES:
 541           fputs ("parens ", dumpfile);
 542           break;
 543
 544         default:
 545           gfc_internal_error
 546             ("show_expr(): Bad intrinsic in expression!");
 547         }
 548
 549       show_expr (p->value.op.op1);
 550
 551       if (p->value.op.op2)
 552         {
 553           fputc (' ', dumpfile);
 554           show_expr (p->value.op.op2);
 555         }
 556
 557       fputc (')', dumpfile);
 558       break;
 559
 560     case EXPR_FUNCTION:
 561       if (p->value.function.name == NULL)
 562         {
 563           fprintf (dumpfile, "%s", p->symtree->n.sym->name);
 564           if (gfc_is_proc_ptr_comp (p, NULL))
 565             show_ref (p->ref);
 566           fputc ('[', dumpfile);
 567           show_actual_arglist (p->value.function.actual);
 568           fputc (']', dumpfile);
 569         }
 570       else
 571         {
 572           fprintf (dumpfile, "%s", p->value.function.name);
 573           if (gfc_is_proc_ptr_comp (p, NULL))
 574             show_ref (p->ref);
 575           fputc ('[', dumpfile);
 576           fputc ('[', dumpfile);
 577           show_actual_arglist (p->value.function.actual);
 578           fputc (']', dumpfile);
 579           fputc (']', dumpfile);
 580         }
 581
 582       break;
 583
 584     case EXPR_COMPCALL:
 585       show_compcall (p);
 586       break;
 587
 588     default:
 589       gfc_internal_error ("show_expr(): Don't know how to show expr");
 590     }
 591 }
 592
 593 /* Show symbol attributes.  The flavor and intent are followed by
 594    whatever single bit attributes are present.  */
 595
 596 static void
 597 show_attr (symbol_attribute *attr, const char * module)
 598 {
 599   if (attr->flavor != FL_UNKNOWN)
 600     fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
 601   if (attr->access != ACCESS_UNKNOWN)
 602     fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
 603   if (attr->proc != PROC_UNKNOWN)
 604     fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
 605   if (attr->save != SAVE_NONE)
 606     fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
 607
 608   if (attr->allocatable)
 609     fputs (" ALLOCATABLE", dumpfile);
 610   if (attr->asynchronous)
 611     fputs (" ASYNCHRONOUS", dumpfile);
 612   if (attr->codimension)
 613     fputs (" CODIMENSION", dumpfile);
 614   if (attr->dimension)
 615     fputs (" DIMENSION", dumpfile);
 616   if (attr->contiguous)
 617     fputs (" CONTIGUOUS", dumpfile);
 618   if (attr->external)
 619     fputs (" EXTERNAL", dumpfile);
 620   if (attr->intrinsic)
 621     fputs (" INTRINSIC", dumpfile);
 622   if (attr->optional)
 623     fputs (" OPTIONAL", dumpfile);
 624   if (attr->pointer)
 625     fputs (" POINTER", dumpfile);
 626   if (attr->is_protected)
 627     fputs (" PROTECTED", dumpfile);
 628   if (attr->value)
 629     fputs (" VALUE", dumpfile);
 630   if (attr->volatile_)
 631     fputs (" VOLATILE", dumpfile);
 632   if (attr->threadprivate)
 633     fputs (" THREADPRIVATE", dumpfile);
 634   if (attr->target)
 635     fputs (" TARGET", dumpfile);
 636   if (attr->dummy)
 637     {
 638       fputs (" DUMMY", dumpfile);
 639       if (attr->intent != INTENT_UNKNOWN)
 640         fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
 641     }
 642
 643   if (attr->result)
 644     fputs (" RESULT", dumpfile);
 645   if (attr->entry)
 646     fputs (" ENTRY", dumpfile);
 647   if (attr->is_bind_c)
 648     fputs (" BIND(C)", dumpfile);
 649
 650   if (attr->data)
 651     fputs (" DATA", dumpfile);
 652   if (attr->use_assoc)
 653     {
 654       fputs (" USE-ASSOC", dumpfile);
 655       if (module != NULL)
 656         fprintf (dumpfile, "(%s)", module);
 657     }
 658
 659   if (attr->in_namelist)
 660     fputs (" IN-NAMELIST", dumpfile);
 661   if (attr->in_common)
 662     fputs (" IN-COMMON", dumpfile);
 663
 664   if (attr->abstract)
 665     fputs (" ABSTRACT", dumpfile);
 666   if (attr->function)
 667     fputs (" FUNCTION", dumpfile);
 668   if (attr->subroutine)
 669     fputs (" SUBROUTINE", dumpfile);
 670   if (attr->implicit_type)
 671     fputs (" IMPLICIT-TYPE", dumpfile);
 672
 673   if (attr->sequence)
 674     fputs (" SEQUENCE", dumpfile);
 675   if (attr->elemental)
 676     fputs (" ELEMENTAL", dumpfile);
 677   if (attr->pure)
 678     fputs (" PURE", dumpfile);
 679   if (attr->recursive)
 680     fputs (" RECURSIVE", dumpfile);
 681
 682   fputc (')', dumpfile);
 683 }
 684
 685
 686 /* Show components of a derived type.  */
 687
 688 static void
 689 show_components (gfc_symbol *sym)
 690 {
 691   gfc_component *c;
 692
 693   for (c = sym->components; c; c = c->next)
 694     {
 695       fprintf (dumpfile, "(%s ", c->name);
 696       show_typespec (&c->ts);
 697       if (c->attr.allocatable)
 698         fputs (" ALLOCATABLE", dumpfile);
 699       if (c->attr.pointer)
 700         fputs (" POINTER", dumpfile);
 701       if (c->attr.proc_pointer)
 702         fputs (" PPC", dumpfile);
 703       if (c->attr.dimension)
 704         fputs (" DIMENSION", dumpfile);
 705       fputc (' ', dumpfile);
 706       show_array_spec (c->as);
 707       if (c->attr.access)
 708         fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
 709       fputc (')', dumpfile);
 710       if (c->next != NULL)
 711         fputc (' ', dumpfile);
 712     }
 713 }
 714
 715
 716 /* Show the f2k_derived namespace with procedure bindings.  */
 717
 718 static void
 719 show_typebound_proc (gfc_typebound_proc* tb, const char* name)
 720 {
 721   show_indent ();
 722
 723   if (tb->is_generic)
 724     fputs ("GENERIC", dumpfile);
 725   else
 726     {
 727       fputs ("PROCEDURE, ", dumpfile);
 728       if (tb->nopass)
 729         fputs ("NOPASS", dumpfile);
 730       else
 731         {
 732           if (tb->pass_arg)
 733             fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
 734           else
 735             fputs ("PASS", dumpfile);
 736         }
 737       if (tb->non_overridable)
 738         fputs (", NON_OVERRIDABLE", dumpfile);
 739     }
 740
 741   if (tb->access == ACCESS_PUBLIC)
 742     fputs (", PUBLIC", dumpfile);
 743   else
 744     fputs (", PRIVATE", dumpfile);
 745
 746   fprintf (dumpfile, " :: %s => ", name);
 747
 748   if (tb->is_generic)
 749     {
 750       gfc_tbp_generic* g;
 751       for (g = tb->u.generic; g; g = g->next)
 752         {
 753           fputs (g->specific_st->name, dumpfile);
 754           if (g->next)
 755             fputs (", ", dumpfile);
 756         }
 757     }
 758   else
 759     fputs (tb->u.specific->n.sym->name, dumpfile);
 760 }
 761
 762 static void
 763 show_typebound_symtree (gfc_symtree* st)
 764 {
 765   gcc_assert (st->n.tb);
 766   show_typebound_proc (st->n.tb, st->name);
 767 }
 768
 769 static void
 770 show_f2k_derived (gfc_namespace* f2k)
 771 {
 772   gfc_finalizer* f;
 773   int op;
 774
 775   show_indent ();
 776   fputs ("Procedure bindings:", dumpfile);
 777   ++show_level;
 778
 779   /* Finalizer bindings.  */
 780   for (f = f2k->finalizers; f; f = f->next)
 781     {
 782       show_indent ();
 783       fprintf (dumpfile, "FINAL %s", f->proc_sym->name);
 784     }
 785
 786   /* Type-bound procedures.  */
 787   gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
 788
 789   --show_level;
 790
 791   show_indent ();
 792   fputs ("Operator bindings:", dumpfile);
 793   ++show_level;
 794
 795   /* User-defined operators.  */
 796   gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
 797
 798   /* Intrinsic operators.  */
 799   for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
 800     if (f2k->tb_op[op])
 801       show_typebound_proc (f2k->tb_op[op],
 802                            gfc_op2string ((gfc_intrinsic_op) op));
 803
 804   --show_level;
 805 }
 806
 807
 808 /* Show a symbol.  If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
 809    show the interface.  Information needed to reconstruct the list of
 810    specific interfaces associated with a generic symbol is done within
 811    that symbol.  */
 812
 813 static void
 814 show_symbol (gfc_symbol *sym)
 815 {
 816   gfc_formal_arglist *formal;
 817   gfc_interface *intr;
 818   int i,len;
 819
 820   if (sym == NULL)
 821     return;
 822
 823   fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
 824   len = strlen (sym->name);
 825   for (i=len; i<12; i++)
 826     fputc(' ', dumpfile);
 827
 828   ++show_level;
 829
 830   show_indent ();
 831   fputs ("type spec : ", dumpfile);
 832   show_typespec (&sym->ts);
 833
 834   show_indent ();
 835   fputs ("attributes: ", dumpfile);
 836   show_attr (&sym->attr, sym->module);
 837
 838   if (sym->value)
 839     {
 840       show_indent ();
 841       fputs ("value: ", dumpfile);
 842       show_expr (sym->value);
 843     }
 844
 845   if (sym->as)
 846     {
 847       show_indent ();
 848       fputs ("Array spec:", dumpfile);
 849       show_array_spec (sym->as);
 850     }
 851
 852   if (sym->generic)
 853     {
 854       show_indent ();
 855       fputs ("Generic interfaces:", dumpfile);
 856       for (intr = sym->generic; intr; intr = intr->next)
 857         fprintf (dumpfile, " %s", intr->sym->name);
 858     }
 859
 860   if (sym->result)
 861     {
 862       show_indent ();
 863       fprintf (dumpfile, "result: %s", sym->result->name);
 864     }
 865
 866   if (sym->components)
 867     {
 868       show_indent ();
 869       fputs ("components: ", dumpfile);
 870       show_components (sym);
 871     }
 872
 873   if (sym->f2k_derived)
 874     {
 875       show_indent ();
 876       if (sym->hash_value)
 877         fprintf (dumpfile, "hash: %d", sym->hash_value);
 878       show_f2k_derived (sym->f2k_derived);
 879     }
 880
 881   if (sym->formal)
 882     {
 883       show_indent ();
 884       fputs ("Formal arglist:", dumpfile);
 885
 886       for (formal = sym->formal; formal; formal = formal->next)
 887         {
 888           if (formal->sym != NULL)
 889             fprintf (dumpfile, " %s", formal->sym->name);
 890           else
 891             fputs (" [Alt Return]", dumpfile);
 892         }
 893     }
 894
 895   if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
 896       && sym->attr.proc != PROC_ST_FUNCTION
 897       && !sym->attr.entry)
 898     {
 899       show_indent ();
 900       fputs ("Formal namespace", dumpfile);
 901       show_namespace (sym->formal_ns);
 902     }
 903   --show_level;
 904 }
 905
 906
 907 /* Show a user-defined operator.  Just prints an operator
 908    and the name of the associated subroutine, really.  */
 909
 910 static void
 911 show_uop (gfc_user_op *uop)
 912 {
 913   gfc_interface *intr;
 914
 915   show_indent ();
 916   fprintf (dumpfile, "%s:", uop->name);
 917
 918   for (intr = uop->op; intr; intr = intr->next)
 919     fprintf (dumpfile, " %s", intr->sym->name);
 920 }
 921
 922
 923 /* Workhorse function for traversing the user operator symtree.  */
 924
 925 static void
 926 traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
 927 {
 928   if (st == NULL)
 929     return;
 930
 931   (*func) (st->n.uop);
 932
 933   traverse_uop (st->left, func);
 934   traverse_uop (st->right, func);
 935 }
 936
 937
 938 /* Traverse the tree of user operator nodes.  */
 939
 940 void
 941 gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
 942 {
 943   traverse_uop (ns->uop_root, func);
 944 }
 945
 946
 947 /* Function to display a common block.  */
 948
 949 static void
 950 show_common (gfc_symtree *st)
 951 {
 952   gfc_symbol *s;
 953
 954   show_indent ();
 955   fprintf (dumpfile, "common: /%s/ ", st->name);
 956
 957   s = st->n.common->head;
 958   while (s)
 959     {
 960       fprintf (dumpfile, "%s", s->name);
 961       s = s->common_next;
 962       if (s)
 963         fputs (", ", dumpfile);
 964     }
 965   fputc ('\n', dumpfile);
 966 }
 967
 968
 969 /* Worker function to display the symbol tree.  */
 970
 971 static void
 972 show_symtree (gfc_symtree *st)
 973 {
 974   int len, i;
 975
 976   show_indent ();
 977
 978   len = strlen(st->name);
 979   fprintf (dumpfile, "symtree: '%s'", st->name);
 980
 981   for (i=len; i<12; i++)
 982     fputc(' ', dumpfile);
 983
 984   if (st->ambiguous)
 985     fputs( " Ambiguous", dumpfile);
 986
 987   if (st->n.sym->ns != gfc_current_ns)
 988     fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
 989              st->n.sym->ns->proc_name->name);
 990   else
 991     show_symbol (st->n.sym);
 992 }
 993
 994
 995 /******************* Show gfc_code structures **************/
 996
 997
 998 /* Show a list of code structures.  Mutually recursive with
 999    show_code_node().  */
1000
1001 static void
1002 show_code (int level, gfc_code *c)
1003 {
1004   for (; c; c = c->next)
1005     show_code_node (level, c);
1006 }
1007
1008 static void
1009 show_namelist (gfc_namelist *n)
1010 {
1011   for (; n->next; n = n->next)
1012     fprintf (dumpfile, "%s,", n->sym->name);
1013   fprintf (dumpfile, "%s", n->sym->name);
1014 }
1015
1016 /* Show a single OpenMP directive node and everything underneath it
1017    if necessary.  */
1018
1019 static void
1020 show_omp_node (int level, gfc_code *c)
1021 {
1022   gfc_omp_clauses *omp_clauses = NULL;
1023   const char *name = NULL;
1024
1025   switch (c->op)
1026     {
1027     case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
1028     case EXEC_OMP_BARRIER: name = "BARRIER"; break;
1029     case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
1030     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
1031     case EXEC_OMP_DO: name = "DO"; break;
1032     case EXEC_OMP_MASTER: name = "MASTER"; break;
1033     case EXEC_OMP_ORDERED: name = "ORDERED"; break;
1034     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
1035     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
1036     case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
1037     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
1038     case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
1039     case EXEC_OMP_SINGLE: name = "SINGLE"; break;
1040     case EXEC_OMP_TASK: name = "TASK"; break;
1041     case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
1042     case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
1043     case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
1044     default:
1045       gcc_unreachable ();
1046     }
1047   fprintf (dumpfile, "!$OMP %s", name);
1048   switch (c->op)
1049     {
1050     case EXEC_OMP_DO:
1051     case EXEC_OMP_PARALLEL:
1052     case EXEC_OMP_PARALLEL_DO:
1053     case EXEC_OMP_PARALLEL_SECTIONS:
1054     case EXEC_OMP_SECTIONS:
1055     case EXEC_OMP_SINGLE:
1056     case EXEC_OMP_WORKSHARE:
1057     case EXEC_OMP_PARALLEL_WORKSHARE:
1058     case EXEC_OMP_TASK:
1059       omp_clauses = c->ext.omp_clauses;
1060       break;
1061     case EXEC_OMP_CRITICAL:
1062       if (c->ext.omp_name)
1063         fprintf (dumpfile, " (%s)", c->ext.omp_name);
1064       break;
1065     case EXEC_OMP_FLUSH:
1066       if (c->ext.omp_namelist)
1067         {
1068           fputs (" (", dumpfile);
1069           show_namelist (c->ext.omp_namelist);
1070           fputc (')', dumpfile);
1071         }
1072       return;
1073     case EXEC_OMP_BARRIER:
1074     case EXEC_OMP_TASKWAIT:
1075     case EXEC_OMP_TASKYIELD:
1076       return;
1077     default:
1078       break;
1079     }
1080   if (omp_clauses)
1081     {
1082       int list_type;
1083
1084       if (omp_clauses->if_expr)
1085         {
1086           fputs (" IF(", dumpfile);
1087           show_expr (omp_clauses->if_expr);
1088           fputc (')', dumpfile);
1089         }
1090       if (omp_clauses->final_expr)
1091         {
1092           fputs (" FINAL(", dumpfile);
1093           show_expr (omp_clauses->final_expr);
1094           fputc (')', dumpfile);
1095         }
1096       if (omp_clauses->num_threads)
1097         {
1098           fputs (" NUM_THREADS(", dumpfile);
1099           show_expr (omp_clauses->num_threads);
1100           fputc (')', dumpfile);
1101         }
1102       if (omp_clauses->sched_kind != OMP_SCHED_NONE)
1103         {
1104           const char *type;
1105           switch (omp_clauses->sched_kind)
1106             {
1107             case OMP_SCHED_STATIC: type = "STATIC"; break;
1108             case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
1109             case OMP_SCHED_GUIDED: type = "GUIDED"; break;
1110             case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
1111             case OMP_SCHED_AUTO: type = "AUTO"; break;
1112             default:
1113               gcc_unreachable ();
1114             }
1115           fprintf (dumpfile, " SCHEDULE (%s", type);
1116           if (omp_clauses->chunk_size)
1117             {
1118               fputc (',', dumpfile);
1119               show_expr (omp_clauses->chunk_size);
1120             }
1121           fputc (')', dumpfile);
1122         }
1123       if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
1124         {
1125           const char *type;
1126           switch (omp_clauses->default_sharing)
1127             {
1128             case OMP_DEFAULT_NONE: type = "NONE"; break;
1129             case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
1130             case OMP_DEFAULT_SHARED: type = "SHARED"; break;
1131             case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1132             default:
1133               gcc_unreachable ();
1134             }
1135           fprintf (dumpfile, " DEFAULT(%s)", type);
1136         }
1137       if (omp_clauses->ordered)
1138         fputs (" ORDERED", dumpfile);
1139       if (omp_clauses->untied)
1140         fputs (" UNTIED", dumpfile);
1141       if (omp_clauses->mergeable)
1142         fputs (" MERGEABLE", dumpfile);
1143       if (omp_clauses->collapse)
1144         fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
1145       for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
1146         if (omp_clauses->lists[list_type] != NULL
1147             && list_type != OMP_LIST_COPYPRIVATE)
1148           {
1149             const char *type;
1150             if (list_type >= OMP_LIST_REDUCTION_FIRST)
1151               {
1152                 switch (list_type)
1153                   {
1154                   case OMP_LIST_PLUS: type = "+"; break;
1155                   case OMP_LIST_MULT: type = "*"; break;
1156                   case OMP_LIST_SUB: type = "-"; break;
1157                   case OMP_LIST_AND: type = ".AND."; break;
1158                   case OMP_LIST_OR: type = ".OR."; break;
1159                   case OMP_LIST_EQV: type = ".EQV."; break;
1160                   case OMP_LIST_NEQV: type = ".NEQV."; break;
1161                   case OMP_LIST_MAX: type = "MAX"; break;
1162                   case OMP_LIST_MIN: type = "MIN"; break;
1163                   case OMP_LIST_IAND: type = "IAND"; break;
1164                   case OMP_LIST_IOR: type = "IOR"; break;
1165                   case OMP_LIST_IEOR: type = "IEOR"; break;
1166                   default:
1167                     gcc_unreachable ();
1168                   }
1169                 fprintf (dumpfile, " REDUCTION(%s:", type);
1170               }
1171             else
1172               {
1173                 switch (list_type)
1174                   {
1175                   case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
1176                   case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1177                   case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
1178                   case OMP_LIST_SHARED: type = "SHARED"; break;
1179                   case OMP_LIST_COPYIN: type = "COPYIN"; break;
1180                   default:
1181                     gcc_unreachable ();
1182                   }
1183                 fprintf (dumpfile, " %s(", type);
1184               }
1185             show_namelist (omp_clauses->lists[list_type]);
1186             fputc (')', dumpfile);
1187           }
1188     }
1189   fputc ('\n', dumpfile);
1190   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
1191     {
1192       gfc_code *d = c->block;
1193       while (d != NULL)
1194         {
1195           show_code (level + 1, d->next);
1196           if (d->block == NULL)
1197             break;
1198           code_indent (level, 0);
1199           fputs ("!$OMP SECTION\n", dumpfile);
1200           d = d->block;
1201         }
1202     }
1203   else
1204     show_code (level + 1, c->block->next);
1205   if (c->op == EXEC_OMP_ATOMIC)
1206     return;
1207   code_indent (level, 0);
1208   fprintf (dumpfile, "!$OMP END %s", name);
1209   if (omp_clauses != NULL)
1210     {
1211       if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
1212         {
1213           fputs (" COPYPRIVATE(", dumpfile);
1214           show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
1215           fputc (')', dumpfile);
1216         }
1217       else if (omp_clauses->nowait)
1218         fputs (" NOWAIT", dumpfile);
1219     }
1220   else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
1221     fprintf (dumpfile, " (%s)", c->ext.omp_name);
1222 }
1223
1224
1225 /* Show a single code node and everything underneath it if necessary.  */
1226
1227 static void
1228 show_code_node (int level, gfc_code *c)
1229 {
1230   gfc_forall_iterator *fa;
1231   gfc_open *open;
1232   gfc_case *cp;
1233   gfc_alloc *a;
1234   gfc_code *d;
1235   gfc_close *close;
1236   gfc_filepos *fp;
1237   gfc_inquire *i;
1238   gfc_dt *dt;
1239   gfc_namespace *ns;
1240
1241   if (c->here)
1242     {
1243       fputc ('\n', dumpfile);
1244       code_indent (level, c->here);
1245     }
1246   else
1247     show_indent ();
1248
1249   switch (c->op)
1250     {
1251     case EXEC_END_PROCEDURE:
1252       break;
1253
1254     case EXEC_NOP:
1255       fputs ("NOP", dumpfile);
1256       break;
1257
1258     case EXEC_CONTINUE:
1259       fputs ("CONTINUE", dumpfile);
1260       break;
1261
1262     case EXEC_ENTRY:
1263       fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
1264       break;
1265
1266     case EXEC_INIT_ASSIGN:
1267     case EXEC_ASSIGN:
1268       fputs ("ASSIGN ", dumpfile);
1269       show_expr (c->expr1);
1270       fputc (' ', dumpfile);
1271       show_expr (c->expr2);
1272       break;
1273
1274     case EXEC_LABEL_ASSIGN:
1275       fputs ("LABEL ASSIGN ", dumpfile);
1276       show_expr (c->expr1);
1277       fprintf (dumpfile, " %d", c->label1->value);
1278       break;
1279
1280     case EXEC_POINTER_ASSIGN:
1281       fputs ("POINTER ASSIGN ", dumpfile);
1282       show_expr (c->expr1);
1283       fputc (' ', dumpfile);
1284       show_expr (c->expr2);
1285       break;
1286
1287     case EXEC_GOTO:
1288       fputs ("GOTO ", dumpfile);
1289       if (c->label1)
1290         fprintf (dumpfile, "%d", c->label1->value);
1291       else
1292         {
1293           show_expr (c->expr1);
1294           d = c->block;
1295           if (d != NULL)
1296             {
1297               fputs (", (", dumpfile);
1298               for (; d; d = d ->block)
1299                 {
1300                   code_indent (level, d->label1);
1301                   if (d->block != NULL)
1302                     fputc (',', dumpfile);
1303                   else
1304                     fputc (')', dumpfile);
1305                 }
1306             }
1307         }
1308       break;
1309
1310     case EXEC_CALL:
1311     case EXEC_ASSIGN_CALL:
1312       if (c->resolved_sym)
1313         fprintf (dumpfile, "CALL %s ", c->resolved_sym->name);
1314       else if (c->symtree)
1315         fprintf (dumpfile, "CALL %s ", c->symtree->name);
1316       else
1317         fputs ("CALL ?? ", dumpfile);
1318
1319       show_actual_arglist (c->ext.actual);
1320       break;
1321
1322     case EXEC_COMPCALL:
1323       fputs ("CALL ", dumpfile);
1324       show_compcall (c->expr1);
1325       break;
1326
1327     case EXEC_CALL_PPC:
1328       fputs ("CALL ", dumpfile);
1329       show_expr (c->expr1);
1330       show_actual_arglist (c->ext.actual);
1331       break;
1332
1333     case EXEC_RETURN:
1334       fputs ("RETURN ", dumpfile);
1335       if (c->expr1)
1336         show_expr (c->expr1);
1337       break;
1338
1339     case EXEC_PAUSE:
1340       fputs ("PAUSE ", dumpfile);
1341
1342       if (c->expr1 != NULL)
1343         show_expr (c->expr1);
1344       else
1345         fprintf (dumpfile, "%d", c->ext.stop_code);
1346
1347       break;
1348
1349     case EXEC_ERROR_STOP:
1350       fputs ("ERROR ", dumpfile);
1351       /* Fall through.  */
1352
1353     case EXEC_STOP:
1354       fputs ("STOP ", dumpfile);
1355
1356       if (c->expr1 != NULL)
1357         show_expr (c->expr1);
1358       else
1359         fprintf (dumpfile, "%d", c->ext.stop_code);
1360
1361       break;
1362
1363     case EXEC_SYNC_ALL:
1364       fputs ("SYNC ALL ", dumpfile);
1365       if (c->expr2 != NULL)
1366         {
1367           fputs (" stat=", dumpfile);
1368           show_expr (c->expr2);
1369         }
1370       if (c->expr3 != NULL)
1371         {
1372           fputs (" errmsg=", dumpfile);
1373           show_expr (c->expr3);
1374         }
1375       break;
1376
1377     case EXEC_SYNC_MEMORY:
1378       fputs ("SYNC MEMORY ", dumpfile);
1379       if (c->expr2 != NULL)
1380         {
1381           fputs (" stat=", dumpfile);
1382           show_expr (c->expr2);
1383         }
1384       if (c->expr3 != NULL)
1385         {
1386           fputs (" errmsg=", dumpfile);
1387           show_expr (c->expr3);
1388         }
1389       break;
1390
1391     case EXEC_SYNC_IMAGES:
1392       fputs ("SYNC IMAGES  image-set=", dumpfile);
1393       if (c->expr1 != NULL)
1394         show_expr (c->expr1);
1395       else
1396         fputs ("* ", dumpfile);
1397       if (c->expr2 != NULL)
1398         {
1399           fputs (" stat=", dumpfile);
1400           show_expr (c->expr2);
1401         }
1402       if (c->expr3 != NULL)
1403         {
1404           fputs (" errmsg=", dumpfile);
1405           show_expr (c->expr3);
1406         }
1407       break;
1408
1409     case EXEC_LOCK:
1410     case EXEC_UNLOCK:
1411       if (c->op == EXEC_LOCK)
1412         fputs ("LOCK ", dumpfile);
1413       else
1414         fputs ("UNLOCK ", dumpfile);
1415
1416       fputs ("lock-variable=", dumpfile);
1417       if (c->expr1 != NULL)
1418         show_expr (c->expr1);
1419       if (c->expr4 != NULL)
1420         {
1421           fputs (" acquired_lock=", dumpfile);
1422           show_expr (c->expr4);
1423         }
1424       if (c->expr2 != NULL)
1425         {
1426           fputs (" stat=", dumpfile);
1427           show_expr (c->expr2);
1428         }
1429       if (c->expr3 != NULL)
1430         {
1431           fputs (" errmsg=", dumpfile);
1432           show_expr (c->expr3);
1433         }
1434       break;
1435
1436     case EXEC_ARITHMETIC_IF:
1437       fputs ("IF ", dumpfile);
1438       show_expr (c->expr1);
1439       fprintf (dumpfile, " %d, %d, %d",
1440                   c->label1->value, c->label2->value, c->label3->value);
1441       break;
1442
1443     case EXEC_IF:
1444       d = c->block;
1445       fputs ("IF ", dumpfile);
1446       show_expr (d->expr1);
1447
1448       ++show_level;
1449       show_code (level + 1, d->next);
1450       --show_level;
1451
1452       d = d->block;
1453       for (; d; d = d->block)
1454         {
1455           code_indent (level, 0);
1456
1457           if (d->expr1 == NULL)
1458             fputs ("ELSE", dumpfile);
1459           else
1460             {
1461               fputs ("ELSE IF ", dumpfile);
1462               show_expr (d->expr1);
1463             }
1464
1465           ++show_level;
1466           show_code (level + 1, d->next);
1467           --show_level;
1468         }
1469
1470       if (c->label1)
1471         code_indent (level, c->label1);
1472       else
1473         show_indent ();
1474
1475       fputs ("ENDIF", dumpfile);
1476       break;
1477
1478     case EXEC_BLOCK:
1479       {
1480         const char* blocktype;
1481         gfc_namespace *saved_ns;
1482
1483         if (c->ext.block.assoc)
1484           blocktype = "ASSOCIATE";
1485         else
1486           blocktype = "BLOCK";
1487         show_indent ();
1488         fprintf (dumpfile, "%s ", blocktype);
1489         ++show_level;
1490         ns = c->ext.block.ns;
1491         saved_ns = gfc_current_ns;
1492         gfc_current_ns = ns;
1493         gfc_traverse_symtree (ns->sym_root, show_symtree);
1494         gfc_current_ns = saved_ns;
1495         show_code (show_level, ns->code);
1496         --show_level;
1497         show_indent ();
1498         fprintf (dumpfile, "END %s ", blocktype);
1499         break;
1500       }
1501
1502     case EXEC_SELECT:
1503       d = c->block;
1504       fputs ("SELECT CASE ", dumpfile);
1505       show_expr (c->expr1);
1506       fputc ('\n', dumpfile);
1507
1508       for (; d; d = d->block)
1509         {
1510           code_indent (level, 0);
1511
1512           fputs ("CASE ", dumpfile);
1513           for (cp = d->ext.block.case_list; cp; cp = cp->next)
1514             {
1515               fputc ('(', dumpfile);
1516               show_expr (cp->low);
1517               fputc (' ', dumpfile);
1518               show_expr (cp->high);
1519               fputc (')', dumpfile);
1520               fputc (' ', dumpfile);
1521             }
1522           fputc ('\n', dumpfile);
1523
1524           show_code (level + 1, d->next);
1525         }
1526
1527       code_indent (level, c->label1);
1528       fputs ("END SELECT", dumpfile);
1529       break;
1530
1531     case EXEC_WHERE:
1532       fputs ("WHERE ", dumpfile);
1533
1534       d = c->block;
1535       show_expr (d->expr1);
1536       fputc ('\n', dumpfile);
1537
1538       show_code (level + 1, d->next);
1539
1540       for (d = d->block; d; d = d->block)
1541         {
1542           code_indent (level, 0);
1543           fputs ("ELSE WHERE ", dumpfile);
1544           show_expr (d->expr1);
1545           fputc ('\n', dumpfile);
1546           show_code (level + 1, d->next);
1547         }
1548
1549       code_indent (level, 0);
1550       fputs ("END WHERE", dumpfile);
1551       break;
1552
1553
1554     case EXEC_FORALL:
1555       fputs ("FORALL ", dumpfile);
1556       for (fa = c->ext.forall_iterator; fa; fa = fa->next)
1557         {
1558           show_expr (fa->var);
1559           fputc (' ', dumpfile);
1560           show_expr (fa->start);
1561           fputc (':', dumpfile);
1562           show_expr (fa->end);
1563           fputc (':', dumpfile);
1564           show_expr (fa->stride);
1565
1566           if (fa->next != NULL)
1567             fputc (',', dumpfile);
1568         }
1569
1570       if (c->expr1 != NULL)
1571         {
1572           fputc (',', dumpfile);
1573           show_expr (c->expr1);
1574         }
1575       fputc ('\n', dumpfile);
1576
1577       show_code (level + 1, c->block->next);
1578
1579       code_indent (level, 0);
1580       fputs ("END FORALL", dumpfile);
1581       break;
1582
1583     case EXEC_CRITICAL:
1584       fputs ("CRITICAL\n", dumpfile);
1585       show_code (level + 1, c->block->next);
1586       code_indent (level, 0);
1587       fputs ("END CRITICAL", dumpfile);
1588       break;
1589
1590     case EXEC_DO:
1591       fputs ("DO ", dumpfile);
1592       if (c->label1)
1593         fprintf (dumpfile, " %-5d ", c->label1->value);
1594
1595       show_expr (c->ext.iterator->var);
1596       fputc ('=', dumpfile);
1597       show_expr (c->ext.iterator->start);
1598       fputc (' ', dumpfile);
1599       show_expr (c->ext.iterator->end);
1600       fputc (' ', dumpfile);
1601       show_expr (c->ext.iterator->step);
1602
1603       ++show_level;
1604       show_code (level + 1, c->block->next);
1605       --show_level;
1606
1607       if (c->label1)
1608         break;
1609
1610       show_indent ();
1611       fputs ("END DO", dumpfile);
1612       break;
1613
1614     case EXEC_DO_CONCURRENT:
1615       fputs ("DO CONCURRENT ", dumpfile);
1616       for (fa = c->ext.forall_iterator; fa; fa = fa->next)
1617         {
1618           show_expr (fa->var);
1619           fputc (' ', dumpfile);
1620           show_expr (fa->start);
1621           fputc (':', dumpfile);
1622           show_expr (fa->end);
1623           fputc (':', dumpfile);
1624           show_expr (fa->stride);
1625
1626           if (fa->next != NULL)
1627             fputc (',', dumpfile);
1628         }
1629       show_expr (c->expr1);
1630
1631       show_code (level + 1, c->block->next);
1632       code_indent (level, c->label1);
1633       fputs ("END DO", dumpfile);
1634       break;
1635
1636     case EXEC_DO_WHILE:
1637       fputs ("DO WHILE ", dumpfile);
1638       show_expr (c->expr1);
1639       fputc ('\n', dumpfile);
1640
1641       show_code (level + 1, c->block->next);
1642
1643       code_indent (level, c->label1);
1644       fputs ("END DO", dumpfile);
1645       break;
1646
1647     case EXEC_CYCLE:
1648       fputs ("CYCLE", dumpfile);
1649       if (c->symtree)
1650         fprintf (dumpfile, " %s", c->symtree->n.sym->name);
1651       break;
1652
1653     case EXEC_EXIT:
1654       fputs ("EXIT", dumpfile);
1655       if (c->symtree)
1656         fprintf (dumpfile, " %s", c->symtree->n.sym->name);
1657       break;
1658
1659     case EXEC_ALLOCATE:
1660       fputs ("ALLOCATE ", dumpfile);
1661       if (c->expr1)
1662         {
1663           fputs (" STAT=", dumpfile);
1664           show_expr (c->expr1);
1665         }
1666
1667       if (c->expr2)
1668         {
1669           fputs (" ERRMSG=", dumpfile);
1670           show_expr (c->expr2);
1671         }
1672
1673       if (c->expr3)
1674         {
1675           if (c->expr3->mold)
1676             fputs (" MOLD=", dumpfile);
1677           else
1678             fputs (" SOURCE=", dumpfile);
1679           show_expr (c->expr3);
1680         }
1681
1682       for (a = c->ext.alloc.list; a; a = a->next)
1683         {
1684           fputc (' ', dumpfile);
1685           show_expr (a->expr);
1686         }
1687
1688       break;
1689
1690     case EXEC_DEALLOCATE:
1691       fputs ("DEALLOCATE ", dumpfile);
1692       if (c->expr1)
1693         {
1694           fputs (" STAT=", dumpfile);
1695           show_expr (c->expr1);
1696         }
1697
1698       if (c->expr2)
1699         {
1700           fputs (" ERRMSG=", dumpfile);
1701           show_expr (c->expr2);
1702         }
1703
1704       for (a = c->ext.alloc.list; a; a = a->next)
1705         {
1706           fputc (' ', dumpfile);
1707           show_expr (a->expr);
1708         }
1709
1710       break;
1711
1712     case EXEC_OPEN:
1713       fputs ("OPEN", dumpfile);
1714       open = c->ext.open;
1715
1716       if (open->unit)
1717         {
1718           fputs (" UNIT=", dumpfile);
1719           show_expr (open->unit);
1720         }
1721       if (open->iomsg)
1722         {
1723           fputs (" IOMSG=", dumpfile);
1724           show_expr (open->iomsg);
1725         }
1726       if (open->iostat)
1727         {
1728           fputs (" IOSTAT=", dumpfile);
1729           show_expr (open->iostat);
1730         }
1731       if (open->file)
1732         {
1733           fputs (" FILE=", dumpfile);
1734           show_expr (open->file);
1735         }
1736       if (open->status)
1737         {
1738           fputs (" STATUS=", dumpfile);
1739           show_expr (open->status);
1740         }
1741       if (open->access)
1742         {
1743           fputs (" ACCESS=", dumpfile);
1744           show_expr (open->access);
1745         }
1746       if (open->form)
1747         {
1748           fputs (" FORM=", dumpfile);
1749           show_expr (open->form);
1750         }
1751       if (open->recl)
1752         {
1753           fputs (" RECL=", dumpfile);
1754           show_expr (open->recl);
1755         }
1756       if (open->blank)
1757         {
1758           fputs (" BLANK=", dumpfile);
1759           show_expr (open->blank);
1760         }
1761       if (open->position)
1762         {
1763           fputs (" POSITION=", dumpfile);
1764           show_expr (open->position);
1765         }
1766       if (open->action)
1767         {
1768           fputs (" ACTION=", dumpfile);
1769           show_expr (open->action);
1770         }
1771       if (open->delim)
1772         {
1773           fputs (" DELIM=", dumpfile);
1774           show_expr (open->delim);
1775         }
1776       if (open->pad)
1777         {
1778           fputs (" PAD=", dumpfile);
1779           show_expr (open->pad);
1780         }
1781       if (open->decimal)
1782         {
1783           fputs (" DECIMAL=", dumpfile);
1784           show_expr (open->decimal);
1785         }
1786       if (open->encoding)
1787         {
1788           fputs (" ENCODING=", dumpfile);
1789           show_expr (open->encoding);
1790         }
1791       if (open->round)
1792         {
1793           fputs (" ROUND=", dumpfile);
1794           show_expr (open->round);
1795         }
1796       if (open->sign)
1797         {
1798           fputs (" SIGN=", dumpfile);
1799           show_expr (open->sign);
1800         }
1801       if (open->convert)
1802         {
1803           fputs (" CONVERT=", dumpfile);
1804           show_expr (open->convert);
1805         }
1806       if (open->asynchronous)
1807         {
1808           fputs (" ASYNCHRONOUS=", dumpfile);
1809           show_expr (open->asynchronous);
1810         }
1811       if (open->err != NULL)
1812         fprintf (dumpfile, " ERR=%d", open->err->value);
1813
1814       break;
1815
1816     case EXEC_CLOSE:
1817       fputs ("CLOSE", dumpfile);
1818       close = c->ext.close;
1819
1820       if (close->unit)
1821         {
1822           fputs (" UNIT=", dumpfile);
1823           show_expr (close->unit);
1824         }
1825       if (close->iomsg)
1826         {
1827           fputs (" IOMSG=", dumpfile);
1828           show_expr (close->iomsg);
1829         }
1830       if (close->iostat)
1831         {
1832           fputs (" IOSTAT=", dumpfile);
1833           show_expr (close->iostat);
1834         }
1835       if (close->status)
1836         {
1837           fputs (" STATUS=", dumpfile);
1838           show_expr (close->status);
1839         }
1840       if (close->err != NULL)
1841         fprintf (dumpfile, " ERR=%d", close->err->value);
1842       break;
1843
1844     case EXEC_BACKSPACE:
1845       fputs ("BACKSPACE", dumpfile);
1846       goto show_filepos;
1847
1848     case EXEC_ENDFILE:
1849       fputs ("ENDFILE", dumpfile);
1850       goto show_filepos;
1851
1852     case EXEC_REWIND:
1853       fputs ("REWIND", dumpfile);
1854       goto show_filepos;
1855
1856     case EXEC_FLUSH:
1857       fputs ("FLUSH", dumpfile);
1858
1859     show_filepos:
1860       fp = c->ext.filepos;
1861
1862       if (fp->unit)
1863         {
1864           fputs (" UNIT=", dumpfile);
1865           show_expr (fp->unit);
1866         }
1867       if (fp->iomsg)
1868         {
1869           fputs (" IOMSG=", dumpfile);
1870           show_expr (fp->iomsg);
1871         }
1872       if (fp->iostat)
1873         {
1874           fputs (" IOSTAT=", dumpfile);
1875           show_expr (fp->iostat);
1876         }
1877       if (fp->err != NULL)
1878         fprintf (dumpfile, " ERR=%d", fp->err->value);
1879       break;
1880
1881     case EXEC_INQUIRE:
1882       fputs ("INQUIRE", dumpfile);
1883       i = c->ext.inquire;
1884
1885       if (i->unit)
1886         {
1887           fputs (" UNIT=", dumpfile);
1888           show_expr (i->unit);
1889         }
1890       if (i->file)
1891         {
1892           fputs (" FILE=", dumpfile);
1893           show_expr (i->file);
1894         }
1895
1896       if (i->iomsg)
1897         {
1898           fputs (" IOMSG=", dumpfile);
1899           show_expr (i->iomsg);
1900         }
1901       if (i->iostat)
1902         {
1903           fputs (" IOSTAT=", dumpfile);
1904           show_expr (i->iostat);
1905         }
1906       if (i->exist)
1907         {
1908           fputs (" EXIST=", dumpfile);
1909           show_expr (i->exist);
1910         }
1911       if (i->opened)
1912         {
1913           fputs (" OPENED=", dumpfile);
1914           show_expr (i->opened);
1915         }
1916       if (i->number)
1917         {
1918           fputs (" NUMBER=", dumpfile);
1919           show_expr (i->number);
1920         }
1921       if (i->named)
1922         {
1923           fputs (" NAMED=", dumpfile);
1924           show_expr (i->named);
1925         }
1926       if (i->name)
1927         {
1928           fputs (" NAME=", dumpfile);
1929           show_expr (i->name);
1930         }
1931       if (i->access)
1932         {
1933           fputs (" ACCESS=", dumpfile);
1934           show_expr (i->access);
1935         }
1936       if (i->sequential)
1937         {
1938           fputs (" SEQUENTIAL=", dumpfile);
1939           show_expr (i->sequential);
1940         }
1941
1942       if (i->direct)
1943         {
1944           fputs (" DIRECT=", dumpfile);
1945           show_expr (i->direct);
1946         }
1947       if (i->form)
1948         {
1949           fputs (" FORM=", dumpfile);
1950           show_expr (i->form);
1951         }
1952       if (i->formatted)
1953         {
1954           fputs (" FORMATTED", dumpfile);
1955           show_expr (i->formatted);
1956         }
1957       if (i->unformatted)
1958         {
1959           fputs (" UNFORMATTED=", dumpfile);
1960           show_expr (i->unformatted);
1961         }
1962       if (i->recl)
1963         {
1964           fputs (" RECL=", dumpfile);
1965           show_expr (i->recl);
1966         }
1967       if (i->nextrec)
1968         {
1969           fputs (" NEXTREC=", dumpfile);
1970           show_expr (i->nextrec);
1971         }
1972       if (i->blank)
1973         {
1974           fputs (" BLANK=", dumpfile);
1975           show_expr (i->blank);
1976         }
1977       if (i->position)
1978         {
1979           fputs (" POSITION=", dumpfile);
1980           show_expr (i->position);
1981         }
1982       if (i->action)
1983         {
1984           fputs (" ACTION=", dumpfile);
1985           show_expr (i->action);
1986         }
1987       if (i->read)
1988         {
1989           fputs (" READ=", dumpfile);
1990           show_expr (i->read);
1991         }
1992       if (i->write)
1993         {
1994           fputs (" WRITE=", dumpfile);
1995           show_expr (i->write);
1996         }
1997       if (i->readwrite)
1998         {
1999           fputs (" READWRITE=", dumpfile);
2000           show_expr (i->readwrite);
2001         }
2002       if (i->delim)
2003         {
2004           fputs (" DELIM=", dumpfile);
2005           show_expr (i->delim);
2006         }
2007       if (i->pad)
2008         {
2009           fputs (" PAD=", dumpfile);
2010           show_expr (i->pad);
2011         }
2012       if (i->convert)
2013         {
2014           fputs (" CONVERT=", dumpfile);
2015           show_expr (i->convert);
2016         }
2017       if (i->asynchronous)
2018         {
2019           fputs (" ASYNCHRONOUS=", dumpfile);
2020           show_expr (i->asynchronous);
2021         }
2022       if (i->decimal)
2023         {
2024           fputs (" DECIMAL=", dumpfile);
2025           show_expr (i->decimal);
2026         }
2027       if (i->encoding)
2028         {
2029           fputs (" ENCODING=", dumpfile);
2030           show_expr (i->encoding);
2031         }
2032       if (i->pending)
2033         {
2034           fputs (" PENDING=", dumpfile);
2035           show_expr (i->pending);
2036         }
2037       if (i->round)
2038         {
2039           fputs (" ROUND=", dumpfile);
2040           show_expr (i->round);
2041         }
2042       if (i->sign)
2043         {
2044           fputs (" SIGN=", dumpfile);
2045           show_expr (i->sign);
2046         }
2047       if (i->size)
2048         {
2049           fputs (" SIZE=", dumpfile);
2050           show_expr (i->size);
2051         }
2052       if (i->id)
2053         {
2054           fputs (" ID=", dumpfile);
2055           show_expr (i->id);
2056         }
2057
2058       if (i->err != NULL)
2059         fprintf (dumpfile, " ERR=%d", i->err->value);
2060       break;
2061
2062     case EXEC_IOLENGTH:
2063       fputs ("IOLENGTH ", dumpfile);
2064       show_expr (c->expr1);
2065       goto show_dt_code;
2066       break;
2067
2068     case EXEC_READ:
2069       fputs ("READ", dumpfile);
2070       goto show_dt;
2071
2072     case EXEC_WRITE:
2073       fputs ("WRITE", dumpfile);
2074
2075     show_dt:
2076       dt = c->ext.dt;
2077       if (dt->io_unit)
2078         {
2079           fputs (" UNIT=", dumpfile);
2080           show_expr (dt->io_unit);
2081         }
2082
2083       if (dt->format_expr)
2084         {
2085           fputs (" FMT=", dumpfile);
2086           show_expr (dt->format_expr);
2087         }
2088
2089       if (dt->format_label != NULL)
2090         fprintf (dumpfile, " FMT=%d", dt->format_label->value);
2091       if (dt->namelist)
2092         fprintf (dumpfile, " NML=%s", dt->namelist->name);
2093
2094       if (dt->iomsg)
2095         {
2096           fputs (" IOMSG=", dumpfile);
2097           show_expr (dt->iomsg);
2098         }
2099       if (dt->iostat)
2100         {
2101           fputs (" IOSTAT=", dumpfile);
2102           show_expr (dt->iostat);
2103         }
2104       if (dt->size)
2105         {
2106           fputs (" SIZE=", dumpfile);
2107           show_expr (dt->size);
2108         }
2109       if (dt->rec)
2110         {
2111           fputs (" REC=", dumpfile);
2112           show_expr (dt->rec);
2113         }
2114       if (dt->advance)
2115         {
2116           fputs (" ADVANCE=", dumpfile);
2117           show_expr (dt->advance);
2118         }
2119       if (dt->id)
2120         {
2121           fputs (" ID=", dumpfile);
2122           show_expr (dt->id);
2123         }
2124       if (dt->pos)
2125         {
2126           fputs (" POS=", dumpfile);
2127           show_expr (dt->pos);
2128         }
2129       if (dt->asynchronous)
2130         {
2131           fputs (" ASYNCHRONOUS=", dumpfile);
2132           show_expr (dt->asynchronous);
2133         }
2134       if (dt->blank)
2135         {
2136           fputs (" BLANK=", dumpfile);
2137           show_expr (dt->blank);
2138         }
2139       if (dt->decimal)
2140         {
2141           fputs (" DECIMAL=", dumpfile);
2142           show_expr (dt->decimal);
2143         }
2144       if (dt->delim)
2145         {
2146           fputs (" DELIM=", dumpfile);
2147           show_expr (dt->delim);
2148         }
2149       if (dt->pad)
2150         {
2151           fputs (" PAD=", dumpfile);
2152           show_expr (dt->pad);
2153         }
2154       if (dt->round)
2155         {
2156           fputs (" ROUND=", dumpfile);
2157           show_expr (dt->round);
2158         }
2159       if (dt->sign)
2160         {
2161           fputs (" SIGN=", dumpfile);
2162           show_expr (dt->sign);
2163         }
2164
2165     show_dt_code:
2166       for (c = c->block->next; c; c = c->next)
2167         show_code_node (level + (c->next != NULL), c);
2168       return;
2169
2170     case EXEC_TRANSFER:
2171       fputs ("TRANSFER ", dumpfile);
2172       show_expr (c->expr1);
2173       break;
2174
2175     case EXEC_DT_END:
2176       fputs ("DT_END", dumpfile);
2177       dt = c->ext.dt;
2178
2179       if (dt->err != NULL)
2180         fprintf (dumpfile, " ERR=%d", dt->err->value);
2181       if (dt->end != NULL)
2182         fprintf (dumpfile, " END=%d", dt->end->value);
2183       if (dt->eor != NULL)
2184         fprintf (dumpfile, " EOR=%d", dt->eor->value);
2185       break;
2186
2187     case EXEC_OMP_ATOMIC:
2188     case EXEC_OMP_BARRIER:
2189     case EXEC_OMP_CRITICAL:
2190     case EXEC_OMP_FLUSH:
2191     case EXEC_OMP_DO:
2192     case EXEC_OMP_MASTER:
2193     case EXEC_OMP_ORDERED:
2194     case EXEC_OMP_PARALLEL:
2195     case EXEC_OMP_PARALLEL_DO:
2196     case EXEC_OMP_PARALLEL_SECTIONS:
2197     case EXEC_OMP_PARALLEL_WORKSHARE:
2198     case EXEC_OMP_SECTIONS:
2199     case EXEC_OMP_SINGLE:
2200     case EXEC_OMP_TASK:
2201     case EXEC_OMP_TASKWAIT:
2202     case EXEC_OMP_TASKYIELD:
2203     case EXEC_OMP_WORKSHARE:
2204       show_omp_node (level, c);
2205       break;
2206
2207     default:
2208       gfc_internal_error ("show_code_node(): Bad statement code");
2209     }
2210 }
2211
2212
2213 /* Show an equivalence chain.  */
2214
2215 static void
2216 show_equiv (gfc_equiv *eq)
2217 {
2218   show_indent ();
2219   fputs ("Equivalence: ", dumpfile);
2220   while (eq)
2221     {
2222       show_expr (eq->expr);
2223       eq = eq->eq;
2224       if (eq)
2225         fputs (", ", dumpfile);
2226     }
2227 }
2228
2229
2230 /* Show a freakin' whole namespace.  */
2231
2232 static void
2233 show_namespace (gfc_namespace *ns)
2234 {
2235   gfc_interface *intr;
2236   gfc_namespace *save;
2237   int op;
2238   gfc_equiv *eq;
2239   int i;
2240
2241   save = gfc_current_ns;
2242
2243   show_indent ();
2244   fputs ("Namespace:", dumpfile);
2245
2246   if (ns != NULL)
2247     {
2248       i = 0;
2249       do
2250         {
2251           int l = i;
2252           while (i < GFC_LETTERS - 1
2253                  && gfc_compare_types(&ns->default_type[i+1],
2254                                       &ns->default_type[l]))
2255             i++;
2256
2257           if (i > l)
2258             fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
2259           else
2260             fprintf (dumpfile, " %c: ", l+'A');
2261
2262           show_typespec(&ns->default_type[l]);
2263           i++;
2264       } while (i < GFC_LETTERS);
2265
2266       if (ns->proc_name != NULL)
2267         {
2268           show_indent ();
2269           fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
2270         }
2271
2272       ++show_level;
2273       gfc_current_ns = ns;
2274       gfc_traverse_symtree (ns->common_root, show_common);
2275
2276       gfc_traverse_symtree (ns->sym_root, show_symtree);
2277
2278       for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
2279         {
2280           /* User operator interfaces */
2281           intr = ns->op[op];
2282           if (intr == NULL)
2283             continue;
2284
2285           show_indent ();
2286           fprintf (dumpfile, "Operator interfaces for %s:",
2287                    gfc_op2string ((gfc_intrinsic_op) op));
2288
2289           for (; intr; intr = intr->next)
2290             fprintf (dumpfile, " %s", intr->sym->name);
2291         }
2292
2293       if (ns->uop_root != NULL)
2294         {
2295           show_indent ();
2296           fputs ("User operators:\n", dumpfile);
2297           gfc_traverse_user_op (ns, show_uop);
2298         }
2299     }
2300   else
2301     ++show_level;
2302
2303   for (eq = ns->equiv; eq; eq = eq->next)
2304     show_equiv (eq);
2305
2306   fputc ('\n', dumpfile);
2307   show_indent ();
2308   fputs ("code:", dumpfile);
2309   show_code (show_level, ns->code);
2310   --show_level;
2311
2312   for (ns = ns->contained; ns; ns = ns->sibling)
2313     {
2314       fputs ("\nCONTAINS\n", dumpfile);
2315       ++show_level;
2316       show_namespace (ns);
2317       --show_level;
2318     }
2319
2320   fputc ('\n', dumpfile);
2321   gfc_current_ns = save;
2322 }
2323
2324
2325 /* Main function for dumping a parse tree.  */
2326
2327 void
2328 gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
2329 {
2330   dumpfile = file;
2331   show_namespace (ns);
2332 }
2333