gcc/fortran/dump-parse-tree.c

   1 /* Parse tree dumper
   2    Copyright (C) 2003, 2004, 2005, 2006, 2007
   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 2, 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 COPYING.  If not, write to the Free
  20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
  21 02110-1301, USA.  */
  22
  23
  24 /* Actually this is just a collection of routines that used to be
  25    scattered around the sources.  Now that they are all in a single
  26    file, almost all of them can be static, and the other files don't
  27    have this mess in them.
  28
  29    As a nice side-effect, this file can act as documentation of the
  30    gfc_code and gfc_expr structures and all their friends and
  31    relatives.
  32
  33    TODO: Dump DATA.  */
  34
  35 #include "config.h"
  36 #include "gfortran.h"
  37
  38 /* Keep track of indentation for symbol tree dumps.  */
  39 static int show_level = 0;
  40
  41 /* Do indentation for a specific level.  */
  42
  43 static inline void
  44 code_indent (int level, gfc_st_label *label)
  45 {
  46   int i;
  47
  48   if (label != NULL)
  49     gfc_status ("%-5d ", label->value);
  50   else
  51     gfc_status ("      ");
  52
  53   for (i = 0; i < 2 * level; i++)
  54     gfc_status_char (' ');
  55 }
  56
  57
  58 /* Simple indentation at the current level.  This one
  59    is used to show symbols.  */
  60
  61 static inline void
  62 show_indent (void)
  63 {
  64   gfc_status ("\n");
  65   code_indent (show_level, NULL);
  66 }
  67
  68
  69 /* Show type-specific information.  */
  70
  71 void
  72 gfc_show_typespec (gfc_typespec *ts)
  73 {
  74   gfc_status ("(%s ", gfc_basic_typename (ts->type));
  75
  76   switch (ts->type)
  77     {
  78     case BT_DERIVED:
  79       gfc_status ("%s", ts->derived->name);
  80       break;
  81
  82     case BT_CHARACTER:
  83       gfc_show_expr (ts->cl->length);
  84       break;
  85
  86     default:
  87       gfc_status ("%d", ts->kind);
  88       break;
  89     }
  90
  91   gfc_status (")");
  92 }
  93
  94
  95 /* Show an actual argument list.  */
  96
  97 void
  98 gfc_show_actual_arglist (gfc_actual_arglist *a)
  99 {
 100   gfc_status ("(");
 101
 102   for (; a; a = a->next)
 103     {
 104       gfc_status_char ('(');
 105       if (a->name != NULL)
 106         gfc_status ("%s = ", a->name);
 107       if (a->expr != NULL)
 108         gfc_show_expr (a->expr);
 109       else
 110         gfc_status ("(arg not-present)");
 111
 112       gfc_status_char (')');
 113       if (a->next != NULL)
 114         gfc_status (" ");
 115     }
 116
 117   gfc_status (")");
 118 }
 119
 120
 121 /* Show a gfc_array_spec array specification structure.  */
 122
 123 void
 124 gfc_show_array_spec (gfc_array_spec *as)
 125 {
 126   const char *c;
 127   int i;
 128
 129   if (as == NULL)
 130     {
 131       gfc_status ("()");
 132       return;
 133     }
 134
 135   gfc_status ("(%d", as->rank);
 136
 137   if (as->rank != 0)
 138     {
 139       switch (as->type)
 140       {
 141         case AS_EXPLICIT:      c = "AS_EXPLICIT";      break;
 142         case AS_DEFERRED:      c = "AS_DEFERRED";      break;
 143         case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
 144         case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
 145         default:
 146           gfc_internal_error ("gfc_show_array_spec(): Unhandled array shape "
 147                               "type.");
 148       }
 149       gfc_status (" %s ", c);
 150
 151       for (i = 0; i < as->rank; i++)
 152         {
 153           gfc_show_expr (as->lower[i]);
 154           gfc_status_char (' ');
 155           gfc_show_expr (as->upper[i]);
 156           gfc_status_char (' ');
 157         }
 158     }
 159
 160   gfc_status (")");
 161 }
 162
 163
 164 /* Show a gfc_array_ref array reference structure.  */
 165
 166 void
 167 gfc_show_array_ref (gfc_array_ref * ar)
 168 {
 169   int i;
 170
 171   gfc_status_char ('(');
 172
 173   switch (ar->type)
 174     {
 175     case AR_FULL:
 176       gfc_status ("FULL");
 177       break;
 178
 179     case AR_SECTION:
 180       for (i = 0; i < ar->dimen; i++)
 181         {
 182           /* There are two types of array sections: either the
 183              elements are identified by an integer array ('vector'),
 184              or by an index range. In the former case we only have to
 185              print the start expression which contains the vector, in
 186              the latter case we have to print any of lower and upper
 187              bound and the stride, if they're present.  */
 188
 189           if (ar->start[i] != NULL)
 190             gfc_show_expr (ar->start[i]);
 191
 192           if (ar->dimen_type[i] == DIMEN_RANGE)
 193             {
 194               gfc_status_char (':');
 195
 196               if (ar->end[i] != NULL)
 197                 gfc_show_expr (ar->end[i]);
 198
 199               if (ar->stride[i] != NULL)
 200                 {
 201                   gfc_status_char (':');
 202                   gfc_show_expr (ar->stride[i]);
 203                 }
 204             }
 205
 206           if (i != ar->dimen - 1)
 207             gfc_status (" , ");
 208         }
 209       break;
 210
 211     case AR_ELEMENT:
 212       for (i = 0; i < ar->dimen; i++)
 213         {
 214           gfc_show_expr (ar->start[i]);
 215           if (i != ar->dimen - 1)
 216             gfc_status (" , ");
 217         }
 218       break;
 219
 220     case AR_UNKNOWN:
 221       gfc_status ("UNKNOWN");
 222       break;
 223
 224     default:
 225       gfc_internal_error ("gfc_show_array_ref(): Unknown array reference");
 226     }
 227
 228   gfc_status_char (')');
 229 }
 230
 231
 232 /* Show a list of gfc_ref structures.  */
 233
 234 void
 235 gfc_show_ref (gfc_ref *p)
 236 {
 237   for (; p; p = p->next)
 238     switch (p->type)
 239       {
 240       case REF_ARRAY:
 241         gfc_show_array_ref (&p->u.ar);
 242         break;
 243
 244       case REF_COMPONENT:
 245         gfc_status (" %% %s", p->u.c.component->name);
 246         break;
 247
 248       case REF_SUBSTRING:
 249         gfc_status_char ('(');
 250         gfc_show_expr (p->u.ss.start);
 251         gfc_status_char (':');
 252         gfc_show_expr (p->u.ss.end);
 253         gfc_status_char (')');
 254         break;
 255
 256       default:
 257         gfc_internal_error ("gfc_show_ref(): Bad component code");
 258       }
 259 }
 260
 261
 262 /* Display a constructor.  Works recursively for array constructors.  */
 263
 264 void
 265 gfc_show_constructor (gfc_constructor *c)
 266 {
 267   for (; c; c = c->next)
 268     {
 269       if (c->iterator == NULL)
 270         gfc_show_expr (c->expr);
 271       else
 272         {
 273           gfc_status_char ('(');
 274           gfc_show_expr (c->expr);
 275
 276           gfc_status_char (' ');
 277           gfc_show_expr (c->iterator->var);
 278           gfc_status_char ('=');
 279           gfc_show_expr (c->iterator->start);
 280           gfc_status_char (',');
 281           gfc_show_expr (c->iterator->end);
 282           gfc_status_char (',');
 283           gfc_show_expr (c->iterator->step);
 284
 285           gfc_status_char (')');
 286         }
 287
 288       if (c->next != NULL)
 289         gfc_status (" , ");
 290     }
 291 }
 292
 293
 294 /* Show an expression.  */
 295
 296 void
 297 gfc_show_expr (gfc_expr *p)
 298 {
 299   const char *c;
 300   int i;
 301
 302   if (p == NULL)
 303     {
 304       gfc_status ("()");
 305       return;
 306     }
 307
 308   switch (p->expr_type)
 309     {
 310     case EXPR_SUBSTRING:
 311       c = p->value.character.string;
 312
 313       for (i = 0; i < p->value.character.length; i++, c++)
 314         {
 315           if (*c == '\'')
 316             gfc_status ("''");
 317           else
 318             gfc_status ("%c", *c);
 319         }
 320
 321       gfc_show_ref (p->ref);
 322       break;
 323
 324     case EXPR_STRUCTURE:
 325       gfc_status ("%s(", p->ts.derived->name);
 326       gfc_show_constructor (p->value.constructor);
 327       gfc_status_char (')');
 328       break;
 329
 330     case EXPR_ARRAY:
 331       gfc_status ("(/ ");
 332       gfc_show_constructor (p->value.constructor);
 333       gfc_status (" /)");
 334
 335       gfc_show_ref (p->ref);
 336       break;
 337
 338     case EXPR_NULL:
 339       gfc_status ("NULL()");
 340       break;
 341
 342     case EXPR_CONSTANT:
 343       switch (p->ts.type)
 344         {
 345         case BT_INTEGER:
 346           mpz_out_str (stdout, 10, p->value.integer);
 347
 348           if (p->ts.kind != gfc_default_integer_kind)
 349             gfc_status ("_%d", p->ts.kind);
 350           break;
 351
 352         case BT_LOGICAL:
 353           if (p->value.logical)
 354             gfc_status (".true.");
 355           else
 356             gfc_status (".false.");
 357           break;
 358
 359         case BT_REAL:
 360           mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
 361           if (p->ts.kind != gfc_default_real_kind)
 362             gfc_status ("_%d", p->ts.kind);
 363           break;
 364
 365         case BT_CHARACTER:
 366           c = p->value.character.string;
 367
 368           gfc_status_char ('\'');
 369
 370           for (i = 0; i < p->value.character.length; i++, c++)
 371             {
 372               if (*c == '\'')
 373                 gfc_status ("''");
 374               else
 375                 gfc_status_char (*c);
 376             }
 377
 378           gfc_status_char ('\'');
 379
 380           break;
 381
 382         case BT_COMPLEX:
 383           gfc_status ("(complex ");
 384
 385           mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE);
 386           if (p->ts.kind != gfc_default_complex_kind)
 387             gfc_status ("_%d", p->ts.kind);
 388
 389           gfc_status (" ");
 390
 391           mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE);
 392           if (p->ts.kind != gfc_default_complex_kind)
 393             gfc_status ("_%d", p->ts.kind);
 394
 395           gfc_status (")");
 396           break;
 397
 398         case BT_HOLLERITH:
 399           gfc_status ("%dH", p->representation.length);
 400           c = p->representation.string;
 401           for (i = 0; i < p->representation.length; i++, c++)
 402             {
 403               gfc_status_char (*c);
 404             }
 405           break;
 406
 407         default:
 408           gfc_status ("???");
 409           break;
 410         }
 411
 412       if (p->representation.string)
 413         {
 414           gfc_status (" {");
 415           c = p->representation.string;
 416           for (i = 0; i < p->representation.length; i++, c++)
 417             {
 418               gfc_status ("%.2x", (unsigned int) *c);
 419               if (i < p->representation.length - 1)
 420                 gfc_status_char (',');
 421             }
 422           gfc_status_char ('}');
 423         }
 424
 425       break;
 426
 427     case EXPR_VARIABLE:
 428       if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
 429         gfc_status ("%s:", p->symtree->n.sym->ns->proc_name->name);
 430       gfc_status ("%s", p->symtree->n.sym->name);
 431       gfc_show_ref (p->ref);
 432       break;
 433
 434     case EXPR_OP:
 435       gfc_status ("(");
 436       switch (p->value.op.operator)
 437         {
 438         case INTRINSIC_UPLUS:
 439           gfc_status ("U+ ");
 440           break;
 441         case INTRINSIC_UMINUS:
 442           gfc_status ("U- ");
 443           break;
 444         case INTRINSIC_PLUS:
 445           gfc_status ("+ ");
 446           break;
 447         case INTRINSIC_MINUS:
 448           gfc_status ("- ");
 449           break;
 450         case INTRINSIC_TIMES:
 451           gfc_status ("* ");
 452           break;
 453         case INTRINSIC_DIVIDE:
 454           gfc_status ("/ ");
 455           break;
 456         case INTRINSIC_POWER:
 457           gfc_status ("** ");
 458           break;
 459         case INTRINSIC_CONCAT:
 460           gfc_status ("// ");
 461           break;
 462         case INTRINSIC_AND:
 463           gfc_status ("AND ");
 464           break;
 465         case INTRINSIC_OR:
 466           gfc_status ("OR ");
 467           break;
 468         case INTRINSIC_EQV:
 469           gfc_status ("EQV ");
 470           break;
 471         case INTRINSIC_NEQV:
 472           gfc_status ("NEQV ");
 473           break;
 474         case INTRINSIC_EQ:
 475         case INTRINSIC_EQ_OS:
 476           gfc_status ("= ");
 477           break;
 478         case INTRINSIC_NE:
 479         case INTRINSIC_NE_OS:
 480           gfc_status ("/= ");
 481           break;
 482         case INTRINSIC_GT:
 483         case INTRINSIC_GT_OS:
 484           gfc_status ("> ");
 485           break;
 486         case INTRINSIC_GE:
 487         case INTRINSIC_GE_OS:
 488           gfc_status (">= ");
 489           break;
 490         case INTRINSIC_LT:
 491         case INTRINSIC_LT_OS:
 492           gfc_status ("< ");
 493           break;
 494         case INTRINSIC_LE:
 495         case INTRINSIC_LE_OS:
 496           gfc_status ("<= ");
 497           break;
 498         case INTRINSIC_NOT:
 499           gfc_status ("NOT ");
 500           break;
 501         case INTRINSIC_PARENTHESES:
 502           gfc_status ("parens");
 503           break;
 504
 505         default:
 506           gfc_internal_error
 507             ("gfc_show_expr(): Bad intrinsic in expression!");
 508         }
 509
 510       gfc_show_expr (p->value.op.op1);
 511
 512       if (p->value.op.op2)
 513         {
 514           gfc_status (" ");
 515           gfc_show_expr (p->value.op.op2);
 516         }
 517
 518       gfc_status (")");
 519       break;
 520
 521     case EXPR_FUNCTION:
 522       if (p->value.function.name == NULL)
 523         {
 524           gfc_status ("%s[", p->symtree->n.sym->name);
 525           gfc_show_actual_arglist (p->value.function.actual);
 526           gfc_status_char (']');
 527         }
 528       else
 529         {
 530           gfc_status ("%s[[", p->value.function.name);
 531           gfc_show_actual_arglist (p->value.function.actual);
 532           gfc_status_char (']');
 533           gfc_status_char (']');
 534         }
 535
 536       break;
 537
 538     default:
 539       gfc_internal_error ("gfc_show_expr(): Don't know how to show expr");
 540     }
 541 }
 542
 543
 544 /* Show symbol attributes.  The flavor and intent are followed by
 545    whatever single bit attributes are present.  */
 546
 547 void
 548 gfc_show_attr (symbol_attribute *attr)
 549 {
 550
 551   gfc_status ("(%s %s %s %s %s", gfc_code2string (flavors, attr->flavor),
 552               gfc_intent_string (attr->intent),
 553               gfc_code2string (access_types, attr->access),
 554               gfc_code2string (procedures, attr->proc),
 555               gfc_code2string (save_status, attr->save));
 556
 557   if (attr->allocatable)
 558     gfc_status (" ALLOCATABLE");
 559   if (attr->dimension)
 560     gfc_status (" DIMENSION");
 561   if (attr->external)
 562     gfc_status (" EXTERNAL");
 563   if (attr->intrinsic)
 564     gfc_status (" INTRINSIC");
 565   if (attr->optional)
 566     gfc_status (" OPTIONAL");
 567   if (attr->pointer)
 568     gfc_status (" POINTER");
 569   if (attr->protected)
 570     gfc_status (" PROTECTED");
 571   if (attr->value)
 572     gfc_status (" VALUE");
 573   if (attr->volatile_)
 574     gfc_status (" VOLATILE");
 575   if (attr->threadprivate)
 576     gfc_status (" THREADPRIVATE");
 577   if (attr->target)
 578     gfc_status (" TARGET");
 579   if (attr->dummy)
 580     gfc_status (" DUMMY");
 581   if (attr->result)
 582     gfc_status (" RESULT");
 583   if (attr->entry)
 584     gfc_status (" ENTRY");
 585
 586   if (attr->data)
 587     gfc_status (" DATA");
 588   if (attr->use_assoc)
 589     gfc_status (" USE-ASSOC");
 590   if (attr->in_namelist)
 591     gfc_status (" IN-NAMELIST");
 592   if (attr->in_common)
 593     gfc_status (" IN-COMMON");
 594
 595   if (attr->function)
 596     gfc_status (" FUNCTION");
 597   if (attr->subroutine)
 598     gfc_status (" SUBROUTINE");
 599   if (attr->implicit_type)
 600     gfc_status (" IMPLICIT-TYPE");
 601
 602   if (attr->sequence)
 603     gfc_status (" SEQUENCE");
 604   if (attr->elemental)
 605     gfc_status (" ELEMENTAL");
 606   if (attr->pure)
 607     gfc_status (" PURE");
 608   if (attr->recursive)
 609     gfc_status (" RECURSIVE");
 610
 611   gfc_status (")");
 612 }
 613
 614
 615 /* Show components of a derived type.  */
 616
 617 void
 618 gfc_show_components (gfc_symbol *sym)
 619 {
 620   gfc_component *c;
 621
 622   for (c = sym->components; c; c = c->next)
 623     {
 624       gfc_status ("(%s ", c->name);
 625       gfc_show_typespec (&c->ts);
 626       if (c->pointer)
 627         gfc_status (" POINTER");
 628       if (c->dimension)
 629         gfc_status (" DIMENSION");
 630       gfc_status_char (' ');
 631       gfc_show_array_spec (c->as);
 632       if (c->access)
 633         gfc_status (" %s", gfc_code2string (access_types, c->access));
 634       gfc_status (")");
 635       if (c->next != NULL)
 636         gfc_status_char (' ');
 637     }
 638 }
 639
 640
 641 /* Show a symbol.  If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
 642    show the interface.  Information needed to reconstruct the list of
 643    specific interfaces associated with a generic symbol is done within
 644    that symbol.  */
 645
 646 void
 647 gfc_show_symbol (gfc_symbol *sym)
 648 {
 649   gfc_formal_arglist *formal;
 650   gfc_interface *intr;
 651
 652   if (sym == NULL)
 653     return;
 654
 655   show_indent ();
 656
 657   gfc_status ("symbol %s ", sym->name);
 658   gfc_show_typespec (&sym->ts);
 659   gfc_show_attr (&sym->attr);
 660
 661   if (sym->value)
 662     {
 663       show_indent ();
 664       gfc_status ("value: ");
 665       gfc_show_expr (sym->value);
 666     }
 667
 668   if (sym->as)
 669     {
 670       show_indent ();
 671       gfc_status ("Array spec:");
 672       gfc_show_array_spec (sym->as);
 673     }
 674
 675   if (sym->generic)
 676     {
 677       show_indent ();
 678       gfc_status ("Generic interfaces:");
 679       for (intr = sym->generic; intr; intr = intr->next)
 680         gfc_status (" %s", intr->sym->name);
 681     }
 682
 683   if (sym->result)
 684     {
 685       show_indent ();
 686       gfc_status ("result: %s", sym->result->name);
 687     }
 688
 689   if (sym->components)
 690     {
 691       show_indent ();
 692       gfc_status ("components: ");
 693       gfc_show_components (sym);
 694     }
 695
 696   if (sym->formal)
 697     {
 698       show_indent ();
 699       gfc_status ("Formal arglist:");
 700
 701       for (formal = sym->formal; formal; formal = formal->next)
 702         {
 703           if (formal->sym != NULL)
 704             gfc_status (" %s", formal->sym->name);
 705           else
 706             gfc_status (" [Alt Return]");
 707         }
 708     }
 709
 710   if (sym->formal_ns)
 711     {
 712       show_indent ();
 713       gfc_status ("Formal namespace");
 714       gfc_show_namespace (sym->formal_ns);
 715     }
 716
 717   gfc_status_char ('\n');
 718 }
 719
 720
 721 /* Show a user-defined operator.  Just prints an operator
 722    and the name of the associated subroutine, really.  */
 723
 724 static void
 725 show_uop (gfc_user_op *uop)
 726 {
 727   gfc_interface *intr;
 728
 729   show_indent ();
 730   gfc_status ("%s:", uop->name);
 731
 732   for (intr = uop->operator; intr; intr = intr->next)
 733     gfc_status (" %s", intr->sym->name);
 734 }
 735
 736
 737 /* Workhorse function for traversing the user operator symtree.  */
 738
 739 static void
 740 traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
 741 {
 742   if (st == NULL)
 743     return;
 744
 745   (*func) (st->n.uop);
 746
 747   traverse_uop (st->left, func);
 748   traverse_uop (st->right, func);
 749 }
 750
 751
 752 /* Traverse the tree of user operator nodes.  */
 753
 754 void
 755 gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
 756 {
 757   traverse_uop (ns->uop_root, func);
 758 }
 759
 760
 761 /* Function to display a common block.  */
 762
 763 static void
 764 show_common (gfc_symtree *st)
 765 {
 766   gfc_symbol *s;
 767
 768   show_indent ();
 769   gfc_status ("common: /%s/ ", st->name);
 770
 771   s = st->n.common->head;
 772   while (s)
 773     {
 774       gfc_status ("%s", s->name);
 775       s = s->common_next;
 776       if (s)
 777         gfc_status (", ");
 778     }
 779   gfc_status_char ('\n');
 780 }
 781
 782
 783 /* Worker function to display the symbol tree.  */
 784
 785 static void
 786 show_symtree (gfc_symtree *st)
 787 {
 788   show_indent ();
 789   gfc_status ("symtree: %s  Ambig %d", st->name, st->ambiguous);
 790
 791   if (st->n.sym->ns != gfc_current_ns)
 792     gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name);
 793   else
 794     gfc_show_symbol (st->n.sym);
 795 }
 796
 797
 798 /******************* Show gfc_code structures **************/
 799
 800
 801
 802 static void gfc_show_code_node (int, gfc_code *);
 803
 804 /* Show a list of code structures.  Mutually recursive with
 805    gfc_show_code_node().  */
 806
 807 void
 808 gfc_show_code (int level, gfc_code *c)
 809 {
 810   for (; c; c = c->next)
 811     gfc_show_code_node (level, c);
 812 }
 813
 814 void
 815 gfc_show_namelist (gfc_namelist *n)
 816 {
 817   for (; n->next; n = n->next)
 818     gfc_status ("%s,", n->sym->name);
 819   gfc_status ("%s", n->sym->name);
 820 }
 821
 822 /* Show a single OpenMP directive node and everything underneath it
 823    if necessary.  */
 824
 825 static void
 826 gfc_show_omp_node (int level, gfc_code *c)
 827 {
 828   gfc_omp_clauses *omp_clauses = NULL;
 829   const char *name = NULL;
 830
 831   switch (c->op)
 832     {
 833     case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
 834     case EXEC_OMP_BARRIER: name = "BARRIER"; break;
 835     case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
 836     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
 837     case EXEC_OMP_DO: name = "DO"; break;
 838     case EXEC_OMP_MASTER: name = "MASTER"; break;
 839     case EXEC_OMP_ORDERED: name = "ORDERED"; break;
 840     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
 841     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
 842     case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
 843     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
 844     case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
 845     case EXEC_OMP_SINGLE: name = "SINGLE"; break;
 846     case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
 847     default:
 848       gcc_unreachable ();
 849     }
 850   gfc_status ("!$OMP %s", name);
 851   switch (c->op)
 852     {
 853     case EXEC_OMP_DO:
 854     case EXEC_OMP_PARALLEL:
 855     case EXEC_OMP_PARALLEL_DO:
 856     case EXEC_OMP_PARALLEL_SECTIONS:
 857     case EXEC_OMP_SECTIONS:
 858     case EXEC_OMP_SINGLE:
 859     case EXEC_OMP_WORKSHARE:
 860     case EXEC_OMP_PARALLEL_WORKSHARE:
 861       omp_clauses = c->ext.omp_clauses;
 862       break;
 863     case EXEC_OMP_CRITICAL:
 864       if (c->ext.omp_name)
 865         gfc_status (" (%s)", c->ext.omp_name);
 866       break;
 867     case EXEC_OMP_FLUSH:
 868       if (c->ext.omp_namelist)
 869         {
 870           gfc_status (" (");
 871           gfc_show_namelist (c->ext.omp_namelist);
 872           gfc_status_char (')');
 873         }
 874       return;
 875     case EXEC_OMP_BARRIER:
 876       return;
 877     default:
 878       break;
 879     }
 880   if (omp_clauses)
 881     {
 882       int list_type;
 883
 884       if (omp_clauses->if_expr)
 885         {
 886           gfc_status (" IF(");
 887           gfc_show_expr (omp_clauses->if_expr);
 888           gfc_status_char (')');
 889         }
 890       if (omp_clauses->num_threads)
 891         {
 892           gfc_status (" NUM_THREADS(");
 893           gfc_show_expr (omp_clauses->num_threads);
 894           gfc_status_char (')');
 895         }
 896       if (omp_clauses->sched_kind != OMP_SCHED_NONE)
 897         {
 898           const char *type;
 899           switch (omp_clauses->sched_kind)
 900             {
 901             case OMP_SCHED_STATIC: type = "STATIC"; break;
 902             case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
 903             case OMP_SCHED_GUIDED: type = "GUIDED"; break;
 904             case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
 905             default:
 906               gcc_unreachable ();
 907             }
 908           gfc_status (" SCHEDULE (%s", type);
 909           if (omp_clauses->chunk_size)
 910             {
 911               gfc_status_char (',');
 912               gfc_show_expr (omp_clauses->chunk_size);
 913             }
 914           gfc_status_char (')');
 915         }
 916       if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
 917         {
 918           const char *type;
 919           switch (omp_clauses->default_sharing)
 920             {
 921             case OMP_DEFAULT_NONE: type = "NONE"; break;
 922             case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
 923             case OMP_DEFAULT_SHARED: type = "SHARED"; break;
 924             case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
 925             default:
 926               gcc_unreachable ();
 927             }
 928           gfc_status (" DEFAULT(%s)", type);
 929         }
 930       if (omp_clauses->ordered)
 931         gfc_status (" ORDERED");
 932       for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
 933         if (omp_clauses->lists[list_type] != NULL
 934             && list_type != OMP_LIST_COPYPRIVATE)
 935           {
 936             const char *type;
 937             if (list_type >= OMP_LIST_REDUCTION_FIRST)
 938               {
 939                 switch (list_type)
 940                   {
 941                   case OMP_LIST_PLUS: type = "+"; break;
 942                   case OMP_LIST_MULT: type = "*"; break;
 943                   case OMP_LIST_SUB: type = "-"; break;
 944                   case OMP_LIST_AND: type = ".AND."; break;
 945                   case OMP_LIST_OR: type = ".OR."; break;
 946                   case OMP_LIST_EQV: type = ".EQV."; break;
 947                   case OMP_LIST_NEQV: type = ".NEQV."; break;
 948                   case OMP_LIST_MAX: type = "MAX"; break;
 949                   case OMP_LIST_MIN: type = "MIN"; break;
 950                   case OMP_LIST_IAND: type = "IAND"; break;
 951                   case OMP_LIST_IOR: type = "IOR"; break;
 952                   case OMP_LIST_IEOR: type = "IEOR"; break;
 953                   default:
 954                     gcc_unreachable ();
 955                   }
 956                 gfc_status (" REDUCTION(%s:", type);
 957               }
 958             else
 959               {
 960                 switch (list_type)
 961                   {
 962                   case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
 963                   case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
 964                   case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
 965                   case OMP_LIST_SHARED: type = "SHARED"; break;
 966                   case OMP_LIST_COPYIN: type = "COPYIN"; break;
 967                   default:
 968                     gcc_unreachable ();
 969                   }
 970                 gfc_status (" %s(", type);
 971               }
 972             gfc_show_namelist (omp_clauses->lists[list_type]);
 973             gfc_status_char (')');
 974           }
 975     }
 976   gfc_status_char ('\n');
 977   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
 978     {
 979       gfc_code *d = c->block;
 980       while (d != NULL)
 981         {
 982           gfc_show_code (level + 1, d->next);
 983           if (d->block == NULL)
 984             break;
 985           code_indent (level, 0);
 986           gfc_status ("!$OMP SECTION\n");
 987           d = d->block;
 988         }
 989     }
 990   else
 991     gfc_show_code (level + 1, c->block->next);
 992   if (c->op == EXEC_OMP_ATOMIC)
 993     return;
 994   code_indent (level, 0);
 995   gfc_status ("!$OMP END %s", name);
 996   if (omp_clauses != NULL)
 997     {
 998       if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
 999         {
1000           gfc_status (" COPYPRIVATE(");
1001           gfc_show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
1002           gfc_status_char (')');
1003         }
1004       else if (omp_clauses->nowait)
1005         gfc_status (" NOWAIT");
1006     }
1007   else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
1008     gfc_status (" (%s)", c->ext.omp_name);
1009 }
1010
1011
1012 /* Show a single code node and everything underneath it if necessary.  */
1013
1014 static void
1015 gfc_show_code_node (int level, gfc_code *c)
1016 {
1017   gfc_forall_iterator *fa;
1018   gfc_open *open;
1019   gfc_case *cp;
1020   gfc_alloc *a;
1021   gfc_code *d;
1022   gfc_close *close;
1023   gfc_filepos *fp;
1024   gfc_inquire *i;
1025   gfc_dt *dt;
1026
1027   code_indent (level, c->here);
1028
1029   switch (c->op)
1030     {
1031     case EXEC_NOP:
1032       gfc_status ("NOP");
1033       break;
1034
1035     case EXEC_CONTINUE:
1036       gfc_status ("CONTINUE");
1037       break;
1038
1039     case EXEC_ENTRY:
1040       gfc_status ("ENTRY %s", c->ext.entry->sym->name);
1041       break;
1042
1043     case EXEC_INIT_ASSIGN:
1044     case EXEC_ASSIGN:
1045       gfc_status ("ASSIGN ");
1046       gfc_show_expr (c->expr);
1047       gfc_status_char (' ');
1048       gfc_show_expr (c->expr2);
1049       break;
1050
1051     case EXEC_LABEL_ASSIGN:
1052       gfc_status ("LABEL ASSIGN ");
1053       gfc_show_expr (c->expr);
1054       gfc_status (" %d", c->label->value);
1055       break;
1056
1057     case EXEC_POINTER_ASSIGN:
1058       gfc_status ("POINTER ASSIGN ");
1059       gfc_show_expr (c->expr);
1060       gfc_status_char (' ');
1061       gfc_show_expr (c->expr2);
1062       break;
1063
1064     case EXEC_GOTO:
1065       gfc_status ("GOTO ");
1066       if (c->label)
1067         gfc_status ("%d", c->label->value);
1068       else
1069         {
1070           gfc_show_expr (c->expr);
1071           d = c->block;
1072           if (d != NULL)
1073             {
1074               gfc_status (", (");
1075               for (; d; d = d ->block)
1076                 {
1077                   code_indent (level, d->label);
1078                   if (d->block != NULL)
1079                     gfc_status_char (',');
1080                   else
1081                     gfc_status_char (')');
1082                 }
1083             }
1084         }
1085       break;
1086
1087     case EXEC_CALL:
1088       if (c->resolved_sym)
1089         gfc_status ("CALL %s ", c->resolved_sym->name);
1090       else if (c->symtree)
1091         gfc_status ("CALL %s ", c->symtree->name);
1092       else
1093         gfc_status ("CALL ?? ");
1094
1095       gfc_show_actual_arglist (c->ext.actual);
1096       break;
1097
1098     case EXEC_RETURN:
1099       gfc_status ("RETURN ");
1100       if (c->expr)
1101         gfc_show_expr (c->expr);
1102       break;
1103
1104     case EXEC_PAUSE:
1105       gfc_status ("PAUSE ");
1106
1107       if (c->expr != NULL)
1108         gfc_show_expr (c->expr);
1109       else
1110         gfc_status ("%d", c->ext.stop_code);
1111
1112       break;
1113
1114     case EXEC_STOP:
1115       gfc_status ("STOP ");
1116
1117       if (c->expr != NULL)
1118         gfc_show_expr (c->expr);
1119       else
1120         gfc_status ("%d", c->ext.stop_code);
1121
1122       break;
1123
1124     case EXEC_ARITHMETIC_IF:
1125       gfc_status ("IF ");
1126       gfc_show_expr (c->expr);
1127       gfc_status (" %d, %d, %d",
1128                   c->label->value, c->label2->value, c->label3->value);
1129       break;
1130
1131     case EXEC_IF:
1132       d = c->block;
1133       gfc_status ("IF ");
1134       gfc_show_expr (d->expr);
1135       gfc_status_char ('\n');
1136       gfc_show_code (level + 1, d->next);
1137
1138       d = d->block;
1139       for (; d; d = d->block)
1140         {
1141           code_indent (level, 0);
1142
1143           if (d->expr == NULL)
1144             gfc_status ("ELSE\n");
1145           else
1146             {
1147               gfc_status ("ELSE IF ");
1148               gfc_show_expr (d->expr);
1149               gfc_status_char ('\n');
1150             }
1151
1152           gfc_show_code (level + 1, d->next);
1153         }
1154
1155       code_indent (level, c->label);
1156
1157       gfc_status ("ENDIF");
1158       break;
1159
1160     case EXEC_SELECT:
1161       d = c->block;
1162       gfc_status ("SELECT CASE ");
1163       gfc_show_expr (c->expr);
1164       gfc_status_char ('\n');
1165
1166       for (; d; d = d->block)
1167         {
1168           code_indent (level, 0);
1169
1170           gfc_status ("CASE ");
1171           for (cp = d->ext.case_list; cp; cp = cp->next)
1172             {
1173               gfc_status_char ('(');
1174               gfc_show_expr (cp->low);
1175               gfc_status_char (' ');
1176               gfc_show_expr (cp->high);
1177               gfc_status_char (')');
1178               gfc_status_char (' ');
1179             }
1180           gfc_status_char ('\n');
1181
1182           gfc_show_code (level + 1, d->next);
1183         }
1184
1185       code_indent (level, c->label);
1186       gfc_status ("END SELECT");
1187       break;
1188
1189     case EXEC_WHERE:
1190       gfc_status ("WHERE ");
1191
1192       d = c->block;
1193       gfc_show_expr (d->expr);
1194       gfc_status_char ('\n');
1195
1196       gfc_show_code (level + 1, d->next);
1197
1198       for (d = d->block; d; d = d->block)
1199         {
1200           code_indent (level, 0);
1201           gfc_status ("ELSE WHERE ");
1202           gfc_show_expr (d->expr);
1203           gfc_status_char ('\n');
1204           gfc_show_code (level + 1, d->next);
1205         }
1206
1207       code_indent (level, 0);
1208       gfc_status ("END WHERE");
1209       break;
1210
1211
1212     case EXEC_FORALL:
1213       gfc_status ("FORALL ");
1214       for (fa = c->ext.forall_iterator; fa; fa = fa->next)
1215         {
1216           gfc_show_expr (fa->var);
1217           gfc_status_char (' ');
1218           gfc_show_expr (fa->start);
1219           gfc_status_char (':');
1220           gfc_show_expr (fa->end);
1221           gfc_status_char (':');
1222           gfc_show_expr (fa->stride);
1223
1224           if (fa->next != NULL)
1225             gfc_status_char (',');
1226         }
1227
1228       if (c->expr != NULL)
1229         {
1230           gfc_status_char (',');
1231           gfc_show_expr (c->expr);
1232         }
1233       gfc_status_char ('\n');
1234
1235       gfc_show_code (level + 1, c->block->next);
1236
1237       code_indent (level, 0);
1238       gfc_status ("END FORALL");
1239       break;
1240
1241     case EXEC_DO:
1242       gfc_status ("DO ");
1243
1244       gfc_show_expr (c->ext.iterator->var);
1245       gfc_status_char ('=');
1246       gfc_show_expr (c->ext.iterator->start);
1247       gfc_status_char (' ');
1248       gfc_show_expr (c->ext.iterator->end);
1249       gfc_status_char (' ');
1250       gfc_show_expr (c->ext.iterator->step);
1251       gfc_status_char ('\n');
1252
1253       gfc_show_code (level + 1, c->block->next);
1254
1255       code_indent (level, 0);
1256       gfc_status ("END DO");
1257       break;
1258
1259     case EXEC_DO_WHILE:
1260       gfc_status ("DO WHILE ");
1261       gfc_show_expr (c->expr);
1262       gfc_status_char ('\n');
1263
1264       gfc_show_code (level + 1, c->block->next);
1265
1266       code_indent (level, c->label);
1267       gfc_status ("END DO");
1268       break;
1269
1270     case EXEC_CYCLE:
1271       gfc_status ("CYCLE");
1272       if (c->symtree)
1273         gfc_status (" %s", c->symtree->n.sym->name);
1274       break;
1275
1276     case EXEC_EXIT:
1277       gfc_status ("EXIT");
1278       if (c->symtree)
1279         gfc_status (" %s", c->symtree->n.sym->name);
1280       break;
1281
1282     case EXEC_ALLOCATE:
1283       gfc_status ("ALLOCATE ");
1284       if (c->expr)
1285         {
1286           gfc_status (" STAT=");
1287           gfc_show_expr (c->expr);
1288         }
1289
1290       for (a = c->ext.alloc_list; a; a = a->next)
1291         {
1292           gfc_status_char (' ');
1293           gfc_show_expr (a->expr);
1294         }
1295
1296       break;
1297
1298     case EXEC_DEALLOCATE:
1299       gfc_status ("DEALLOCATE ");
1300       if (c->expr)
1301         {
1302           gfc_status (" STAT=");
1303           gfc_show_expr (c->expr);
1304         }
1305
1306       for (a = c->ext.alloc_list; a; a = a->next)
1307         {
1308           gfc_status_char (' ');
1309           gfc_show_expr (a->expr);
1310         }
1311
1312       break;
1313
1314     case EXEC_OPEN:
1315       gfc_status ("OPEN");
1316       open = c->ext.open;
1317
1318       if (open->unit)
1319         {
1320           gfc_status (" UNIT=");
1321           gfc_show_expr (open->unit);
1322         }
1323       if (open->iomsg)
1324         {
1325           gfc_status (" IOMSG=");
1326           gfc_show_expr (open->iomsg);
1327         }
1328       if (open->iostat)
1329         {
1330           gfc_status (" IOSTAT=");
1331           gfc_show_expr (open->iostat);
1332         }
1333       if (open->file)
1334         {
1335           gfc_status (" FILE=");
1336           gfc_show_expr (open->file);
1337         }
1338       if (open->status)
1339         {
1340           gfc_status (" STATUS=");
1341           gfc_show_expr (open->status);
1342         }
1343       if (open->access)
1344         {
1345           gfc_status (" ACCESS=");
1346           gfc_show_expr (open->access);
1347         }
1348       if (open->form)
1349         {
1350           gfc_status (" FORM=");
1351           gfc_show_expr (open->form);
1352         }
1353       if (open->recl)
1354         {
1355           gfc_status (" RECL=");
1356           gfc_show_expr (open->recl);
1357         }
1358       if (open->blank)
1359         {
1360           gfc_status (" BLANK=");
1361           gfc_show_expr (open->blank);
1362         }
1363       if (open->position)
1364         {
1365           gfc_status (" POSITION=");
1366           gfc_show_expr (open->position);
1367         }
1368       if (open->action)
1369         {
1370           gfc_status (" ACTION=");
1371           gfc_show_expr (open->action);
1372         }
1373       if (open->delim)
1374         {
1375           gfc_status (" DELIM=");
1376           gfc_show_expr (open->delim);
1377         }
1378       if (open->pad)
1379         {
1380           gfc_status (" PAD=");
1381           gfc_show_expr (open->pad);
1382         }
1383       if (open->convert)
1384         {
1385           gfc_status (" CONVERT=");
1386           gfc_show_expr (open->convert);
1387         }
1388       if (open->err != NULL)
1389         gfc_status (" ERR=%d", open->err->value);
1390
1391       break;
1392
1393     case EXEC_CLOSE:
1394       gfc_status ("CLOSE");
1395       close = c->ext.close;
1396
1397       if (close->unit)
1398         {
1399           gfc_status (" UNIT=");
1400           gfc_show_expr (close->unit);
1401         }
1402       if (close->iomsg)
1403         {
1404           gfc_status (" IOMSG=");
1405           gfc_show_expr (close->iomsg);
1406         }
1407       if (close->iostat)
1408         {
1409           gfc_status (" IOSTAT=");
1410           gfc_show_expr (close->iostat);
1411         }
1412       if (close->status)
1413         {
1414           gfc_status (" STATUS=");
1415           gfc_show_expr (close->status);
1416         }
1417       if (close->err != NULL)
1418         gfc_status (" ERR=%d", close->err->value);
1419       break;
1420
1421     case EXEC_BACKSPACE:
1422       gfc_status ("BACKSPACE");
1423       goto show_filepos;
1424
1425     case EXEC_ENDFILE:
1426       gfc_status ("ENDFILE");
1427       goto show_filepos;
1428
1429     case EXEC_REWIND:
1430       gfc_status ("REWIND");
1431       goto show_filepos;
1432
1433     case EXEC_FLUSH:
1434       gfc_status ("FLUSH");
1435
1436     show_filepos:
1437       fp = c->ext.filepos;
1438
1439       if (fp->unit)
1440         {
1441           gfc_status (" UNIT=");
1442           gfc_show_expr (fp->unit);
1443         }
1444       if (fp->iomsg)
1445         {
1446           gfc_status (" IOMSG=");
1447           gfc_show_expr (fp->iomsg);
1448         }
1449       if (fp->iostat)
1450         {
1451           gfc_status (" IOSTAT=");
1452           gfc_show_expr (fp->iostat);
1453         }
1454       if (fp->err != NULL)
1455         gfc_status (" ERR=%d", fp->err->value);
1456       break;
1457
1458     case EXEC_INQUIRE:
1459       gfc_status ("INQUIRE");
1460       i = c->ext.inquire;
1461
1462       if (i->unit)
1463         {
1464           gfc_status (" UNIT=");
1465           gfc_show_expr (i->unit);
1466         }
1467       if (i->file)
1468         {
1469           gfc_status (" FILE=");
1470           gfc_show_expr (i->file);
1471         }
1472
1473       if (i->iomsg)
1474         {
1475           gfc_status (" IOMSG=");
1476           gfc_show_expr (i->iomsg);
1477         }
1478       if (i->iostat)
1479         {
1480           gfc_status (" IOSTAT=");
1481           gfc_show_expr (i->iostat);
1482         }
1483       if (i->exist)
1484         {
1485           gfc_status (" EXIST=");
1486           gfc_show_expr (i->exist);
1487         }
1488       if (i->opened)
1489         {
1490           gfc_status (" OPENED=");
1491           gfc_show_expr (i->opened);
1492         }
1493       if (i->number)
1494         {
1495           gfc_status (" NUMBER=");
1496           gfc_show_expr (i->number);
1497         }
1498       if (i->named)
1499         {
1500           gfc_status (" NAMED=");
1501           gfc_show_expr (i->named);
1502         }
1503       if (i->name)
1504         {
1505           gfc_status (" NAME=");
1506           gfc_show_expr (i->name);
1507         }
1508       if (i->access)
1509         {
1510           gfc_status (" ACCESS=");
1511           gfc_show_expr (i->access);
1512         }
1513       if (i->sequential)
1514         {
1515           gfc_status (" SEQUENTIAL=");
1516           gfc_show_expr (i->sequential);
1517         }
1518
1519       if (i->direct)
1520         {
1521           gfc_status (" DIRECT=");
1522           gfc_show_expr (i->direct);
1523         }
1524       if (i->form)
1525         {
1526           gfc_status (" FORM=");
1527           gfc_show_expr (i->form);
1528         }
1529       if (i->formatted)
1530         {
1531           gfc_status (" FORMATTED");
1532           gfc_show_expr (i->formatted);
1533         }
1534       if (i->unformatted)
1535         {
1536           gfc_status (" UNFORMATTED=");
1537           gfc_show_expr (i->unformatted);
1538         }
1539       if (i->recl)
1540         {
1541           gfc_status (" RECL=");
1542           gfc_show_expr (i->recl);
1543         }
1544       if (i->nextrec)
1545         {
1546           gfc_status (" NEXTREC=");
1547           gfc_show_expr (i->nextrec);
1548         }
1549       if (i->blank)
1550         {
1551           gfc_status (" BLANK=");
1552           gfc_show_expr (i->blank);
1553         }
1554       if (i->position)
1555         {
1556           gfc_status (" POSITION=");
1557           gfc_show_expr (i->position);
1558         }
1559       if (i->action)
1560         {
1561           gfc_status (" ACTION=");
1562           gfc_show_expr (i->action);
1563         }
1564       if (i->read)
1565         {
1566           gfc_status (" READ=");
1567           gfc_show_expr (i->read);
1568         }
1569       if (i->write)
1570         {
1571           gfc_status (" WRITE=");
1572           gfc_show_expr (i->write);
1573         }
1574       if (i->readwrite)
1575         {
1576           gfc_status (" READWRITE=");
1577           gfc_show_expr (i->readwrite);
1578         }
1579       if (i->delim)
1580         {
1581           gfc_status (" DELIM=");
1582           gfc_show_expr (i->delim);
1583         }
1584       if (i->pad)
1585         {
1586           gfc_status (" PAD=");
1587           gfc_show_expr (i->pad);
1588         }
1589       if (i->convert)
1590         {
1591           gfc_status (" CONVERT=");
1592           gfc_show_expr (i->convert);
1593         }
1594
1595       if (i->err != NULL)
1596         gfc_status (" ERR=%d", i->err->value);
1597       break;
1598
1599     case EXEC_IOLENGTH:
1600       gfc_status ("IOLENGTH ");
1601       gfc_show_expr (c->expr);
1602       goto show_dt_code;
1603       break;
1604
1605     case EXEC_READ:
1606       gfc_status ("READ");
1607       goto show_dt;
1608
1609     case EXEC_WRITE:
1610       gfc_status ("WRITE");
1611
1612     show_dt:
1613       dt = c->ext.dt;
1614       if (dt->io_unit)
1615         {
1616           gfc_status (" UNIT=");
1617           gfc_show_expr (dt->io_unit);
1618         }
1619
1620       if (dt->format_expr)
1621         {
1622           gfc_status (" FMT=");
1623           gfc_show_expr (dt->format_expr);
1624         }
1625
1626       if (dt->format_label != NULL)
1627         gfc_status (" FMT=%d", dt->format_label->value);
1628       if (dt->namelist)
1629         gfc_status (" NML=%s", dt->namelist->name);
1630
1631       if (dt->iomsg)
1632         {
1633           gfc_status (" IOMSG=");
1634           gfc_show_expr (dt->iomsg);
1635         }
1636       if (dt->iostat)
1637         {
1638           gfc_status (" IOSTAT=");
1639           gfc_show_expr (dt->iostat);
1640         }
1641       if (dt->size)
1642         {
1643           gfc_status (" SIZE=");
1644           gfc_show_expr (dt->size);
1645         }
1646       if (dt->rec)
1647         {
1648           gfc_status (" REC=");
1649           gfc_show_expr (dt->rec);
1650         }
1651       if (dt->advance)
1652         {
1653           gfc_status (" ADVANCE=");
1654           gfc_show_expr (dt->advance);
1655         }
1656
1657     show_dt_code:
1658       gfc_status_char ('\n');
1659       for (c = c->block->next; c; c = c->next)
1660         gfc_show_code_node (level + (c->next != NULL), c);
1661       return;
1662
1663     case EXEC_TRANSFER:
1664       gfc_status ("TRANSFER ");
1665       gfc_show_expr (c->expr);
1666       break;
1667
1668     case EXEC_DT_END:
1669       gfc_status ("DT_END");
1670       dt = c->ext.dt;
1671
1672       if (dt->err != NULL)
1673         gfc_status (" ERR=%d", dt->err->value);
1674       if (dt->end != NULL)
1675         gfc_status (" END=%d", dt->end->value);
1676       if (dt->eor != NULL)
1677         gfc_status (" EOR=%d", dt->eor->value);
1678       break;
1679
1680     case EXEC_OMP_ATOMIC:
1681     case EXEC_OMP_BARRIER:
1682     case EXEC_OMP_CRITICAL:
1683     case EXEC_OMP_FLUSH:
1684     case EXEC_OMP_DO:
1685     case EXEC_OMP_MASTER:
1686     case EXEC_OMP_ORDERED:
1687     case EXEC_OMP_PARALLEL:
1688     case EXEC_OMP_PARALLEL_DO:
1689     case EXEC_OMP_PARALLEL_SECTIONS:
1690     case EXEC_OMP_PARALLEL_WORKSHARE:
1691     case EXEC_OMP_SECTIONS:
1692     case EXEC_OMP_SINGLE:
1693     case EXEC_OMP_WORKSHARE:
1694       gfc_show_omp_node (level, c);
1695       break;
1696
1697     default:
1698       gfc_internal_error ("gfc_show_code_node(): Bad statement code");
1699     }
1700
1701   gfc_status_char ('\n');
1702 }
1703
1704
1705 /* Show an equivalence chain.  */
1706
1707 void
1708 gfc_show_equiv (gfc_equiv *eq)
1709 {
1710   show_indent ();
1711   gfc_status ("Equivalence: ");
1712   while (eq)
1713     {
1714       gfc_show_expr (eq->expr);
1715       eq = eq->eq;
1716       if (eq)
1717         gfc_status (", ");
1718     }
1719 }
1720
1721
1722 /* Show a freakin' whole namespace.  */
1723
1724 void
1725 gfc_show_namespace (gfc_namespace *ns)
1726 {
1727   gfc_interface *intr;
1728   gfc_namespace *save;
1729   gfc_intrinsic_op op;
1730   gfc_equiv *eq;
1731   int i;
1732
1733   save = gfc_current_ns;
1734   show_level++;
1735
1736   show_indent ();
1737   gfc_status ("Namespace:");
1738
1739   if (ns != NULL)
1740     {
1741       i = 0;
1742       do
1743         {
1744           int l = i;
1745           while (i < GFC_LETTERS - 1
1746                  && gfc_compare_types(&ns->default_type[i+1],
1747                                       &ns->default_type[l]))
1748             i++;
1749
1750           if (i > l)
1751             gfc_status(" %c-%c: ", l+'A', i+'A');
1752           else
1753             gfc_status(" %c: ", l+'A');
1754
1755           gfc_show_typespec(&ns->default_type[l]);
1756           i++;
1757       } while (i < GFC_LETTERS);
1758
1759       if (ns->proc_name != NULL)
1760         {
1761           show_indent ();
1762           gfc_status ("procedure name = %s", ns->proc_name->name);
1763         }
1764
1765       gfc_current_ns = ns;
1766       gfc_traverse_symtree (ns->common_root, show_common);
1767
1768       gfc_traverse_symtree (ns->sym_root, show_symtree);
1769
1770       for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
1771         {
1772           /* User operator interfaces */
1773           intr = ns->operator[op];
1774           if (intr == NULL)
1775             continue;
1776
1777           show_indent ();
1778           gfc_status ("Operator interfaces for %s:", gfc_op2string (op));
1779
1780           for (; intr; intr = intr->next)
1781             gfc_status (" %s", intr->sym->name);
1782         }
1783
1784       if (ns->uop_root != NULL)
1785         {
1786           show_indent ();
1787           gfc_status ("User operators:\n");
1788           gfc_traverse_user_op (ns, show_uop);
1789         }
1790     }
1791
1792   for (eq = ns->equiv; eq; eq = eq->next)
1793     gfc_show_equiv (eq);
1794
1795   gfc_status_char ('\n');
1796   gfc_status_char ('\n');
1797
1798   gfc_show_code (0, ns->code);
1799
1800   for (ns = ns->contained; ns; ns = ns->sibling)
1801     {
1802       show_indent ();
1803       gfc_status ("CONTAINS\n");
1804       gfc_show_namespace (ns);
1805     }
1806
1807   show_level--;
1808   gfc_status_char ('\n');
1809   gfc_current_ns = save;
1810 }