2 Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
3 Free Software Foundation, Inc.
4 Contributed by Steven Bosscher
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
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
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
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.
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
37 #include "constructor.h"
39 /* Keep track of indentation for symbol tree dumps. */
40 static int show_level = 0;
42 /* The file handle we're dumping to is kept in a static variable. This
43 is not too cool, but it avoids a lot of passing it around. */
44 static FILE *dumpfile;
46 /* Forward declaration of some of the functions. */
47 static void show_expr (gfc_expr *p);
48 static void show_code_node (int, gfc_code *);
49 static void show_namespace (gfc_namespace *ns);
52 /* Allow dumping of an expression in the debugger. */
53 void gfc_debug_expr (gfc_expr *);
56 gfc_debug_expr (gfc_expr *e)
61 fputc ('\n', dumpfile);
66 /* Do indentation for a specific level. */
69 code_indent (int level, gfc_st_label *label)
74 fprintf (dumpfile, "%-5d ", label->value);
76 for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
77 fputc (' ', dumpfile);
81 /* Simple indentation at the current level. This one
82 is used to show symbols. */
87 fputc ('\n', dumpfile);
88 code_indent (show_level, NULL);
92 /* Show type-specific information. */
95 show_typespec (gfc_typespec *ts)
97 fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
103 fprintf (dumpfile, "%s", ts->u.derived->name);
107 show_expr (ts->u.cl->length);
108 fprintf(dumpfile, " %d", ts->kind);
112 fprintf (dumpfile, "%d", ts->kind);
116 fputc (')', dumpfile);
120 /* Show an actual argument list. */
123 show_actual_arglist (gfc_actual_arglist *a)
125 fputc ('(', dumpfile);
127 for (; a; a = a->next)
129 fputc ('(', dumpfile);
131 fprintf (dumpfile, "%s = ", a->name);
135 fputs ("(arg not-present)", dumpfile);
137 fputc (')', dumpfile);
139 fputc (' ', dumpfile);
142 fputc (')', dumpfile);
146 /* Show a gfc_array_spec array specification structure. */
149 show_array_spec (gfc_array_spec *as)
156 fputs ("()", dumpfile);
160 fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
162 if (as->rank + as->corank > 0)
166 case AS_EXPLICIT: c = "AS_EXPLICIT"; break;
167 case AS_DEFERRED: c = "AS_DEFERRED"; break;
168 case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break;
169 case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
171 gfc_internal_error ("show_array_spec(): Unhandled array shape "
174 fprintf (dumpfile, " %s ", c);
176 for (i = 0; i < as->rank + as->corank; i++)
178 show_expr (as->lower[i]);
179 fputc (' ', dumpfile);
180 show_expr (as->upper[i]);
181 fputc (' ', dumpfile);
185 fputc (')', dumpfile);
189 /* Show a gfc_array_ref array reference structure. */
192 show_array_ref (gfc_array_ref * ar)
196 fputc ('(', dumpfile);
201 fputs ("FULL", dumpfile);
205 for (i = 0; i < ar->dimen; i++)
207 /* There are two types of array sections: either the
208 elements are identified by an integer array ('vector'),
209 or by an index range. In the former case we only have to
210 print the start expression which contains the vector, in
211 the latter case we have to print any of lower and upper
212 bound and the stride, if they're present. */
214 if (ar->start[i] != NULL)
215 show_expr (ar->start[i]);
217 if (ar->dimen_type[i] == DIMEN_RANGE)
219 fputc (':', dumpfile);
221 if (ar->end[i] != NULL)
222 show_expr (ar->end[i]);
224 if (ar->stride[i] != NULL)
226 fputc (':', dumpfile);
227 show_expr (ar->stride[i]);
231 if (i != ar->dimen - 1)
232 fputs (" , ", dumpfile);
237 for (i = 0; i < ar->dimen; i++)
239 show_expr (ar->start[i]);
240 if (i != ar->dimen - 1)
241 fputs (" , ", dumpfile);
246 fputs ("UNKNOWN", dumpfile);
250 gfc_internal_error ("show_array_ref(): Unknown array reference");
253 fputc (')', dumpfile);
257 /* Show a list of gfc_ref structures. */
260 show_ref (gfc_ref *p)
262 for (; p; p = p->next)
266 show_array_ref (&p->u.ar);
270 fprintf (dumpfile, " %% %s", p->u.c.component->name);
274 fputc ('(', dumpfile);
275 show_expr (p->u.ss.start);
276 fputc (':', dumpfile);
277 show_expr (p->u.ss.end);
278 fputc (')', dumpfile);
282 gfc_internal_error ("show_ref(): Bad component code");
287 /* Display a constructor. Works recursively for array constructors. */
290 show_constructor (gfc_constructor_base base)
293 for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
295 if (c->iterator == NULL)
299 fputc ('(', dumpfile);
302 fputc (' ', dumpfile);
303 show_expr (c->iterator->var);
304 fputc ('=', dumpfile);
305 show_expr (c->iterator->start);
306 fputc (',', dumpfile);
307 show_expr (c->iterator->end);
308 fputc (',', dumpfile);
309 show_expr (c->iterator->step);
311 fputc (')', dumpfile);
314 if (gfc_constructor_next (c) != NULL)
315 fputs (" , ", dumpfile);
321 show_char_const (const gfc_char_t *c, int length)
325 fputc ('\'', dumpfile);
326 for (i = 0; i < length; i++)
329 fputs ("''", dumpfile);
331 fputs (gfc_print_wide_char (c[i]), dumpfile);
333 fputc ('\'', dumpfile);
337 /* Show a component-call expression. */
340 show_compcall (gfc_expr* p)
342 gcc_assert (p->expr_type == EXPR_COMPCALL);
344 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
346 fprintf (dumpfile, "%s", p->value.compcall.name);
348 show_actual_arglist (p->value.compcall.actual);
352 /* Show an expression. */
355 show_expr (gfc_expr *p)
362 fputs ("()", dumpfile);
366 switch (p->expr_type)
369 show_char_const (p->value.character.string, p->value.character.length);
374 fprintf (dumpfile, "%s(", p->ts.u.derived->name);
375 show_constructor (p->value.constructor);
376 fputc (')', dumpfile);
380 fputs ("(/ ", dumpfile);
381 show_constructor (p->value.constructor);
382 fputs (" /)", dumpfile);
388 fputs ("NULL()", dumpfile);
395 mpz_out_str (stdout, 10, p->value.integer);
397 if (p->ts.kind != gfc_default_integer_kind)
398 fprintf (dumpfile, "_%d", p->ts.kind);
402 if (p->value.logical)
403 fputs (".true.", dumpfile);
405 fputs (".false.", dumpfile);
409 mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
410 if (p->ts.kind != gfc_default_real_kind)
411 fprintf (dumpfile, "_%d", p->ts.kind);
415 show_char_const (p->value.character.string,
416 p->value.character.length);
420 fputs ("(complex ", dumpfile);
422 mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
424 if (p->ts.kind != gfc_default_complex_kind)
425 fprintf (dumpfile, "_%d", p->ts.kind);
427 fputc (' ', dumpfile);
429 mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
431 if (p->ts.kind != gfc_default_complex_kind)
432 fprintf (dumpfile, "_%d", p->ts.kind);
434 fputc (')', dumpfile);
438 fprintf (dumpfile, "%dH", p->representation.length);
439 c = p->representation.string;
440 for (i = 0; i < p->representation.length; i++, c++)
442 fputc (*c, dumpfile);
447 fputs ("???", dumpfile);
451 if (p->representation.string)
453 fputs (" {", dumpfile);
454 c = p->representation.string;
455 for (i = 0; i < p->representation.length; i++, c++)
457 fprintf (dumpfile, "%.2x", (unsigned int) *c);
458 if (i < p->representation.length - 1)
459 fputc (',', dumpfile);
461 fputc ('}', dumpfile);
467 if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
468 fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
469 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
474 fputc ('(', dumpfile);
475 switch (p->value.op.op)
477 case INTRINSIC_UPLUS:
478 fputs ("U+ ", dumpfile);
480 case INTRINSIC_UMINUS:
481 fputs ("U- ", dumpfile);
484 fputs ("+ ", dumpfile);
486 case INTRINSIC_MINUS:
487 fputs ("- ", dumpfile);
489 case INTRINSIC_TIMES:
490 fputs ("* ", dumpfile);
492 case INTRINSIC_DIVIDE:
493 fputs ("/ ", dumpfile);
495 case INTRINSIC_POWER:
496 fputs ("** ", dumpfile);
498 case INTRINSIC_CONCAT:
499 fputs ("// ", dumpfile);
502 fputs ("AND ", dumpfile);
505 fputs ("OR ", dumpfile);
508 fputs ("EQV ", dumpfile);
511 fputs ("NEQV ", dumpfile);
514 case INTRINSIC_EQ_OS:
515 fputs ("= ", dumpfile);
518 case INTRINSIC_NE_OS:
519 fputs ("/= ", dumpfile);
522 case INTRINSIC_GT_OS:
523 fputs ("> ", dumpfile);
526 case INTRINSIC_GE_OS:
527 fputs (">= ", dumpfile);
530 case INTRINSIC_LT_OS:
531 fputs ("< ", dumpfile);
534 case INTRINSIC_LE_OS:
535 fputs ("<= ", dumpfile);
538 fputs ("NOT ", dumpfile);
540 case INTRINSIC_PARENTHESES:
541 fputs ("parens ", dumpfile);
546 ("show_expr(): Bad intrinsic in expression!");
549 show_expr (p->value.op.op1);
553 fputc (' ', dumpfile);
554 show_expr (p->value.op.op2);
557 fputc (')', dumpfile);
561 if (p->value.function.name == NULL)
563 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
564 if (gfc_is_proc_ptr_comp (p, NULL))
566 fputc ('[', dumpfile);
567 show_actual_arglist (p->value.function.actual);
568 fputc (']', dumpfile);
572 fprintf (dumpfile, "%s", p->value.function.name);
573 if (gfc_is_proc_ptr_comp (p, NULL))
575 fputc ('[', dumpfile);
576 fputc ('[', dumpfile);
577 show_actual_arglist (p->value.function.actual);
578 fputc (']', dumpfile);
579 fputc (']', dumpfile);
589 gfc_internal_error ("show_expr(): Don't know how to show expr");
593 /* Show symbol attributes. The flavor and intent are followed by
594 whatever single bit attributes are present. */
597 show_attr (symbol_attribute *attr, const char * module)
599 if (attr->flavor != FL_UNKNOWN)
600 fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
601 if (attr->access != ACCESS_UNKNOWN)
602 fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
603 if (attr->proc != PROC_UNKNOWN)
604 fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
605 if (attr->save != SAVE_NONE)
606 fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
608 if (attr->allocatable)
609 fputs (" ALLOCATABLE", dumpfile);
610 if (attr->asynchronous)
611 fputs (" ASYNCHRONOUS", dumpfile);
612 if (attr->codimension)
613 fputs (" CODIMENSION", dumpfile);
615 fputs (" DIMENSION", dumpfile);
616 if (attr->contiguous)
617 fputs (" CONTIGUOUS", dumpfile);
619 fputs (" EXTERNAL", dumpfile);
621 fputs (" INTRINSIC", dumpfile);
623 fputs (" OPTIONAL", dumpfile);
625 fputs (" POINTER", dumpfile);
626 if (attr->is_protected)
627 fputs (" PROTECTED", dumpfile);
629 fputs (" VALUE", dumpfile);
631 fputs (" VOLATILE", dumpfile);
632 if (attr->threadprivate)
633 fputs (" THREADPRIVATE", dumpfile);
635 fputs (" TARGET", dumpfile);
638 fputs (" DUMMY", dumpfile);
639 if (attr->intent != INTENT_UNKNOWN)
640 fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
644 fputs (" RESULT", dumpfile);
646 fputs (" ENTRY", dumpfile);
648 fputs (" BIND(C)", dumpfile);
651 fputs (" DATA", dumpfile);
654 fputs (" USE-ASSOC", dumpfile);
656 fprintf (dumpfile, "(%s)", module);
659 if (attr->in_namelist)
660 fputs (" IN-NAMELIST", dumpfile);
662 fputs (" IN-COMMON", dumpfile);
665 fputs (" ABSTRACT", dumpfile);
667 fputs (" FUNCTION", dumpfile);
668 if (attr->subroutine)
669 fputs (" SUBROUTINE", dumpfile);
670 if (attr->implicit_type)
671 fputs (" IMPLICIT-TYPE", dumpfile);
674 fputs (" SEQUENCE", dumpfile);
676 fputs (" ELEMENTAL", dumpfile);
678 fputs (" PURE", dumpfile);
680 fputs (" RECURSIVE", dumpfile);
682 fputc (')', dumpfile);
686 /* Show components of a derived type. */
689 show_components (gfc_symbol *sym)
693 for (c = sym->components; c; c = c->next)
695 fprintf (dumpfile, "(%s ", c->name);
696 show_typespec (&c->ts);
697 if (c->attr.allocatable)
698 fputs (" ALLOCATABLE", dumpfile);
700 fputs (" POINTER", dumpfile);
701 if (c->attr.proc_pointer)
702 fputs (" PPC", dumpfile);
703 if (c->attr.dimension)
704 fputs (" DIMENSION", dumpfile);
705 fputc (' ', dumpfile);
706 show_array_spec (c->as);
708 fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
709 fputc (')', dumpfile);
711 fputc (' ', dumpfile);
716 /* Show the f2k_derived namespace with procedure bindings. */
719 show_typebound_proc (gfc_typebound_proc* tb, const char* name)
724 fputs ("GENERIC", dumpfile);
727 fputs ("PROCEDURE, ", dumpfile);
729 fputs ("NOPASS", dumpfile);
733 fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
735 fputs ("PASS", dumpfile);
737 if (tb->non_overridable)
738 fputs (", NON_OVERRIDABLE", dumpfile);
741 if (tb->access == ACCESS_PUBLIC)
742 fputs (", PUBLIC", dumpfile);
744 fputs (", PRIVATE", dumpfile);
746 fprintf (dumpfile, " :: %s => ", name);
751 for (g = tb->u.generic; g; g = g->next)
753 fputs (g->specific_st->name, dumpfile);
755 fputs (", ", dumpfile);
759 fputs (tb->u.specific->n.sym->name, dumpfile);
763 show_typebound_symtree (gfc_symtree* st)
765 gcc_assert (st->n.tb);
766 show_typebound_proc (st->n.tb, st->name);
770 show_f2k_derived (gfc_namespace* f2k)
776 fputs ("Procedure bindings:", dumpfile);
779 /* Finalizer bindings. */
780 for (f = f2k->finalizers; f; f = f->next)
783 fprintf (dumpfile, "FINAL %s", f->proc_sym->name);
786 /* Type-bound procedures. */
787 gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
792 fputs ("Operator bindings:", dumpfile);
795 /* User-defined operators. */
796 gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
798 /* Intrinsic operators. */
799 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
801 show_typebound_proc (f2k->tb_op[op],
802 gfc_op2string ((gfc_intrinsic_op) op));
808 /* Show a symbol. If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
809 show the interface. Information needed to reconstruct the list of
810 specific interfaces associated with a generic symbol is done within
814 show_symbol (gfc_symbol *sym)
816 gfc_formal_arglist *formal;
823 fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
824 len = strlen (sym->name);
825 for (i=len; i<12; i++)
826 fputc(' ', dumpfile);
831 fputs ("type spec : ", dumpfile);
832 show_typespec (&sym->ts);
835 fputs ("attributes: ", dumpfile);
836 show_attr (&sym->attr, sym->module);
841 fputs ("value: ", dumpfile);
842 show_expr (sym->value);
848 fputs ("Array spec:", dumpfile);
849 show_array_spec (sym->as);
855 fputs ("Generic interfaces:", dumpfile);
856 for (intr = sym->generic; intr; intr = intr->next)
857 fprintf (dumpfile, " %s", intr->sym->name);
863 fprintf (dumpfile, "result: %s", sym->result->name);
869 fputs ("components: ", dumpfile);
870 show_components (sym);
873 if (sym->f2k_derived)
877 fprintf (dumpfile, "hash: %d", sym->hash_value);
878 show_f2k_derived (sym->f2k_derived);
884 fputs ("Formal arglist:", dumpfile);
886 for (formal = sym->formal; formal; formal = formal->next)
888 if (formal->sym != NULL)
889 fprintf (dumpfile, " %s", formal->sym->name);
891 fputs (" [Alt Return]", dumpfile);
895 if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
896 && sym->attr.proc != PROC_ST_FUNCTION
900 fputs ("Formal namespace", dumpfile);
901 show_namespace (sym->formal_ns);
907 /* Show a user-defined operator. Just prints an operator
908 and the name of the associated subroutine, really. */
911 show_uop (gfc_user_op *uop)
916 fprintf (dumpfile, "%s:", uop->name);
918 for (intr = uop->op; intr; intr = intr->next)
919 fprintf (dumpfile, " %s", intr->sym->name);
923 /* Workhorse function for traversing the user operator symtree. */
926 traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
933 traverse_uop (st->left, func);
934 traverse_uop (st->right, func);
938 /* Traverse the tree of user operator nodes. */
941 gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
943 traverse_uop (ns->uop_root, func);
947 /* Function to display a common block. */
950 show_common (gfc_symtree *st)
955 fprintf (dumpfile, "common: /%s/ ", st->name);
957 s = st->n.common->head;
960 fprintf (dumpfile, "%s", s->name);
963 fputs (", ", dumpfile);
965 fputc ('\n', dumpfile);
969 /* Worker function to display the symbol tree. */
972 show_symtree (gfc_symtree *st)
978 len = strlen(st->name);
979 fprintf (dumpfile, "symtree: '%s'", st->name);
981 for (i=len; i<12; i++)
982 fputc(' ', dumpfile);
985 fputs( " Ambiguous", dumpfile);
987 if (st->n.sym->ns != gfc_current_ns)
988 fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
989 st->n.sym->ns->proc_name->name);
991 show_symbol (st->n.sym);
995 /******************* Show gfc_code structures **************/
998 /* Show a list of code structures. Mutually recursive with
1002 show_code (int level, gfc_code *c)
1004 for (; c; c = c->next)
1005 show_code_node (level, c);
1009 show_namelist (gfc_namelist *n)
1011 for (; n->next; n = n->next)
1012 fprintf (dumpfile, "%s,", n->sym->name);
1013 fprintf (dumpfile, "%s", n->sym->name);
1016 /* Show a single OpenMP directive node and everything underneath it
1020 show_omp_node (int level, gfc_code *c)
1022 gfc_omp_clauses *omp_clauses = NULL;
1023 const char *name = NULL;
1027 case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
1028 case EXEC_OMP_BARRIER: name = "BARRIER"; break;
1029 case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
1030 case EXEC_OMP_FLUSH: name = "FLUSH"; break;
1031 case EXEC_OMP_DO: name = "DO"; break;
1032 case EXEC_OMP_MASTER: name = "MASTER"; break;
1033 case EXEC_OMP_ORDERED: name = "ORDERED"; break;
1034 case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
1035 case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
1036 case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
1037 case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
1038 case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
1039 case EXEC_OMP_SINGLE: name = "SINGLE"; break;
1040 case EXEC_OMP_TASK: name = "TASK"; break;
1041 case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
1042 case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
1043 case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
1047 fprintf (dumpfile, "!$OMP %s", name);
1051 case EXEC_OMP_PARALLEL:
1052 case EXEC_OMP_PARALLEL_DO:
1053 case EXEC_OMP_PARALLEL_SECTIONS:
1054 case EXEC_OMP_SECTIONS:
1055 case EXEC_OMP_SINGLE:
1056 case EXEC_OMP_WORKSHARE:
1057 case EXEC_OMP_PARALLEL_WORKSHARE:
1059 omp_clauses = c->ext.omp_clauses;
1061 case EXEC_OMP_CRITICAL:
1062 if (c->ext.omp_name)
1063 fprintf (dumpfile, " (%s)", c->ext.omp_name);
1065 case EXEC_OMP_FLUSH:
1066 if (c->ext.omp_namelist)
1068 fputs (" (", dumpfile);
1069 show_namelist (c->ext.omp_namelist);
1070 fputc (')', dumpfile);
1073 case EXEC_OMP_BARRIER:
1074 case EXEC_OMP_TASKWAIT:
1075 case EXEC_OMP_TASKYIELD:
1084 if (omp_clauses->if_expr)
1086 fputs (" IF(", dumpfile);
1087 show_expr (omp_clauses->if_expr);
1088 fputc (')', dumpfile);
1090 if (omp_clauses->final_expr)
1092 fputs (" FINAL(", dumpfile);
1093 show_expr (omp_clauses->final_expr);
1094 fputc (')', dumpfile);
1096 if (omp_clauses->num_threads)
1098 fputs (" NUM_THREADS(", dumpfile);
1099 show_expr (omp_clauses->num_threads);
1100 fputc (')', dumpfile);
1102 if (omp_clauses->sched_kind != OMP_SCHED_NONE)
1105 switch (omp_clauses->sched_kind)
1107 case OMP_SCHED_STATIC: type = "STATIC"; break;
1108 case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
1109 case OMP_SCHED_GUIDED: type = "GUIDED"; break;
1110 case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
1111 case OMP_SCHED_AUTO: type = "AUTO"; break;
1115 fprintf (dumpfile, " SCHEDULE (%s", type);
1116 if (omp_clauses->chunk_size)
1118 fputc (',', dumpfile);
1119 show_expr (omp_clauses->chunk_size);
1121 fputc (')', dumpfile);
1123 if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
1126 switch (omp_clauses->default_sharing)
1128 case OMP_DEFAULT_NONE: type = "NONE"; break;
1129 case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
1130 case OMP_DEFAULT_SHARED: type = "SHARED"; break;
1131 case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1135 fprintf (dumpfile, " DEFAULT(%s)", type);
1137 if (omp_clauses->ordered)
1138 fputs (" ORDERED", dumpfile);
1139 if (omp_clauses->untied)
1140 fputs (" UNTIED", dumpfile);
1141 if (omp_clauses->mergeable)
1142 fputs (" MERGEABLE", dumpfile);
1143 if (omp_clauses->collapse)
1144 fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
1145 for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
1146 if (omp_clauses->lists[list_type] != NULL
1147 && list_type != OMP_LIST_COPYPRIVATE)
1150 if (list_type >= OMP_LIST_REDUCTION_FIRST)
1154 case OMP_LIST_PLUS: type = "+"; break;
1155 case OMP_LIST_MULT: type = "*"; break;
1156 case OMP_LIST_SUB: type = "-"; break;
1157 case OMP_LIST_AND: type = ".AND."; break;
1158 case OMP_LIST_OR: type = ".OR."; break;
1159 case OMP_LIST_EQV: type = ".EQV."; break;
1160 case OMP_LIST_NEQV: type = ".NEQV."; break;
1161 case OMP_LIST_MAX: type = "MAX"; break;
1162 case OMP_LIST_MIN: type = "MIN"; break;
1163 case OMP_LIST_IAND: type = "IAND"; break;
1164 case OMP_LIST_IOR: type = "IOR"; break;
1165 case OMP_LIST_IEOR: type = "IEOR"; break;
1169 fprintf (dumpfile, " REDUCTION(%s:", type);
1175 case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
1176 case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1177 case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
1178 case OMP_LIST_SHARED: type = "SHARED"; break;
1179 case OMP_LIST_COPYIN: type = "COPYIN"; break;
1183 fprintf (dumpfile, " %s(", type);
1185 show_namelist (omp_clauses->lists[list_type]);
1186 fputc (')', dumpfile);
1189 fputc ('\n', dumpfile);
1190 if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
1192 gfc_code *d = c->block;
1195 show_code (level + 1, d->next);
1196 if (d->block == NULL)
1198 code_indent (level, 0);
1199 fputs ("!$OMP SECTION\n", dumpfile);
1204 show_code (level + 1, c->block->next);
1205 if (c->op == EXEC_OMP_ATOMIC)
1207 code_indent (level, 0);
1208 fprintf (dumpfile, "!$OMP END %s", name);
1209 if (omp_clauses != NULL)
1211 if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
1213 fputs (" COPYPRIVATE(", dumpfile);
1214 show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
1215 fputc (')', dumpfile);
1217 else if (omp_clauses->nowait)
1218 fputs (" NOWAIT", dumpfile);
1220 else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
1221 fprintf (dumpfile, " (%s)", c->ext.omp_name);
1225 /* Show a single code node and everything underneath it if necessary. */
1228 show_code_node (int level, gfc_code *c)
1230 gfc_forall_iterator *fa;
1243 fputc ('\n', dumpfile);
1244 code_indent (level, c->here);
1251 case EXEC_END_PROCEDURE:
1255 fputs ("NOP", dumpfile);
1259 fputs ("CONTINUE", dumpfile);
1263 fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
1266 case EXEC_INIT_ASSIGN:
1268 fputs ("ASSIGN ", dumpfile);
1269 show_expr (c->expr1);
1270 fputc (' ', dumpfile);
1271 show_expr (c->expr2);
1274 case EXEC_LABEL_ASSIGN:
1275 fputs ("LABEL ASSIGN ", dumpfile);
1276 show_expr (c->expr1);
1277 fprintf (dumpfile, " %d", c->label1->value);
1280 case EXEC_POINTER_ASSIGN:
1281 fputs ("POINTER ASSIGN ", dumpfile);
1282 show_expr (c->expr1);
1283 fputc (' ', dumpfile);
1284 show_expr (c->expr2);
1288 fputs ("GOTO ", dumpfile);
1290 fprintf (dumpfile, "%d", c->label1->value);
1293 show_expr (c->expr1);
1297 fputs (", (", dumpfile);
1298 for (; d; d = d ->block)
1300 code_indent (level, d->label1);
1301 if (d->block != NULL)
1302 fputc (',', dumpfile);
1304 fputc (')', dumpfile);
1311 case EXEC_ASSIGN_CALL:
1312 if (c->resolved_sym)
1313 fprintf (dumpfile, "CALL %s ", c->resolved_sym->name);
1314 else if (c->symtree)
1315 fprintf (dumpfile, "CALL %s ", c->symtree->name);
1317 fputs ("CALL ?? ", dumpfile);
1319 show_actual_arglist (c->ext.actual);
1323 fputs ("CALL ", dumpfile);
1324 show_compcall (c->expr1);
1328 fputs ("CALL ", dumpfile);
1329 show_expr (c->expr1);
1330 show_actual_arglist (c->ext.actual);
1334 fputs ("RETURN ", dumpfile);
1336 show_expr (c->expr1);
1340 fputs ("PAUSE ", dumpfile);
1342 if (c->expr1 != NULL)
1343 show_expr (c->expr1);
1345 fprintf (dumpfile, "%d", c->ext.stop_code);
1349 case EXEC_ERROR_STOP:
1350 fputs ("ERROR ", dumpfile);
1354 fputs ("STOP ", dumpfile);
1356 if (c->expr1 != NULL)
1357 show_expr (c->expr1);
1359 fprintf (dumpfile, "%d", c->ext.stop_code);
1364 fputs ("SYNC ALL ", dumpfile);
1365 if (c->expr2 != NULL)
1367 fputs (" stat=", dumpfile);
1368 show_expr (c->expr2);
1370 if (c->expr3 != NULL)
1372 fputs (" errmsg=", dumpfile);
1373 show_expr (c->expr3);
1377 case EXEC_SYNC_MEMORY:
1378 fputs ("SYNC MEMORY ", dumpfile);
1379 if (c->expr2 != NULL)
1381 fputs (" stat=", dumpfile);
1382 show_expr (c->expr2);
1384 if (c->expr3 != NULL)
1386 fputs (" errmsg=", dumpfile);
1387 show_expr (c->expr3);
1391 case EXEC_SYNC_IMAGES:
1392 fputs ("SYNC IMAGES image-set=", dumpfile);
1393 if (c->expr1 != NULL)
1394 show_expr (c->expr1);
1396 fputs ("* ", dumpfile);
1397 if (c->expr2 != NULL)
1399 fputs (" stat=", dumpfile);
1400 show_expr (c->expr2);
1402 if (c->expr3 != NULL)
1404 fputs (" errmsg=", dumpfile);
1405 show_expr (c->expr3);
1411 if (c->op == EXEC_LOCK)
1412 fputs ("LOCK ", dumpfile);
1414 fputs ("UNLOCK ", dumpfile);
1416 fputs ("lock-variable=", dumpfile);
1417 if (c->expr1 != NULL)
1418 show_expr (c->expr1);
1419 if (c->expr4 != NULL)
1421 fputs (" acquired_lock=", dumpfile);
1422 show_expr (c->expr4);
1424 if (c->expr2 != NULL)
1426 fputs (" stat=", dumpfile);
1427 show_expr (c->expr2);
1429 if (c->expr3 != NULL)
1431 fputs (" errmsg=", dumpfile);
1432 show_expr (c->expr3);
1436 case EXEC_ARITHMETIC_IF:
1437 fputs ("IF ", dumpfile);
1438 show_expr (c->expr1);
1439 fprintf (dumpfile, " %d, %d, %d",
1440 c->label1->value, c->label2->value, c->label3->value);
1445 fputs ("IF ", dumpfile);
1446 show_expr (d->expr1);
1449 show_code (level + 1, d->next);
1453 for (; d; d = d->block)
1455 code_indent (level, 0);
1457 if (d->expr1 == NULL)
1458 fputs ("ELSE", dumpfile);
1461 fputs ("ELSE IF ", dumpfile);
1462 show_expr (d->expr1);
1466 show_code (level + 1, d->next);
1471 code_indent (level, c->label1);
1475 fputs ("ENDIF", dumpfile);
1480 const char* blocktype;
1481 gfc_namespace *saved_ns;
1483 if (c->ext.block.assoc)
1484 blocktype = "ASSOCIATE";
1486 blocktype = "BLOCK";
1488 fprintf (dumpfile, "%s ", blocktype);
1490 ns = c->ext.block.ns;
1491 saved_ns = gfc_current_ns;
1492 gfc_current_ns = ns;
1493 gfc_traverse_symtree (ns->sym_root, show_symtree);
1494 gfc_current_ns = saved_ns;
1495 show_code (show_level, ns->code);
1498 fprintf (dumpfile, "END %s ", blocktype);
1504 fputs ("SELECT CASE ", dumpfile);
1505 show_expr (c->expr1);
1506 fputc ('\n', dumpfile);
1508 for (; d; d = d->block)
1510 code_indent (level, 0);
1512 fputs ("CASE ", dumpfile);
1513 for (cp = d->ext.block.case_list; cp; cp = cp->next)
1515 fputc ('(', dumpfile);
1516 show_expr (cp->low);
1517 fputc (' ', dumpfile);
1518 show_expr (cp->high);
1519 fputc (')', dumpfile);
1520 fputc (' ', dumpfile);
1522 fputc ('\n', dumpfile);
1524 show_code (level + 1, d->next);
1527 code_indent (level, c->label1);
1528 fputs ("END SELECT", dumpfile);
1532 fputs ("WHERE ", dumpfile);
1535 show_expr (d->expr1);
1536 fputc ('\n', dumpfile);
1538 show_code (level + 1, d->next);
1540 for (d = d->block; d; d = d->block)
1542 code_indent (level, 0);
1543 fputs ("ELSE WHERE ", dumpfile);
1544 show_expr (d->expr1);
1545 fputc ('\n', dumpfile);
1546 show_code (level + 1, d->next);
1549 code_indent (level, 0);
1550 fputs ("END WHERE", dumpfile);
1555 fputs ("FORALL ", dumpfile);
1556 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
1558 show_expr (fa->var);
1559 fputc (' ', dumpfile);
1560 show_expr (fa->start);
1561 fputc (':', dumpfile);
1562 show_expr (fa->end);
1563 fputc (':', dumpfile);
1564 show_expr (fa->stride);
1566 if (fa->next != NULL)
1567 fputc (',', dumpfile);
1570 if (c->expr1 != NULL)
1572 fputc (',', dumpfile);
1573 show_expr (c->expr1);
1575 fputc ('\n', dumpfile);
1577 show_code (level + 1, c->block->next);
1579 code_indent (level, 0);
1580 fputs ("END FORALL", dumpfile);
1584 fputs ("CRITICAL\n", dumpfile);
1585 show_code (level + 1, c->block->next);
1586 code_indent (level, 0);
1587 fputs ("END CRITICAL", dumpfile);
1591 fputs ("DO ", dumpfile);
1593 fprintf (dumpfile, " %-5d ", c->label1->value);
1595 show_expr (c->ext.iterator->var);
1596 fputc ('=', dumpfile);
1597 show_expr (c->ext.iterator->start);
1598 fputc (' ', dumpfile);
1599 show_expr (c->ext.iterator->end);
1600 fputc (' ', dumpfile);
1601 show_expr (c->ext.iterator->step);
1604 show_code (level + 1, c->block->next);
1611 fputs ("END DO", dumpfile);
1614 case EXEC_DO_CONCURRENT:
1615 fputs ("DO CONCURRENT ", dumpfile);
1616 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
1618 show_expr (fa->var);
1619 fputc (' ', dumpfile);
1620 show_expr (fa->start);
1621 fputc (':', dumpfile);
1622 show_expr (fa->end);
1623 fputc (':', dumpfile);
1624 show_expr (fa->stride);
1626 if (fa->next != NULL)
1627 fputc (',', dumpfile);
1629 show_expr (c->expr1);
1631 show_code (level + 1, c->block->next);
1632 code_indent (level, c->label1);
1633 fputs ("END DO", dumpfile);
1637 fputs ("DO WHILE ", dumpfile);
1638 show_expr (c->expr1);
1639 fputc ('\n', dumpfile);
1641 show_code (level + 1, c->block->next);
1643 code_indent (level, c->label1);
1644 fputs ("END DO", dumpfile);
1648 fputs ("CYCLE", dumpfile);
1650 fprintf (dumpfile, " %s", c->symtree->n.sym->name);
1654 fputs ("EXIT", dumpfile);
1656 fprintf (dumpfile, " %s", c->symtree->n.sym->name);
1660 fputs ("ALLOCATE ", dumpfile);
1663 fputs (" STAT=", dumpfile);
1664 show_expr (c->expr1);
1669 fputs (" ERRMSG=", dumpfile);
1670 show_expr (c->expr2);
1676 fputs (" MOLD=", dumpfile);
1678 fputs (" SOURCE=", dumpfile);
1679 show_expr (c->expr3);
1682 for (a = c->ext.alloc.list; a; a = a->next)
1684 fputc (' ', dumpfile);
1685 show_expr (a->expr);
1690 case EXEC_DEALLOCATE:
1691 fputs ("DEALLOCATE ", dumpfile);
1694 fputs (" STAT=", dumpfile);
1695 show_expr (c->expr1);
1700 fputs (" ERRMSG=", dumpfile);
1701 show_expr (c->expr2);
1704 for (a = c->ext.alloc.list; a; a = a->next)
1706 fputc (' ', dumpfile);
1707 show_expr (a->expr);
1713 fputs ("OPEN", dumpfile);
1718 fputs (" UNIT=", dumpfile);
1719 show_expr (open->unit);
1723 fputs (" IOMSG=", dumpfile);
1724 show_expr (open->iomsg);
1728 fputs (" IOSTAT=", dumpfile);
1729 show_expr (open->iostat);
1733 fputs (" FILE=", dumpfile);
1734 show_expr (open->file);
1738 fputs (" STATUS=", dumpfile);
1739 show_expr (open->status);
1743 fputs (" ACCESS=", dumpfile);
1744 show_expr (open->access);
1748 fputs (" FORM=", dumpfile);
1749 show_expr (open->form);
1753 fputs (" RECL=", dumpfile);
1754 show_expr (open->recl);
1758 fputs (" BLANK=", dumpfile);
1759 show_expr (open->blank);
1763 fputs (" POSITION=", dumpfile);
1764 show_expr (open->position);
1768 fputs (" ACTION=", dumpfile);
1769 show_expr (open->action);
1773 fputs (" DELIM=", dumpfile);
1774 show_expr (open->delim);
1778 fputs (" PAD=", dumpfile);
1779 show_expr (open->pad);
1783 fputs (" DECIMAL=", dumpfile);
1784 show_expr (open->decimal);
1788 fputs (" ENCODING=", dumpfile);
1789 show_expr (open->encoding);
1793 fputs (" ROUND=", dumpfile);
1794 show_expr (open->round);
1798 fputs (" SIGN=", dumpfile);
1799 show_expr (open->sign);
1803 fputs (" CONVERT=", dumpfile);
1804 show_expr (open->convert);
1806 if (open->asynchronous)
1808 fputs (" ASYNCHRONOUS=", dumpfile);
1809 show_expr (open->asynchronous);
1811 if (open->err != NULL)
1812 fprintf (dumpfile, " ERR=%d", open->err->value);
1817 fputs ("CLOSE", dumpfile);
1818 close = c->ext.close;
1822 fputs (" UNIT=", dumpfile);
1823 show_expr (close->unit);
1827 fputs (" IOMSG=", dumpfile);
1828 show_expr (close->iomsg);
1832 fputs (" IOSTAT=", dumpfile);
1833 show_expr (close->iostat);
1837 fputs (" STATUS=", dumpfile);
1838 show_expr (close->status);
1840 if (close->err != NULL)
1841 fprintf (dumpfile, " ERR=%d", close->err->value);
1844 case EXEC_BACKSPACE:
1845 fputs ("BACKSPACE", dumpfile);
1849 fputs ("ENDFILE", dumpfile);
1853 fputs ("REWIND", dumpfile);
1857 fputs ("FLUSH", dumpfile);
1860 fp = c->ext.filepos;
1864 fputs (" UNIT=", dumpfile);
1865 show_expr (fp->unit);
1869 fputs (" IOMSG=", dumpfile);
1870 show_expr (fp->iomsg);
1874 fputs (" IOSTAT=", dumpfile);
1875 show_expr (fp->iostat);
1877 if (fp->err != NULL)
1878 fprintf (dumpfile, " ERR=%d", fp->err->value);
1882 fputs ("INQUIRE", dumpfile);
1887 fputs (" UNIT=", dumpfile);
1888 show_expr (i->unit);
1892 fputs (" FILE=", dumpfile);
1893 show_expr (i->file);
1898 fputs (" IOMSG=", dumpfile);
1899 show_expr (i->iomsg);
1903 fputs (" IOSTAT=", dumpfile);
1904 show_expr (i->iostat);
1908 fputs (" EXIST=", dumpfile);
1909 show_expr (i->exist);
1913 fputs (" OPENED=", dumpfile);
1914 show_expr (i->opened);
1918 fputs (" NUMBER=", dumpfile);
1919 show_expr (i->number);
1923 fputs (" NAMED=", dumpfile);
1924 show_expr (i->named);
1928 fputs (" NAME=", dumpfile);
1929 show_expr (i->name);
1933 fputs (" ACCESS=", dumpfile);
1934 show_expr (i->access);
1938 fputs (" SEQUENTIAL=", dumpfile);
1939 show_expr (i->sequential);
1944 fputs (" DIRECT=", dumpfile);
1945 show_expr (i->direct);
1949 fputs (" FORM=", dumpfile);
1950 show_expr (i->form);
1954 fputs (" FORMATTED", dumpfile);
1955 show_expr (i->formatted);
1959 fputs (" UNFORMATTED=", dumpfile);
1960 show_expr (i->unformatted);
1964 fputs (" RECL=", dumpfile);
1965 show_expr (i->recl);
1969 fputs (" NEXTREC=", dumpfile);
1970 show_expr (i->nextrec);
1974 fputs (" BLANK=", dumpfile);
1975 show_expr (i->blank);
1979 fputs (" POSITION=", dumpfile);
1980 show_expr (i->position);
1984 fputs (" ACTION=", dumpfile);
1985 show_expr (i->action);
1989 fputs (" READ=", dumpfile);
1990 show_expr (i->read);
1994 fputs (" WRITE=", dumpfile);
1995 show_expr (i->write);
1999 fputs (" READWRITE=", dumpfile);
2000 show_expr (i->readwrite);
2004 fputs (" DELIM=", dumpfile);
2005 show_expr (i->delim);
2009 fputs (" PAD=", dumpfile);
2014 fputs (" CONVERT=", dumpfile);
2015 show_expr (i->convert);
2017 if (i->asynchronous)
2019 fputs (" ASYNCHRONOUS=", dumpfile);
2020 show_expr (i->asynchronous);
2024 fputs (" DECIMAL=", dumpfile);
2025 show_expr (i->decimal);
2029 fputs (" ENCODING=", dumpfile);
2030 show_expr (i->encoding);
2034 fputs (" PENDING=", dumpfile);
2035 show_expr (i->pending);
2039 fputs (" ROUND=", dumpfile);
2040 show_expr (i->round);
2044 fputs (" SIGN=", dumpfile);
2045 show_expr (i->sign);
2049 fputs (" SIZE=", dumpfile);
2050 show_expr (i->size);
2054 fputs (" ID=", dumpfile);
2059 fprintf (dumpfile, " ERR=%d", i->err->value);
2063 fputs ("IOLENGTH ", dumpfile);
2064 show_expr (c->expr1);
2069 fputs ("READ", dumpfile);
2073 fputs ("WRITE", dumpfile);
2079 fputs (" UNIT=", dumpfile);
2080 show_expr (dt->io_unit);
2083 if (dt->format_expr)
2085 fputs (" FMT=", dumpfile);
2086 show_expr (dt->format_expr);
2089 if (dt->format_label != NULL)
2090 fprintf (dumpfile, " FMT=%d", dt->format_label->value);
2092 fprintf (dumpfile, " NML=%s", dt->namelist->name);
2096 fputs (" IOMSG=", dumpfile);
2097 show_expr (dt->iomsg);
2101 fputs (" IOSTAT=", dumpfile);
2102 show_expr (dt->iostat);
2106 fputs (" SIZE=", dumpfile);
2107 show_expr (dt->size);
2111 fputs (" REC=", dumpfile);
2112 show_expr (dt->rec);
2116 fputs (" ADVANCE=", dumpfile);
2117 show_expr (dt->advance);
2121 fputs (" ID=", dumpfile);
2126 fputs (" POS=", dumpfile);
2127 show_expr (dt->pos);
2129 if (dt->asynchronous)
2131 fputs (" ASYNCHRONOUS=", dumpfile);
2132 show_expr (dt->asynchronous);
2136 fputs (" BLANK=", dumpfile);
2137 show_expr (dt->blank);
2141 fputs (" DECIMAL=", dumpfile);
2142 show_expr (dt->decimal);
2146 fputs (" DELIM=", dumpfile);
2147 show_expr (dt->delim);
2151 fputs (" PAD=", dumpfile);
2152 show_expr (dt->pad);
2156 fputs (" ROUND=", dumpfile);
2157 show_expr (dt->round);
2161 fputs (" SIGN=", dumpfile);
2162 show_expr (dt->sign);
2166 for (c = c->block->next; c; c = c->next)
2167 show_code_node (level + (c->next != NULL), c);
2171 fputs ("TRANSFER ", dumpfile);
2172 show_expr (c->expr1);
2176 fputs ("DT_END", dumpfile);
2179 if (dt->err != NULL)
2180 fprintf (dumpfile, " ERR=%d", dt->err->value);
2181 if (dt->end != NULL)
2182 fprintf (dumpfile, " END=%d", dt->end->value);
2183 if (dt->eor != NULL)
2184 fprintf (dumpfile, " EOR=%d", dt->eor->value);
2187 case EXEC_OMP_ATOMIC:
2188 case EXEC_OMP_BARRIER:
2189 case EXEC_OMP_CRITICAL:
2190 case EXEC_OMP_FLUSH:
2192 case EXEC_OMP_MASTER:
2193 case EXEC_OMP_ORDERED:
2194 case EXEC_OMP_PARALLEL:
2195 case EXEC_OMP_PARALLEL_DO:
2196 case EXEC_OMP_PARALLEL_SECTIONS:
2197 case EXEC_OMP_PARALLEL_WORKSHARE:
2198 case EXEC_OMP_SECTIONS:
2199 case EXEC_OMP_SINGLE:
2201 case EXEC_OMP_TASKWAIT:
2202 case EXEC_OMP_TASKYIELD:
2203 case EXEC_OMP_WORKSHARE:
2204 show_omp_node (level, c);
2208 gfc_internal_error ("show_code_node(): Bad statement code");
2213 /* Show an equivalence chain. */
2216 show_equiv (gfc_equiv *eq)
2219 fputs ("Equivalence: ", dumpfile);
2222 show_expr (eq->expr);
2225 fputs (", ", dumpfile);
2230 /* Show a freakin' whole namespace. */
2233 show_namespace (gfc_namespace *ns)
2235 gfc_interface *intr;
2236 gfc_namespace *save;
2241 save = gfc_current_ns;
2244 fputs ("Namespace:", dumpfile);
2252 while (i < GFC_LETTERS - 1
2253 && gfc_compare_types(&ns->default_type[i+1],
2254 &ns->default_type[l]))
2258 fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
2260 fprintf (dumpfile, " %c: ", l+'A');
2262 show_typespec(&ns->default_type[l]);
2264 } while (i < GFC_LETTERS);
2266 if (ns->proc_name != NULL)
2269 fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
2273 gfc_current_ns = ns;
2274 gfc_traverse_symtree (ns->common_root, show_common);
2276 gfc_traverse_symtree (ns->sym_root, show_symtree);
2278 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
2280 /* User operator interfaces */
2286 fprintf (dumpfile, "Operator interfaces for %s:",
2287 gfc_op2string ((gfc_intrinsic_op) op));
2289 for (; intr; intr = intr->next)
2290 fprintf (dumpfile, " %s", intr->sym->name);
2293 if (ns->uop_root != NULL)
2296 fputs ("User operators:\n", dumpfile);
2297 gfc_traverse_user_op (ns, show_uop);
2303 for (eq = ns->equiv; eq; eq = eq->next)
2306 fputc ('\n', dumpfile);
2308 fputs ("code:", dumpfile);
2309 show_code (show_level, ns->code);
2312 for (ns = ns->contained; ns; ns = ns->sibling)
2314 fputs ("\nCONTAINS\n", dumpfile);
2316 show_namespace (ns);
2320 fputc ('\n', dumpfile);
2321 gfc_current_ns = save;
2325 /* Main function for dumping a parse tree. */
2328 gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
2331 show_namespace (ns);