gcc/fortran/dump-parse-tree.c

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