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