?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* dwarf2out.c (gen_variable_die): For -gdwarf-5, use DW_TAG_variable
[official-gcc.git] / gcc / fortran / dump-parse-tree.c
blob36fc4cc096984219e0d6b2e67204f5caf271bc9a
1 /* Parse tree dumper
2 Copyright (C) 2003-2017 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 3, 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 COPYING3. If not see
19 <http://www.gnu.org/licenses/>. */
20
21
22 /* Actually this is just a collection of routines that used to be
23 scattered around the sources. Now that they are all in a single
24 file, almost all of them can be static, and the other files don't
25 have this mess in them.
26
27 As a nice side-effect, this file can act as documentation of the
28 gfc_code and gfc_expr structures and all their friends and
29 relatives.
30
31 TODO: Dump DATA. */
32
33 #include "config.h"
34 #include "system.h"
35 #include "coretypes.h"
36 #include "gfortran.h"
37 #include "constructor.h"
38
39 /* Keep track of indentation for symbol tree dumps. */
40 static int show_level = 0;
41
42 /* The file handle we're dumping to is kept in a static variable. This
43 is not too cool, but it avoids a lot of passing it around. */
44 static FILE *dumpfile;
45
46 /* Forward declaration of some of the functions. */
47 static void show_expr (gfc_expr *p);
48 static void show_code_node (int, gfc_code *);
49 static void show_namespace (gfc_namespace *ns);
50 static void show_code (int, gfc_code *);
51
52
53 /* Allow dumping of an expression in the debugger. */
54 void gfc_debug_expr (gfc_expr *);
55
56 void
57 gfc_debug_expr (gfc_expr *e)
58 {
59 FILE *tmp = dumpfile;
60 dumpfile = stderr;
61 show_expr (e);
62 fputc ('\n', dumpfile);
63 dumpfile = tmp;
64 }
65
66 /* Allow for dumping of a piece of code in the debugger. */
67 void gfc_debug_code (gfc_code *c);
68
69 void
70 gfc_debug_code (gfc_code *c)
71 {
72 FILE *tmp = dumpfile;
73 dumpfile = stderr;
74 show_code (1, c);
75 fputc ('\n', dumpfile);
76 dumpfile = tmp;
77 }
78
79 /* Do indentation for a specific level. */
80
81 static inline void
82 code_indent (int level, gfc_st_label *label)
83 {
84 int i;
85
86 if (label != NULL)
87 fprintf (dumpfile, "%-5d ", label->value);
88
89 for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
90 fputc (' ', dumpfile);
91 }
92
93
94 /* Simple indentation at the current level. This one
95 is used to show symbols. */
96
97 static inline void
98 show_indent (void)
99 {
100 fputc ('\n', dumpfile);
101 code_indent (show_level, NULL);
102 }
103
104
105 /* Show type-specific information. */
106
107 static void
108 show_typespec (gfc_typespec *ts)
109 {
110 if (ts->type == BT_ASSUMED)
111 {
112 fputs ("(TYPE(*))", dumpfile);
113 return;
114 }
115
116 fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
117
118 switch (ts->type)
119 {
120 case BT_DERIVED:
121 case BT_CLASS:
122 case BT_UNION:
123 fprintf (dumpfile, "%s", ts->u.derived->name);
124 break;
125
126 case BT_CHARACTER:
127 if (ts->u.cl)
128 show_expr (ts->u.cl->length);
129 fprintf(dumpfile, " %d", ts->kind);
130 break;
131
132 default:
133 fprintf (dumpfile, "%d", ts->kind);
134 break;
135 }
136 if (ts->is_c_interop)
137 fputs (" C_INTEROP", dumpfile);
138
139 if (ts->is_iso_c)
140 fputs (" ISO_C", dumpfile);
141
142 if (ts->deferred)
143 fputs (" DEFERRED", dumpfile);
144
145 fputc (')', dumpfile);
146 }
147
148
149 /* Show an actual argument list. */
150
151 static void
152 show_actual_arglist (gfc_actual_arglist *a)
153 {
154 fputc ('(', dumpfile);
155
156 for (; a; a = a->next)
157 {
158 fputc ('(', dumpfile);
159 if (a->name != NULL)
160 fprintf (dumpfile, "%s = ", a->name);
161 if (a->expr != NULL)
162 show_expr (a->expr);
163 else
164 fputs ("(arg not-present)", dumpfile);
165
166 fputc (')', dumpfile);
167 if (a->next != NULL)
168 fputc (' ', dumpfile);
169 }
170
171 fputc (')', dumpfile);
172 }
173
174
175 /* Show a gfc_array_spec array specification structure. */
176
177 static void
178 show_array_spec (gfc_array_spec *as)
179 {
180 const char *c;
181 int i;
182
183 if (as == NULL)
184 {
185 fputs ("()", dumpfile);
186 return;
187 }
188
189 fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
190
191 if (as->rank + as->corank > 0 || as->rank == -1)
192 {
193 switch (as->type)
194 {
195 case AS_EXPLICIT: c = "AS_EXPLICIT"; break;
196 case AS_DEFERRED: c = "AS_DEFERRED"; break;
197 case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break;
198 case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
199 case AS_ASSUMED_RANK: c = "AS_ASSUMED_RANK"; break;
200 default:
201 gfc_internal_error ("show_array_spec(): Unhandled array shape "
202 "type.");
203 }
204 fprintf (dumpfile, " %s ", c);
205
206 for (i = 0; i < as->rank + as->corank; i++)
207 {
208 show_expr (as->lower[i]);
209 fputc (' ', dumpfile);
210 show_expr (as->upper[i]);
211 fputc (' ', dumpfile);
212 }
213 }
214
215 fputc (')', dumpfile);
216 }
217
218
219 /* Show a gfc_array_ref array reference structure. */
220
221 static void
222 show_array_ref (gfc_array_ref * ar)
223 {
224 int i;
225
226 fputc ('(', dumpfile);
227
228 switch (ar->type)
229 {
230 case AR_FULL:
231 fputs ("FULL", dumpfile);
232 break;
233
234 case AR_SECTION:
235 for (i = 0; i < ar->dimen; i++)
236 {
237 /* There are two types of array sections: either the
238 elements are identified by an integer array ('vector'),
239 or by an index range. In the former case we only have to
240 print the start expression which contains the vector, in
241 the latter case we have to print any of lower and upper
242 bound and the stride, if they're present. */
243
244 if (ar->start[i] != NULL)
245 show_expr (ar->start[i]);
246
247 if (ar->dimen_type[i] == DIMEN_RANGE)
248 {
249 fputc (':', dumpfile);
250
251 if (ar->end[i] != NULL)
252 show_expr (ar->end[i]);
253
254 if (ar->stride[i] != NULL)
255 {
256 fputc (':', dumpfile);
257 show_expr (ar->stride[i]);
258 }
259 }
260
261 if (i != ar->dimen - 1)
262 fputs (" , ", dumpfile);
263 }
264 break;
265
266 case AR_ELEMENT:
267 for (i = 0; i < ar->dimen; i++)
268 {
269 show_expr (ar->start[i]);
270 if (i != ar->dimen - 1)
271 fputs (" , ", dumpfile);
272 }
273 break;
274
275 case AR_UNKNOWN:
276 fputs ("UNKNOWN", dumpfile);
277 break;
278
279 default:
280 gfc_internal_error ("show_array_ref(): Unknown array reference");
281 }
282
283 fputc (')', dumpfile);
284 }
285
286
287 /* Show a list of gfc_ref structures. */
288
289 static void
290 show_ref (gfc_ref *p)
291 {
292 for (; p; p = p->next)
293 switch (p->type)
294 {
295 case REF_ARRAY:
296 show_array_ref (&p->u.ar);
297 break;
298
299 case REF_COMPONENT:
300 fprintf (dumpfile, " %% %s", p->u.c.component->name);
301 break;
302
303 case REF_SUBSTRING:
304 fputc ('(', dumpfile);
305 show_expr (p->u.ss.start);
306 fputc (':', dumpfile);
307 show_expr (p->u.ss.end);
308 fputc (')', dumpfile);
309 break;
310
311 default:
312 gfc_internal_error ("show_ref(): Bad component code");
313 }
314 }
315
316
317 /* Display a constructor. Works recursively for array constructors. */
318
319 static void
320 show_constructor (gfc_constructor_base base)
321 {
322 gfc_constructor *c;
323 for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
324 {
325 if (c->iterator == NULL)
326 show_expr (c->expr);
327 else
328 {
329 fputc ('(', dumpfile);
330 show_expr (c->expr);
331
332 fputc (' ', dumpfile);
333 show_expr (c->iterator->var);
334 fputc ('=', dumpfile);
335 show_expr (c->iterator->start);
336 fputc (',', dumpfile);
337 show_expr (c->iterator->end);
338 fputc (',', dumpfile);
339 show_expr (c->iterator->step);
340
341 fputc (')', dumpfile);
342 }
343
344 if (gfc_constructor_next (c) != NULL)
345 fputs (" , ", dumpfile);
346 }
347 }
348
349
350 static void
351 show_char_const (const gfc_char_t *c, int length)
352 {
353 int i;
354
355 fputc ('\'', dumpfile);
356 for (i = 0; i < length; i++)
357 {
358 if (c[i] == '\'')
359 fputs ("''", dumpfile);
360 else
361 fputs (gfc_print_wide_char (c[i]), dumpfile);
362 }
363 fputc ('\'', dumpfile);
364 }
365
366
367 /* Show a component-call expression. */
368
369 static void
370 show_compcall (gfc_expr* p)
371 {
372 gcc_assert (p->expr_type == EXPR_COMPCALL);
373
374 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
375 show_ref (p->ref);
376 fprintf (dumpfile, "%s", p->value.compcall.name);
377
378 show_actual_arglist (p->value.compcall.actual);
379 }
380
381
382 /* Show an expression. */
383
384 static void
385 show_expr (gfc_expr *p)
386 {
387 const char *c;
388 int i;
389
390 if (p == NULL)
391 {
392 fputs ("()", dumpfile);
393 return;
394 }
395
396 switch (p->expr_type)
397 {
398 case EXPR_SUBSTRING:
399 show_char_const (p->value.character.string, p->value.character.length);
400 show_ref (p->ref);
401 break;
402
403 case EXPR_STRUCTURE:
404 fprintf (dumpfile, "%s(", p->ts.u.derived->name);
405 show_constructor (p->value.constructor);
406 fputc (')', dumpfile);
407 break;
408
409 case EXPR_ARRAY:
410 fputs ("(/ ", dumpfile);
411 show_constructor (p->value.constructor);
412 fputs (" /)", dumpfile);
413
414 show_ref (p->ref);
415 break;
416
417 case EXPR_NULL:
418 fputs ("NULL()", dumpfile);
419 break;
420
421 case EXPR_CONSTANT:
422 switch (p->ts.type)
423 {
424 case BT_INTEGER:
425 mpz_out_str (stdout, 10, p->value.integer);
426
427 if (p->ts.kind != gfc_default_integer_kind)
428 fprintf (dumpfile, "_%d", p->ts.kind);
429 break;
430
431 case BT_LOGICAL:
432 if (p->value.logical)
433 fputs (".true.", dumpfile);
434 else
435 fputs (".false.", dumpfile);
436 break;
437
438 case BT_REAL:
439 mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
440 if (p->ts.kind != gfc_default_real_kind)
441 fprintf (dumpfile, "_%d", p->ts.kind);
442 break;
443
444 case BT_CHARACTER:
445 show_char_const (p->value.character.string,
446 p->value.character.length);
447 break;
448
449 case BT_COMPLEX:
450 fputs ("(complex ", dumpfile);
451
452 mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
453 GFC_RND_MODE);
454 if (p->ts.kind != gfc_default_complex_kind)
455 fprintf (dumpfile, "_%d", p->ts.kind);
456
457 fputc (' ', dumpfile);
458
459 mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
460 GFC_RND_MODE);
461 if (p->ts.kind != gfc_default_complex_kind)
462 fprintf (dumpfile, "_%d", p->ts.kind);
463
464 fputc (')', dumpfile);
465 break;
466
467 case BT_HOLLERITH:
468 fprintf (dumpfile, "%dH", p->representation.length);
469 c = p->representation.string;
470 for (i = 0; i < p->representation.length; i++, c++)
471 {
472 fputc (*c, dumpfile);
473 }
474 break;
475
476 default:
477 fputs ("???", dumpfile);
478 break;
479 }
480
481 if (p->representation.string)
482 {
483 fputs (" {", dumpfile);
484 c = p->representation.string;
485 for (i = 0; i < p->representation.length; i++, c++)
486 {
487 fprintf (dumpfile, "%.2x", (unsigned int) *c);
488 if (i < p->representation.length - 1)
489 fputc (',', dumpfile);
490 }
491 fputc ('}', dumpfile);
492 }
493
494 break;
495
496 case EXPR_VARIABLE:
497 if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
498 fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
499 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
500 show_ref (p->ref);
501 break;
502
503 case EXPR_OP:
504 fputc ('(', dumpfile);
505 switch (p->value.op.op)
506 {
507 case INTRINSIC_UPLUS:
508 fputs ("U+ ", dumpfile);
509 break;
510 case INTRINSIC_UMINUS:
511 fputs ("U- ", dumpfile);
512 break;
513 case INTRINSIC_PLUS:
514 fputs ("+ ", dumpfile);
515 break;
516 case INTRINSIC_MINUS:
517 fputs ("- ", dumpfile);
518 break;
519 case INTRINSIC_TIMES:
520 fputs ("* ", dumpfile);
521 break;
522 case INTRINSIC_DIVIDE:
523 fputs ("/ ", dumpfile);
524 break;
525 case INTRINSIC_POWER:
526 fputs ("** ", dumpfile);
527 break;
528 case INTRINSIC_CONCAT:
529 fputs ("// ", dumpfile);
530 break;
531 case INTRINSIC_AND:
532 fputs ("AND ", dumpfile);
533 break;
534 case INTRINSIC_OR:
535 fputs ("OR ", dumpfile);
536 break;
537 case INTRINSIC_EQV:
538 fputs ("EQV ", dumpfile);
539 break;
540 case INTRINSIC_NEQV:
541 fputs ("NEQV ", dumpfile);
542 break;
543 case INTRINSIC_EQ:
544 case INTRINSIC_EQ_OS:
545 fputs ("= ", dumpfile);
546 break;
547 case INTRINSIC_NE:
548 case INTRINSIC_NE_OS:
549 fputs ("/= ", dumpfile);
550 break;
551 case INTRINSIC_GT:
552 case INTRINSIC_GT_OS:
553 fputs ("> ", dumpfile);
554 break;
555 case INTRINSIC_GE:
556 case INTRINSIC_GE_OS:
557 fputs (">= ", dumpfile);
558 break;
559 case INTRINSIC_LT:
560 case INTRINSIC_LT_OS:
561 fputs ("< ", dumpfile);
562 break;
563 case INTRINSIC_LE:
564 case INTRINSIC_LE_OS:
565 fputs ("<= ", dumpfile);
566 break;
567 case INTRINSIC_NOT:
568 fputs ("NOT ", dumpfile);
569 break;
570 case INTRINSIC_PARENTHESES:
571 fputs ("parens ", dumpfile);
572 break;
573
574 default:
575 gfc_internal_error
576 ("show_expr(): Bad intrinsic in expression!");
577 }
578
579 show_expr (p->value.op.op1);
580
581 if (p->value.op.op2)
582 {
583 fputc (' ', dumpfile);
584 show_expr (p->value.op.op2);
585 }
586
587 fputc (')', dumpfile);
588 break;
589
590 case EXPR_FUNCTION:
591 if (p->value.function.name == NULL)
592 {
593 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
594 if (gfc_is_proc_ptr_comp (p))
595 show_ref (p->ref);
596 fputc ('[', dumpfile);
597 show_actual_arglist (p->value.function.actual);
598 fputc (']', dumpfile);
599 }
600 else
601 {
602 fprintf (dumpfile, "%s", p->value.function.name);
603 if (gfc_is_proc_ptr_comp (p))
604 show_ref (p->ref);
605 fputc ('[', dumpfile);
606 fputc ('[', dumpfile);
607 show_actual_arglist (p->value.function.actual);
608 fputc (']', dumpfile);
609 fputc (']', dumpfile);
610 }
611
612 break;
613
614 case EXPR_COMPCALL:
615 show_compcall (p);
616 break;
617
618 default:
619 gfc_internal_error ("show_expr(): Don't know how to show expr");
620 }
621 }
622
623 /* Show symbol attributes. The flavor and intent are followed by
624 whatever single bit attributes are present. */
625
626 static void
627 show_attr (symbol_attribute *attr, const char * module)
628 {
629 if (attr->flavor != FL_UNKNOWN)
630 fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
631 if (attr->access != ACCESS_UNKNOWN)
632 fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
633 if (attr->proc != PROC_UNKNOWN)
634 fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
635 if (attr->save != SAVE_NONE)
636 fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
637
638 if (attr->artificial)
639 fputs (" ARTIFICIAL", dumpfile);
640 if (attr->allocatable)
641 fputs (" ALLOCATABLE", dumpfile);
642 if (attr->asynchronous)
643 fputs (" ASYNCHRONOUS", dumpfile);
644 if (attr->codimension)
645 fputs (" CODIMENSION", dumpfile);
646 if (attr->dimension)
647 fputs (" DIMENSION", dumpfile);
648 if (attr->contiguous)
649 fputs (" CONTIGUOUS", dumpfile);
650 if (attr->external)
651 fputs (" EXTERNAL", dumpfile);
652 if (attr->intrinsic)
653 fputs (" INTRINSIC", dumpfile);
654 if (attr->optional)
655 fputs (" OPTIONAL", dumpfile);
656 if (attr->pointer)
657 fputs (" POINTER", dumpfile);
658 if (attr->is_protected)
659 fputs (" PROTECTED", dumpfile);
660 if (attr->value)
661 fputs (" VALUE", dumpfile);
662 if (attr->volatile_)
663 fputs (" VOLATILE", dumpfile);
664 if (attr->threadprivate)
665 fputs (" THREADPRIVATE", dumpfile);
666 if (attr->target)
667 fputs (" TARGET", dumpfile);
668 if (attr->dummy)
669 {
670 fputs (" DUMMY", dumpfile);
671 if (attr->intent != INTENT_UNKNOWN)
672 fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
673 }
674
675 if (attr->result)
676 fputs (" RESULT", dumpfile);
677 if (attr->entry)
678 fputs (" ENTRY", dumpfile);
679 if (attr->is_bind_c)
680 fputs (" BIND(C)", dumpfile);
681
682 if (attr->data)
683 fputs (" DATA", dumpfile);
684 if (attr->use_assoc)
685 {
686 fputs (" USE-ASSOC", dumpfile);
687 if (module != NULL)
688 fprintf (dumpfile, "(%s)", module);
689 }
690
691 if (attr->in_namelist)
692 fputs (" IN-NAMELIST", dumpfile);
693 if (attr->in_common)
694 fputs (" IN-COMMON", dumpfile);
695
696 if (attr->abstract)
697 fputs (" ABSTRACT", dumpfile);
698 if (attr->function)
699 fputs (" FUNCTION", dumpfile);
700 if (attr->subroutine)
701 fputs (" SUBROUTINE", dumpfile);
702 if (attr->implicit_type)
703 fputs (" IMPLICIT-TYPE", dumpfile);
704
705 if (attr->sequence)
706 fputs (" SEQUENCE", dumpfile);
707 if (attr->elemental)
708 fputs (" ELEMENTAL", dumpfile);
709 if (attr->pure)
710 fputs (" PURE", dumpfile);
711 if (attr->recursive)
712 fputs (" RECURSIVE", dumpfile);
713
714 fputc (')', dumpfile);
715 }
716
717
718 /* Show components of a derived type. */
719
720 static void
721 show_components (gfc_symbol *sym)
722 {
723 gfc_component *c;
724
725 for (c = sym->components; c; c = c->next)
726 {
727 fprintf (dumpfile, "(%s ", c->name);
728 show_typespec (&c->ts);
729 if (c->attr.allocatable)
730 fputs (" ALLOCATABLE", dumpfile);
731 if (c->attr.pointer)
732 fputs (" POINTER", dumpfile);
733 if (c->attr.proc_pointer)
734 fputs (" PPC", dumpfile);
735 if (c->attr.dimension)
736 fputs (" DIMENSION", dumpfile);
737 fputc (' ', dumpfile);
738 show_array_spec (c->as);
739 if (c->attr.access)
740 fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
741 fputc (')', dumpfile);
742 if (c->next != NULL)
743 fputc (' ', dumpfile);
744 }
745 }
746
747
748 /* Show the f2k_derived namespace with procedure bindings. */
749
750 static void
751 show_typebound_proc (gfc_typebound_proc* tb, const char* name)
752 {
753 show_indent ();
754
755 if (tb->is_generic)
756 fputs ("GENERIC", dumpfile);
757 else
758 {
759 fputs ("PROCEDURE, ", dumpfile);
760 if (tb->nopass)
761 fputs ("NOPASS", dumpfile);
762 else
763 {
764 if (tb->pass_arg)
765 fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
766 else
767 fputs ("PASS", dumpfile);
768 }
769 if (tb->non_overridable)
770 fputs (", NON_OVERRIDABLE", dumpfile);
771 }
772
773 if (tb->access == ACCESS_PUBLIC)
774 fputs (", PUBLIC", dumpfile);
775 else
776 fputs (", PRIVATE", dumpfile);
777
778 fprintf (dumpfile, " :: %s => ", name);
779
780 if (tb->is_generic)
781 {
782 gfc_tbp_generic* g;
783 for (g = tb->u.generic; g; g = g->next)
784 {
785 fputs (g->specific_st->name, dumpfile);
786 if (g->next)
787 fputs (", ", dumpfile);
788 }
789 }
790 else
791 fputs (tb->u.specific->n.sym->name, dumpfile);
792 }
793
794 static void
795 show_typebound_symtree (gfc_symtree* st)
796 {
797 gcc_assert (st->n.tb);
798 show_typebound_proc (st->n.tb, st->name);
799 }
800
801 static void
802 show_f2k_derived (gfc_namespace* f2k)
803 {
804 gfc_finalizer* f;
805 int op;
806
807 show_indent ();
808 fputs ("Procedure bindings:", dumpfile);
809 ++show_level;
810
811 /* Finalizer bindings. */
812 for (f = f2k->finalizers; f; f = f->next)
813 {
814 show_indent ();
815 fprintf (dumpfile, "FINAL %s", f->proc_tree->n.sym->name);
816 }
817
818 /* Type-bound procedures. */
819 gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
820
821 --show_level;
822
823 show_indent ();
824 fputs ("Operator bindings:", dumpfile);
825 ++show_level;
826
827 /* User-defined operators. */
828 gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
829
830 /* Intrinsic operators. */
831 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
832 if (f2k->tb_op[op])
833 show_typebound_proc (f2k->tb_op[op],
834 gfc_op2string ((gfc_intrinsic_op) op));
835
836 --show_level;
837 }
838
839
840 /* Show a symbol. If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
841 show the interface. Information needed to reconstruct the list of
842 specific interfaces associated with a generic symbol is done within
843 that symbol. */
844
845 static void
846 show_symbol (gfc_symbol *sym)
847 {
848 gfc_formal_arglist *formal;
849 gfc_interface *intr;
850 int i,len;
851
852 if (sym == NULL)
853 return;
854
855 fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
856 len = strlen (sym->name);
857 for (i=len; i<12; i++)
858 fputc(' ', dumpfile);
859
860 ++show_level;
861
862 show_indent ();
863 fputs ("type spec : ", dumpfile);
864 show_typespec (&sym->ts);
865
866 show_indent ();
867 fputs ("attributes: ", dumpfile);
868 show_attr (&sym->attr, sym->module);
869
870 if (sym->value)
871 {
872 show_indent ();
873 fputs ("value: ", dumpfile);
874 show_expr (sym->value);
875 }
876
877 if (sym->as)
878 {
879 show_indent ();
880 fputs ("Array spec:", dumpfile);
881 show_array_spec (sym->as);
882 }
883
884 if (sym->generic)
885 {
886 show_indent ();
887 fputs ("Generic interfaces:", dumpfile);
888 for (intr = sym->generic; intr; intr = intr->next)
889 fprintf (dumpfile, " %s", intr->sym->name);
890 }
891
892 if (sym->result)
893 {
894 show_indent ();
895 fprintf (dumpfile, "result: %s", sym->result->name);
896 }
897
898 if (sym->components)
899 {
900 show_indent ();
901 fputs ("components: ", dumpfile);
902 show_components (sym);
903 }
904
905 if (sym->f2k_derived)
906 {
907 show_indent ();
908 if (sym->hash_value)
909 fprintf (dumpfile, "hash: %d", sym->hash_value);
910 show_f2k_derived (sym->f2k_derived);
911 }
912
913 if (sym->formal)
914 {
915 show_indent ();
916 fputs ("Formal arglist:", dumpfile);
917
918 for (formal = sym->formal; formal; formal = formal->next)
919 {
920 if (formal->sym != NULL)
921 fprintf (dumpfile, " %s", formal->sym->name);
922 else
923 fputs (" [Alt Return]", dumpfile);
924 }
925 }
926
927 if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
928 && sym->attr.proc != PROC_ST_FUNCTION
929 && !sym->attr.entry)
930 {
931 show_indent ();
932 fputs ("Formal namespace", dumpfile);
933 show_namespace (sym->formal_ns);
934 }
935 --show_level;
936 }
937
938
939 /* Show a user-defined operator. Just prints an operator
940 and the name of the associated subroutine, really. */
941
942 static void
943 show_uop (gfc_user_op *uop)
944 {
945 gfc_interface *intr;
946
947 show_indent ();
948 fprintf (dumpfile, "%s:", uop->name);
949
950 for (intr = uop->op; intr; intr = intr->next)
951 fprintf (dumpfile, " %s", intr->sym->name);
952 }
953
954
955 /* Workhorse function for traversing the user operator symtree. */
956
957 static void
958 traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
959 {
960 if (st == NULL)
961 return;
962
963 (*func) (st->n.uop);
964
965 traverse_uop (st->left, func);
966 traverse_uop (st->right, func);
967 }
968
969
970 /* Traverse the tree of user operator nodes. */
971
972 void
973 gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
974 {
975 traverse_uop (ns->uop_root, func);
976 }
977
978
979 /* Function to display a common block. */
980
981 static void
982 show_common (gfc_symtree *st)
983 {
984 gfc_symbol *s;
985
986 show_indent ();
987 fprintf (dumpfile, "common: /%s/ ", st->name);
988
989 s = st->n.common->head;
990 while (s)
991 {
992 fprintf (dumpfile, "%s", s->name);
993 s = s->common_next;
994 if (s)
995 fputs (", ", dumpfile);
996 }
997 fputc ('\n', dumpfile);
998 }
999
1000
1001 /* Worker function to display the symbol tree. */
1002
1003 static void
1004 show_symtree (gfc_symtree *st)
1005 {
1006 int len, i;
1007
1008 show_indent ();
1009
1010 len = strlen(st->name);
1011 fprintf (dumpfile, "symtree: '%s'", st->name);
1012
1013 for (i=len; i<12; i++)
1014 fputc(' ', dumpfile);
1015
1016 if (st->ambiguous)
1017 fputs( " Ambiguous", dumpfile);
1018
1019 if (st->n.sym->ns != gfc_current_ns)
1020 fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
1021 st->n.sym->ns->proc_name->name);
1022 else
1023 show_symbol (st->n.sym);
1024 }
1025
1026
1027 /******************* Show gfc_code structures **************/
1028
1029
1030 /* Show a list of code structures. Mutually recursive with
1031 show_code_node(). */
1032
1033 static void
1034 show_code (int level, gfc_code *c)
1035 {
1036 for (; c; c = c->next)
1037 show_code_node (level, c);
1038 }
1039
1040 static void
1041 show_omp_namelist (int list_type, gfc_omp_namelist *n)
1042 {
1043 for (; n; n = n->next)
1044 {
1045 if (list_type == OMP_LIST_REDUCTION)
1046 switch (n->u.reduction_op)
1047 {
1048 case OMP_REDUCTION_PLUS:
1049 case OMP_REDUCTION_TIMES:
1050 case OMP_REDUCTION_MINUS:
1051 case OMP_REDUCTION_AND:
1052 case OMP_REDUCTION_OR:
1053 case OMP_REDUCTION_EQV:
1054 case OMP_REDUCTION_NEQV:
1055 fprintf (dumpfile, "%s:",
1056 gfc_op2string ((gfc_intrinsic_op) n->u.reduction_op));
1057 break;
1058 case OMP_REDUCTION_MAX: fputs ("max:", dumpfile); break;
1059 case OMP_REDUCTION_MIN: fputs ("min:", dumpfile); break;
1060 case OMP_REDUCTION_IAND: fputs ("iand:", dumpfile); break;
1061 case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break;
1062 case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
1063 case OMP_REDUCTION_USER:
1064 if (n->udr)
1065 fprintf (dumpfile, "%s:", n->udr->udr->name);
1066 break;
1067 default: break;
1068 }
1069 else if (list_type == OMP_LIST_DEPEND)
1070 switch (n->u.depend_op)
1071 {
1072 case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
1073 case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
1074 case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
1075 case OMP_DEPEND_SINK_FIRST:
1076 fputs ("sink:", dumpfile);
1077 while (1)
1078 {
1079 fprintf (dumpfile, "%s", n->sym->name);
1080 if (n->expr)
1081 {
1082 fputc ('+', dumpfile);
1083 show_expr (n->expr);
1084 }
1085 if (n->next == NULL)
1086 break;
1087 else if (n->next->u.depend_op != OMP_DEPEND_SINK)
1088 {
1089 fputs (") DEPEND(", dumpfile);
1090 break;
1091 }
1092 fputc (',', dumpfile);
1093 n = n->next;
1094 }
1095 continue;
1096 default: break;
1097 }
1098 else if (list_type == OMP_LIST_MAP)
1099 switch (n->u.map_op)
1100 {
1101 case OMP_MAP_ALLOC: fputs ("alloc:", dumpfile); break;
1102 case OMP_MAP_TO: fputs ("to:", dumpfile); break;
1103 case OMP_MAP_FROM: fputs ("from:", dumpfile); break;
1104 case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break;
1105 default: break;
1106 }
1107 else if (list_type == OMP_LIST_LINEAR)
1108 switch (n->u.linear_op)
1109 {
1110 case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break;
1111 case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break;
1112 case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
1113 default: break;
1114 }
1115 fprintf (dumpfile, "%s", n->sym->name);
1116 if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
1117 fputc (')', dumpfile);
1118 if (n->expr)
1119 {
1120 fputc (':', dumpfile);
1121 show_expr (n->expr);
1122 }
1123 if (n->next)
1124 fputc (',', dumpfile);
1125 }
1126 }
1127
1128
1129 /* Show OpenMP or OpenACC clauses. */
1130
1131 static void
1132 show_omp_clauses (gfc_omp_clauses *omp_clauses)
1133 {
1134 int list_type, i;
1135
1136 switch (omp_clauses->cancel)
1137 {
1138 case OMP_CANCEL_UNKNOWN:
1139 break;
1140 case OMP_CANCEL_PARALLEL:
1141 fputs (" PARALLEL", dumpfile);
1142 break;
1143 case OMP_CANCEL_SECTIONS:
1144 fputs (" SECTIONS", dumpfile);
1145 break;
1146 case OMP_CANCEL_DO:
1147 fputs (" DO", dumpfile);
1148 break;
1149 case OMP_CANCEL_TASKGROUP:
1150 fputs (" TASKGROUP", dumpfile);
1151 break;
1152 }
1153 if (omp_clauses->if_expr)
1154 {
1155 fputs (" IF(", dumpfile);
1156 show_expr (omp_clauses->if_expr);
1157 fputc (')', dumpfile);
1158 }
1159 if (omp_clauses->final_expr)
1160 {
1161 fputs (" FINAL(", dumpfile);
1162 show_expr (omp_clauses->final_expr);
1163 fputc (')', dumpfile);
1164 }
1165 if (omp_clauses->num_threads)
1166 {
1167 fputs (" NUM_THREADS(", dumpfile);
1168 show_expr (omp_clauses->num_threads);
1169 fputc (')', dumpfile);
1170 }
1171 if (omp_clauses->async)
1172 {
1173 fputs (" ASYNC", dumpfile);
1174 if (omp_clauses->async_expr)
1175 {
1176 fputc ('(', dumpfile);
1177 show_expr (omp_clauses->async_expr);
1178 fputc (')', dumpfile);
1179 }
1180 }
1181 if (omp_clauses->num_gangs_expr)
1182 {
1183 fputs (" NUM_GANGS(", dumpfile);
1184 show_expr (omp_clauses->num_gangs_expr);
1185 fputc (')', dumpfile);
1186 }
1187 if (omp_clauses->num_workers_expr)
1188 {
1189 fputs (" NUM_WORKERS(", dumpfile);
1190 show_expr (omp_clauses->num_workers_expr);
1191 fputc (')', dumpfile);
1192 }
1193 if (omp_clauses->vector_length_expr)
1194 {
1195 fputs (" VECTOR_LENGTH(", dumpfile);
1196 show_expr (omp_clauses->vector_length_expr);
1197 fputc (')', dumpfile);
1198 }
1199 if (omp_clauses->gang)
1200 {
1201 fputs (" GANG", dumpfile);
1202 if (omp_clauses->gang_num_expr || omp_clauses->gang_static_expr)
1203 {
1204 fputc ('(', dumpfile);
1205 if (omp_clauses->gang_num_expr)
1206 {
1207 fprintf (dumpfile, "num:");
1208 show_expr (omp_clauses->gang_num_expr);
1209 }
1210 if (omp_clauses->gang_num_expr && omp_clauses->gang_static)
1211 fputc (',', dumpfile);
1212 if (omp_clauses->gang_static)
1213 {
1214 fprintf (dumpfile, "static:");
1215 if (omp_clauses->gang_static_expr)
1216 show_expr (omp_clauses->gang_static_expr);
1217 else
1218 fputc ('*', dumpfile);
1219 }
1220 fputc (')', dumpfile);
1221 }
1222 }
1223 if (omp_clauses->worker)
1224 {
1225 fputs (" WORKER", dumpfile);
1226 if (omp_clauses->worker_expr)
1227 {
1228 fputc ('(', dumpfile);
1229 show_expr (omp_clauses->worker_expr);
1230 fputc (')', dumpfile);
1231 }
1232 }
1233 if (omp_clauses->vector)
1234 {
1235 fputs (" VECTOR", dumpfile);
1236 if (omp_clauses->vector_expr)
1237 {
1238 fputc ('(', dumpfile);
1239 show_expr (omp_clauses->vector_expr);
1240 fputc (')', dumpfile);
1241 }
1242 }
1243 if (omp_clauses->sched_kind != OMP_SCHED_NONE)
1244 {
1245 const char *type;
1246 switch (omp_clauses->sched_kind)
1247 {
1248 case OMP_SCHED_STATIC: type = "STATIC"; break;
1249 case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
1250 case OMP_SCHED_GUIDED: type = "GUIDED"; break;
1251 case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
1252 case OMP_SCHED_AUTO: type = "AUTO"; break;
1253 default:
1254 gcc_unreachable ();
1255 }
1256 fputs (" SCHEDULE (", dumpfile);
1257 if (omp_clauses->sched_simd)
1258 {
1259 if (omp_clauses->sched_monotonic
1260 || omp_clauses->sched_nonmonotonic)
1261 fputs ("SIMD, ", dumpfile);
1262 else
1263 fputs ("SIMD: ", dumpfile);
1264 }
1265 if (omp_clauses->sched_monotonic)
1266 fputs ("MONOTONIC: ", dumpfile);
1267 else if (omp_clauses->sched_nonmonotonic)
1268 fputs ("NONMONOTONIC: ", dumpfile);
1269 fputs (type, dumpfile);
1270 if (omp_clauses->chunk_size)
1271 {
1272 fputc (',', dumpfile);
1273 show_expr (omp_clauses->chunk_size);
1274 }
1275 fputc (')', dumpfile);
1276 }
1277 if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
1278 {
1279 const char *type;
1280 switch (omp_clauses->default_sharing)
1281 {
1282 case OMP_DEFAULT_NONE: type = "NONE"; break;
1283 case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
1284 case OMP_DEFAULT_SHARED: type = "SHARED"; break;
1285 case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1286 default:
1287 gcc_unreachable ();
1288 }
1289 fprintf (dumpfile, " DEFAULT(%s)", type);
1290 }
1291 if (omp_clauses->tile_list)
1292 {
1293 gfc_expr_list *list;
1294 fputs (" TILE(", dumpfile);
1295 for (list = omp_clauses->tile_list; list; list = list->next)
1296 {
1297 show_expr (list->expr);
1298 if (list->next)
1299 fputs (", ", dumpfile);
1300 }
1301 fputc (')', dumpfile);
1302 }
1303 if (omp_clauses->wait_list)
1304 {
1305 gfc_expr_list *list;
1306 fputs (" WAIT(", dumpfile);
1307 for (list = omp_clauses->wait_list; list; list = list->next)
1308 {
1309 show_expr (list->expr);
1310 if (list->next)
1311 fputs (", ", dumpfile);
1312 }
1313 fputc (')', dumpfile);
1314 }
1315 if (omp_clauses->seq)
1316 fputs (" SEQ", dumpfile);
1317 if (omp_clauses->independent)
1318 fputs (" INDEPENDENT", dumpfile);
1319 if (omp_clauses->ordered)
1320 {
1321 if (omp_clauses->orderedc)
1322 fprintf (dumpfile, " ORDERED(%d)", omp_clauses->orderedc);
1323 else
1324 fputs (" ORDERED", dumpfile);
1325 }
1326 if (omp_clauses->untied)
1327 fputs (" UNTIED", dumpfile);
1328 if (omp_clauses->mergeable)
1329 fputs (" MERGEABLE", dumpfile);
1330 if (omp_clauses->collapse)
1331 fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
1332 for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
1333 if (omp_clauses->lists[list_type] != NULL
1334 && list_type != OMP_LIST_COPYPRIVATE)
1335 {
1336 const char *type = NULL;
1337 switch (list_type)
1338 {
1339 case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
1340 case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
1341 case OMP_LIST_CACHE: type = ""; break;
1342 case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
1343 case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1344 case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
1345 case OMP_LIST_SHARED: type = "SHARED"; break;
1346 case OMP_LIST_COPYIN: type = "COPYIN"; break;
1347 case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
1348 case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
1349 case OMP_LIST_LINEAR: type = "LINEAR"; break;
1350 case OMP_LIST_REDUCTION: type = "REDUCTION"; break;
1351 case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break;
1352 case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
1353 case OMP_LIST_DEPEND: type = "DEPEND"; break;
1354 default:
1355 gcc_unreachable ();
1356 }
1357 fprintf (dumpfile, " %s(", type);
1358 show_omp_namelist (list_type, omp_clauses->lists[list_type]);
1359 fputc (')', dumpfile);
1360 }
1361 if (omp_clauses->safelen_expr)
1362 {
1363 fputs (" SAFELEN(", dumpfile);
1364 show_expr (omp_clauses->safelen_expr);
1365 fputc (')', dumpfile);
1366 }
1367 if (omp_clauses->simdlen_expr)
1368 {
1369 fputs (" SIMDLEN(", dumpfile);
1370 show_expr (omp_clauses->simdlen_expr);
1371 fputc (')', dumpfile);
1372 }
1373 if (omp_clauses->inbranch)
1374 fputs (" INBRANCH", dumpfile);
1375 if (omp_clauses->notinbranch)
1376 fputs (" NOTINBRANCH", dumpfile);
1377 if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
1378 {
1379 const char *type;
1380 switch (omp_clauses->proc_bind)
1381 {
1382 case OMP_PROC_BIND_MASTER: type = "MASTER"; break;
1383 case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break;
1384 case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break;
1385 default:
1386 gcc_unreachable ();
1387 }
1388 fprintf (dumpfile, " PROC_BIND(%s)", type);
1389 }
1390 if (omp_clauses->num_teams)
1391 {
1392 fputs (" NUM_TEAMS(", dumpfile);
1393 show_expr (omp_clauses->num_teams);
1394 fputc (')', dumpfile);
1395 }
1396 if (omp_clauses->device)
1397 {
1398 fputs (" DEVICE(", dumpfile);
1399 show_expr (omp_clauses->device);
1400 fputc (')', dumpfile);
1401 }
1402 if (omp_clauses->thread_limit)
1403 {
1404 fputs (" THREAD_LIMIT(", dumpfile);
1405 show_expr (omp_clauses->thread_limit);
1406 fputc (')', dumpfile);
1407 }
1408 if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE)
1409 {
1410 fprintf (dumpfile, " DIST_SCHEDULE (STATIC");
1411 if (omp_clauses->dist_chunk_size)
1412 {
1413 fputc (',', dumpfile);
1414 show_expr (omp_clauses->dist_chunk_size);
1415 }
1416 fputc (')', dumpfile);
1417 }
1418 if (omp_clauses->defaultmap)
1419 fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile);
1420 if (omp_clauses->nogroup)
1421 fputs (" NOGROUP", dumpfile);
1422 if (omp_clauses->simd)
1423 fputs (" SIMD", dumpfile);
1424 if (omp_clauses->threads)
1425 fputs (" THREADS", dumpfile);
1426 if (omp_clauses->grainsize)
1427 {
1428 fputs (" GRAINSIZE(", dumpfile);
1429 show_expr (omp_clauses->grainsize);
1430 fputc (')', dumpfile);
1431 }
1432 if (omp_clauses->hint)
1433 {
1434 fputs (" HINT(", dumpfile);
1435 show_expr (omp_clauses->hint);
1436 fputc (')', dumpfile);
1437 }
1438 if (omp_clauses->num_tasks)
1439 {
1440 fputs (" NUM_TASKS(", dumpfile);
1441 show_expr (omp_clauses->num_tasks);
1442 fputc (')', dumpfile);
1443 }
1444 if (omp_clauses->priority)
1445 {
1446 fputs (" PRIORITY(", dumpfile);
1447 show_expr (omp_clauses->priority);
1448 fputc (')', dumpfile);
1449 }
1450 for (i = 0; i < OMP_IF_LAST; i++)
1451 if (omp_clauses->if_exprs[i])
1452 {
1453 static const char *ifs[] = {
1454 "PARALLEL",
1455 "TASK",
1456 "TASKLOOP",
1457 "TARGET",
1458 "TARGET DATA",
1459 "TARGET UPDATE",
1460 "TARGET ENTER DATA",
1461 "TARGET EXIT DATA"
1462 };
1463 fputs (" IF(", dumpfile);
1464 fputs (ifs[i], dumpfile);
1465 fputs (": ", dumpfile);
1466 show_expr (omp_clauses->if_exprs[i]);
1467 fputc (')', dumpfile);
1468 }
1469 if (omp_clauses->depend_source)
1470 fputs (" DEPEND(source)", dumpfile);
1471 }
1472
1473 /* Show a single OpenMP or OpenACC directive node and everything underneath it
1474 if necessary. */
1475
1476 static void
1477 show_omp_node (int level, gfc_code *c)
1478 {
1479 gfc_omp_clauses *omp_clauses = NULL;
1480 const char *name = NULL;
1481 bool is_oacc = false;
1482
1483 switch (c->op)
1484 {
1485 case EXEC_OACC_PARALLEL_LOOP:
1486 name = "PARALLEL LOOP"; is_oacc = true; break;
1487 case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break;
1488 case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break;
1489 case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break;
1490 case EXEC_OACC_DATA: name = "DATA"; is_oacc = true; break;
1491 case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; is_oacc = true; break;
1492 case EXEC_OACC_LOOP: name = "LOOP"; is_oacc = true; break;
1493 case EXEC_OACC_UPDATE: name = "UPDATE"; is_oacc = true; break;
1494 case EXEC_OACC_WAIT: name = "WAIT"; is_oacc = true; break;
1495 case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
1496 case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
1497 case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
1498 case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
1499 case EXEC_OMP_BARRIER: name = "BARRIER"; break;
1500 case EXEC_OMP_CANCEL: name = "CANCEL"; break;
1501 case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break;
1502 case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
1503 case EXEC_OMP_DISTRIBUTE: name = "DISTRIBUTE"; break;
1504 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
1505 name = "DISTRIBUTE PARALLEL DO"; break;
1506 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
1507 name = "DISTRIBUTE PARALLEL DO SIMD"; break;
1508 case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break;
1509 case EXEC_OMP_DO: name = "DO"; break;
1510 case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
1511 case EXEC_OMP_FLUSH: name = "FLUSH"; break;
1512 case EXEC_OMP_MASTER: name = "MASTER"; break;
1513 case EXEC_OMP_ORDERED: name = "ORDERED"; break;
1514 case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
1515 case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
1516 case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
1517 case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
1518 case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
1519 case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
1520 case EXEC_OMP_SIMD: name = "SIMD"; break;
1521 case EXEC_OMP_SINGLE: name = "SINGLE"; break;
1522 case EXEC_OMP_TARGET: name = "TARGET"; break;
1523 case EXEC_OMP_TARGET_DATA: name = "TARGET DATA"; break;
1524 case EXEC_OMP_TARGET_ENTER_DATA: name = "TARGET ENTER DATA"; break;
1525 case EXEC_OMP_TARGET_EXIT_DATA: name = "TARGET EXIT DATA"; break;
1526 case EXEC_OMP_TARGET_PARALLEL: name = "TARGET PARALLEL"; break;
1527 case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break;
1528 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
1529 name = "TARGET_PARALLEL_DO_SIMD"; break;
1530 case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break;
1531 case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break;
1532 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
1533 name = "TARGET TEAMS DISTRIBUTE"; break;
1534 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
1535 name = "TARGET TEAMS DISTRIBUTE PARALLEL DO"; break;
1536 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1537 name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
1538 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
1539 name = "TARGET TEAMS DISTRIBUTE SIMD"; break;
1540 case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break;
1541 case EXEC_OMP_TASK: name = "TASK"; break;
1542 case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break;
1543 case EXEC_OMP_TASKLOOP: name = "TASKLOOP"; break;
1544 case EXEC_OMP_TASKLOOP_SIMD: name = "TASKLOOP SIMD"; break;
1545 case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
1546 case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
1547 case EXEC_OMP_TEAMS: name = "TEAMS"; break;
1548 case EXEC_OMP_TEAMS_DISTRIBUTE: name = "TEAMS DISTRIBUTE"; break;
1549 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
1550 name = "TEAMS DISTRIBUTE PARALLEL DO"; break;
1551 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1552 name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
1553 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break;
1554 case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
1555 default:
1556 gcc_unreachable ();
1557 }
1558 fprintf (dumpfile, "!$%s %s", is_oacc ? "ACC" : "OMP", name);
1559 switch (c->op)
1560 {
1561 case EXEC_OACC_PARALLEL_LOOP:
1562 case EXEC_OACC_PARALLEL:
1563 case EXEC_OACC_KERNELS_LOOP:
1564 case EXEC_OACC_KERNELS:
1565 case EXEC_OACC_DATA:
1566 case EXEC_OACC_HOST_DATA:
1567 case EXEC_OACC_LOOP:
1568 case EXEC_OACC_UPDATE:
1569 case EXEC_OACC_WAIT:
1570 case EXEC_OACC_CACHE:
1571 case EXEC_OACC_ENTER_DATA:
1572 case EXEC_OACC_EXIT_DATA:
1573 case EXEC_OMP_CANCEL:
1574 case EXEC_OMP_CANCELLATION_POINT:
1575 case EXEC_OMP_DISTRIBUTE:
1576 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
1577 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
1578 case EXEC_OMP_DISTRIBUTE_SIMD:
1579 case EXEC_OMP_DO:
1580 case EXEC_OMP_DO_SIMD:
1581 case EXEC_OMP_ORDERED:
1582 case EXEC_OMP_PARALLEL:
1583 case EXEC_OMP_PARALLEL_DO:
1584 case EXEC_OMP_PARALLEL_DO_SIMD:
1585 case EXEC_OMP_PARALLEL_SECTIONS:
1586 case EXEC_OMP_PARALLEL_WORKSHARE:
1587 case EXEC_OMP_SECTIONS:
1588 case EXEC_OMP_SIMD:
1589 case EXEC_OMP_SINGLE:
1590 case EXEC_OMP_TARGET:
1591 case EXEC_OMP_TARGET_DATA:
1592 case EXEC_OMP_TARGET_ENTER_DATA:
1593 case EXEC_OMP_TARGET_EXIT_DATA:
1594 case EXEC_OMP_TARGET_PARALLEL:
1595 case EXEC_OMP_TARGET_PARALLEL_DO:
1596 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
1597 case EXEC_OMP_TARGET_SIMD:
1598 case EXEC_OMP_TARGET_TEAMS:
1599 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
1600 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
1601 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1602 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
1603 case EXEC_OMP_TARGET_UPDATE:
1604 case EXEC_OMP_TASK:
1605 case EXEC_OMP_TASKLOOP:
1606 case EXEC_OMP_TASKLOOP_SIMD:
1607 case EXEC_OMP_TEAMS:
1608 case EXEC_OMP_TEAMS_DISTRIBUTE:
1609 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
1610 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1611 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
1612 case EXEC_OMP_WORKSHARE:
1613 omp_clauses = c->ext.omp_clauses;
1614 break;
1615 case EXEC_OMP_CRITICAL:
1616 omp_clauses = c->ext.omp_clauses;
1617 if (omp_clauses)
1618 fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
1619 break;
1620 case EXEC_OMP_FLUSH:
1621 if (c->ext.omp_namelist)
1622 {
1623 fputs (" (", dumpfile);
1624 show_omp_namelist (OMP_LIST_NUM, c->ext.omp_namelist);
1625 fputc (')', dumpfile);
1626 }
1627 return;
1628 case EXEC_OMP_BARRIER:
1629 case EXEC_OMP_TASKWAIT:
1630 case EXEC_OMP_TASKYIELD:
1631 return;
1632 default:
1633 break;
1634 }
1635 if (omp_clauses)
1636 show_omp_clauses (omp_clauses);
1637 fputc ('\n', dumpfile);
1638
1639 /* OpenMP and OpenACC executable directives don't have associated blocks. */
1640 if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
1641 || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
1642 || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
1643 || c->op == EXEC_OMP_TARGET_EXIT_DATA
1644 || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
1645 return;
1646 if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
1647 {
1648 gfc_code *d = c->block;
1649 while (d != NULL)
1650 {
1651 show_code (level + 1, d->next);
1652 if (d->block == NULL)
1653 break;
1654 code_indent (level, 0);
1655 fputs ("!$OMP SECTION\n", dumpfile);
1656 d = d->block;
1657 }
1658 }
1659 else
1660 show_code (level + 1, c->block->next);
1661 if (c->op == EXEC_OMP_ATOMIC)
1662 return;
1663 fputc ('\n', dumpfile);
1664 code_indent (level, 0);
1665 fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
1666 if (omp_clauses != NULL)
1667 {
1668 if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
1669 {
1670 fputs (" COPYPRIVATE(", dumpfile);
1671 show_omp_namelist (OMP_LIST_COPYPRIVATE,
1672 omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
1673 fputc (')', dumpfile);
1674 }
1675 else if (omp_clauses->nowait)
1676 fputs (" NOWAIT", dumpfile);
1677 }
1678 else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
1679 fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
1680 }
1681
1682
1683 /* Show a single code node and everything underneath it if necessary. */
1684
1685 static void
1686 show_code_node (int level, gfc_code *c)
1687 {
1688 gfc_forall_iterator *fa;
1689 gfc_open *open;
1690 gfc_case *cp;
1691 gfc_alloc *a;
1692 gfc_code *d;
1693 gfc_close *close;
1694 gfc_filepos *fp;
1695 gfc_inquire *i;
1696 gfc_dt *dt;
1697 gfc_namespace *ns;
1698
1699 if (c->here)
1700 {
1701 fputc ('\n', dumpfile);
1702 code_indent (level, c->here);
1703 }
1704 else
1705 show_indent ();
1706
1707 switch (c->op)
1708 {
1709 case EXEC_END_PROCEDURE:
1710 break;
1711
1712 case EXEC_NOP:
1713 fputs ("NOP", dumpfile);
1714 break;
1715
1716 case EXEC_CONTINUE:
1717 fputs ("CONTINUE", dumpfile);
1718 break;
1719
1720 case EXEC_ENTRY:
1721 fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
1722 break;
1723
1724 case EXEC_INIT_ASSIGN:
1725 case EXEC_ASSIGN:
1726 fputs ("ASSIGN ", dumpfile);
1727 show_expr (c->expr1);
1728 fputc (' ', dumpfile);
1729 show_expr (c->expr2);
1730 break;
1731
1732 case EXEC_LABEL_ASSIGN:
1733 fputs ("LABEL ASSIGN ", dumpfile);
1734 show_expr (c->expr1);
1735 fprintf (dumpfile, " %d", c->label1->value);
1736 break;
1737
1738 case EXEC_POINTER_ASSIGN:
1739 fputs ("POINTER ASSIGN ", dumpfile);
1740 show_expr (c->expr1);
1741 fputc (' ', dumpfile);
1742 show_expr (c->expr2);
1743 break;
1744
1745 case EXEC_GOTO:
1746 fputs ("GOTO ", dumpfile);
1747 if (c->label1)
1748 fprintf (dumpfile, "%d", c->label1->value);
1749 else
1750 {
1751 show_expr (c->expr1);
1752 d = c->block;
1753 if (d != NULL)
1754 {
1755 fputs (", (", dumpfile);
1756 for (; d; d = d ->block)
1757 {
1758 code_indent (level, d->label1);
1759 if (d->block != NULL)
1760 fputc (',', dumpfile);
1761 else
1762 fputc (')', dumpfile);
1763 }
1764 }
1765 }
1766 break;
1767
1768 case EXEC_CALL:
1769 case EXEC_ASSIGN_CALL:
1770 if (c->resolved_sym)
1771 fprintf (dumpfile, "CALL %s ", c->resolved_sym->name);
1772 else if (c->symtree)
1773 fprintf (dumpfile, "CALL %s ", c->symtree->name);
1774 else
1775 fputs ("CALL ?? ", dumpfile);
1776
1777 show_actual_arglist (c->ext.actual);
1778 break;
1779
1780 case EXEC_COMPCALL:
1781 fputs ("CALL ", dumpfile);
1782 show_compcall (c->expr1);
1783 break;
1784
1785 case EXEC_CALL_PPC:
1786 fputs ("CALL ", dumpfile);
1787 show_expr (c->expr1);
1788 show_actual_arglist (c->ext.actual);
1789 break;
1790
1791 case EXEC_RETURN:
1792 fputs ("RETURN ", dumpfile);
1793 if (c->expr1)
1794 show_expr (c->expr1);
1795 break;
1796
1797 case EXEC_PAUSE:
1798 fputs ("PAUSE ", dumpfile);
1799
1800 if (c->expr1 != NULL)
1801 show_expr (c->expr1);
1802 else
1803 fprintf (dumpfile, "%d", c->ext.stop_code);
1804
1805 break;
1806
1807 case EXEC_ERROR_STOP:
1808 fputs ("ERROR ", dumpfile);
1809 /* Fall through. */
1810
1811 case EXEC_STOP:
1812 fputs ("STOP ", dumpfile);
1813
1814 if (c->expr1 != NULL)
1815 show_expr (c->expr1);
1816 else
1817 fprintf (dumpfile, "%d", c->ext.stop_code);
1818
1819 break;
1820
1821 case EXEC_SYNC_ALL:
1822 fputs ("SYNC ALL ", dumpfile);
1823 if (c->expr2 != NULL)
1824 {
1825 fputs (" stat=", dumpfile);
1826 show_expr (c->expr2);
1827 }
1828 if (c->expr3 != NULL)
1829 {
1830 fputs (" errmsg=", dumpfile);
1831 show_expr (c->expr3);
1832 }
1833 break;
1834
1835 case EXEC_SYNC_MEMORY:
1836 fputs ("SYNC MEMORY ", dumpfile);
1837 if (c->expr2 != NULL)
1838 {
1839 fputs (" stat=", dumpfile);
1840 show_expr (c->expr2);
1841 }
1842 if (c->expr3 != NULL)
1843 {
1844 fputs (" errmsg=", dumpfile);
1845 show_expr (c->expr3);
1846 }
1847 break;
1848
1849 case EXEC_SYNC_IMAGES:
1850 fputs ("SYNC IMAGES image-set=", dumpfile);
1851 if (c->expr1 != NULL)
1852 show_expr (c->expr1);
1853 else
1854 fputs ("* ", dumpfile);
1855 if (c->expr2 != NULL)
1856 {
1857 fputs (" stat=", dumpfile);
1858 show_expr (c->expr2);
1859 }
1860 if (c->expr3 != NULL)
1861 {
1862 fputs (" errmsg=", dumpfile);
1863 show_expr (c->expr3);
1864 }
1865 break;
1866
1867 case EXEC_EVENT_POST:
1868 case EXEC_EVENT_WAIT:
1869 if (c->op == EXEC_EVENT_POST)
1870 fputs ("EVENT POST ", dumpfile);
1871 else
1872 fputs ("EVENT WAIT ", dumpfile);
1873
1874 fputs ("event-variable=", dumpfile);
1875 if (c->expr1 != NULL)
1876 show_expr (c->expr1);
1877 if (c->expr4 != NULL)
1878 {
1879 fputs (" until_count=", dumpfile);
1880 show_expr (c->expr4);
1881 }
1882 if (c->expr2 != NULL)
1883 {
1884 fputs (" stat=", dumpfile);
1885 show_expr (c->expr2);
1886 }
1887 if (c->expr3 != NULL)
1888 {
1889 fputs (" errmsg=", dumpfile);
1890 show_expr (c->expr3);
1891 }
1892 break;
1893
1894 case EXEC_LOCK:
1895 case EXEC_UNLOCK:
1896 if (c->op == EXEC_LOCK)
1897 fputs ("LOCK ", dumpfile);
1898 else
1899 fputs ("UNLOCK ", dumpfile);
1900
1901 fputs ("lock-variable=", dumpfile);
1902 if (c->expr1 != NULL)
1903 show_expr (c->expr1);
1904 if (c->expr4 != NULL)
1905 {
1906 fputs (" acquired_lock=", dumpfile);
1907 show_expr (c->expr4);
1908 }
1909 if (c->expr2 != NULL)
1910 {
1911 fputs (" stat=", dumpfile);
1912 show_expr (c->expr2);
1913 }
1914 if (c->expr3 != NULL)
1915 {
1916 fputs (" errmsg=", dumpfile);
1917 show_expr (c->expr3);
1918 }
1919 break;
1920
1921 case EXEC_ARITHMETIC_IF:
1922 fputs ("IF ", dumpfile);
1923 show_expr (c->expr1);
1924 fprintf (dumpfile, " %d, %d, %d",
1925 c->label1->value, c->label2->value, c->label3->value);
1926 break;
1927
1928 case EXEC_IF:
1929 d = c->block;
1930 fputs ("IF ", dumpfile);
1931 show_expr (d->expr1);
1932
1933 ++show_level;
1934 show_code (level + 1, d->next);
1935 --show_level;
1936
1937 d = d->block;
1938 for (; d; d = d->block)
1939 {
1940 code_indent (level, 0);
1941
1942 if (d->expr1 == NULL)
1943 fputs ("ELSE", dumpfile);
1944 else
1945 {
1946 fputs ("ELSE IF ", dumpfile);
1947 show_expr (d->expr1);
1948 }
1949
1950 ++show_level;
1951 show_code (level + 1, d->next);
1952 --show_level;
1953 }
1954
1955 if (c->label1)
1956 code_indent (level, c->label1);
1957 else
1958 show_indent ();
1959
1960 fputs ("ENDIF", dumpfile);
1961 break;
1962
1963 case EXEC_BLOCK:
1964 {
1965 const char* blocktype;
1966 gfc_namespace *saved_ns;
1967 gfc_association_list *alist;
1968
1969 if (c->ext.block.assoc)
1970 blocktype = "ASSOCIATE";
1971 else
1972 blocktype = "BLOCK";
1973 show_indent ();
1974 fprintf (dumpfile, "%s ", blocktype);
1975 for (alist = c->ext.block.assoc; alist; alist = alist->next)
1976 {
1977 fprintf (dumpfile, " %s = ", alist->name);
1978 show_expr (alist->target);
1979 }
1980
1981 ++show_level;
1982 ns = c->ext.block.ns;
1983 saved_ns = gfc_current_ns;
1984 gfc_current_ns = ns;
1985 gfc_traverse_symtree (ns->sym_root, show_symtree);
1986 gfc_current_ns = saved_ns;
1987 show_code (show_level, ns->code);
1988 --show_level;
1989 show_indent ();
1990 fprintf (dumpfile, "END %s ", blocktype);
1991 break;
1992 }
1993
1994 case EXEC_END_BLOCK:
1995 /* Only come here when there is a label on an
1996 END ASSOCIATE construct. */
1997 break;
1998
1999 case EXEC_SELECT:
2000 case EXEC_SELECT_TYPE:
2001 d = c->block;
2002 if (c->op == EXEC_SELECT_TYPE)
2003 fputs ("SELECT TYPE ", dumpfile);
2004 else
2005 fputs ("SELECT CASE ", dumpfile);
2006 show_expr (c->expr1);
2007 fputc ('\n', dumpfile);
2008
2009 for (; d; d = d->block)
2010 {
2011 code_indent (level, 0);
2012
2013 fputs ("CASE ", dumpfile);
2014 for (cp = d->ext.block.case_list; cp; cp = cp->next)
2015 {
2016 fputc ('(', dumpfile);
2017 show_expr (cp->low);
2018 fputc (' ', dumpfile);
2019 show_expr (cp->high);
2020 fputc (')', dumpfile);
2021 fputc (' ', dumpfile);
2022 }
2023 fputc ('\n', dumpfile);
2024
2025 show_code (level + 1, d->next);
2026 }
2027
2028 code_indent (level, c->label1);
2029 fputs ("END SELECT", dumpfile);
2030 break;
2031
2032 case EXEC_WHERE:
2033 fputs ("WHERE ", dumpfile);
2034
2035 d = c->block;
2036 show_expr (d->expr1);
2037 fputc ('\n', dumpfile);
2038
2039 show_code (level + 1, d->next);
2040
2041 for (d = d->block; d; d = d->block)
2042 {
2043 code_indent (level, 0);
2044 fputs ("ELSE WHERE ", dumpfile);
2045 show_expr (d->expr1);
2046 fputc ('\n', dumpfile);
2047 show_code (level + 1, d->next);
2048 }
2049
2050 code_indent (level, 0);
2051 fputs ("END WHERE", dumpfile);
2052 break;
2053
2054
2055 case EXEC_FORALL:
2056 fputs ("FORALL ", dumpfile);
2057 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
2058 {
2059 show_expr (fa->var);
2060 fputc (' ', dumpfile);
2061 show_expr (fa->start);
2062 fputc (':', dumpfile);
2063 show_expr (fa->end);
2064 fputc (':', dumpfile);
2065 show_expr (fa->stride);
2066
2067 if (fa->next != NULL)
2068 fputc (',', dumpfile);
2069 }
2070
2071 if (c->expr1 != NULL)
2072 {
2073 fputc (',', dumpfile);
2074 show_expr (c->expr1);
2075 }
2076 fputc ('\n', dumpfile);
2077
2078 show_code (level + 1, c->block->next);
2079
2080 code_indent (level, 0);
2081 fputs ("END FORALL", dumpfile);
2082 break;
2083
2084 case EXEC_CRITICAL:
2085 fputs ("CRITICAL\n", dumpfile);
2086 show_code (level + 1, c->block->next);
2087 code_indent (level, 0);
2088 fputs ("END CRITICAL", dumpfile);
2089 break;
2090
2091 case EXEC_DO:
2092 fputs ("DO ", dumpfile);
2093 if (c->label1)
2094 fprintf (dumpfile, " %-5d ", c->label1->value);
2095
2096 show_expr (c->ext.iterator->var);
2097 fputc ('=', dumpfile);
2098 show_expr (c->ext.iterator->start);
2099 fputc (' ', dumpfile);
2100 show_expr (c->ext.iterator->end);
2101 fputc (' ', dumpfile);
2102 show_expr (c->ext.iterator->step);
2103
2104 ++show_level;
2105 show_code (level + 1, c->block->next);
2106 --show_level;
2107
2108 if (c->label1)
2109 break;
2110
2111 show_indent ();
2112 fputs ("END DO", dumpfile);
2113 break;
2114
2115 case EXEC_DO_CONCURRENT:
2116 fputs ("DO CONCURRENT ", dumpfile);
2117 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
2118 {
2119 show_expr (fa->var);
2120 fputc (' ', dumpfile);
2121 show_expr (fa->start);
2122 fputc (':', dumpfile);
2123 show_expr (fa->end);
2124 fputc (':', dumpfile);
2125 show_expr (fa->stride);
2126
2127 if (fa->next != NULL)
2128 fputc (',', dumpfile);
2129 }
2130 show_expr (c->expr1);
2131
2132 show_code (level + 1, c->block->next);
2133 code_indent (level, c->label1);
2134 fputs ("END DO", dumpfile);
2135 break;
2136
2137 case EXEC_DO_WHILE:
2138 fputs ("DO WHILE ", dumpfile);
2139 show_expr (c->expr1);
2140 fputc ('\n', dumpfile);
2141
2142 show_code (level + 1, c->block->next);
2143
2144 code_indent (level, c->label1);
2145 fputs ("END DO", dumpfile);
2146 break;
2147
2148 case EXEC_CYCLE:
2149 fputs ("CYCLE", dumpfile);
2150 if (c->symtree)
2151 fprintf (dumpfile, " %s", c->symtree->n.sym->name);
2152 break;
2153
2154 case EXEC_EXIT:
2155 fputs ("EXIT", dumpfile);
2156 if (c->symtree)
2157 fprintf (dumpfile, " %s", c->symtree->n.sym->name);
2158 break;
2159
2160 case EXEC_ALLOCATE:
2161 fputs ("ALLOCATE ", dumpfile);
2162 if (c->expr1)
2163 {
2164 fputs (" STAT=", dumpfile);
2165 show_expr (c->expr1);
2166 }
2167
2168 if (c->expr2)
2169 {
2170 fputs (" ERRMSG=", dumpfile);
2171 show_expr (c->expr2);
2172 }
2173
2174 if (c->expr3)
2175 {
2176 if (c->expr3->mold)
2177 fputs (" MOLD=", dumpfile);
2178 else
2179 fputs (" SOURCE=", dumpfile);
2180 show_expr (c->expr3);
2181 }
2182
2183 for (a = c->ext.alloc.list; a; a = a->next)
2184 {
2185 fputc (' ', dumpfile);
2186 show_expr (a->expr);
2187 }
2188
2189 break;
2190
2191 case EXEC_DEALLOCATE:
2192 fputs ("DEALLOCATE ", dumpfile);
2193 if (c->expr1)
2194 {
2195 fputs (" STAT=", dumpfile);
2196 show_expr (c->expr1);
2197 }
2198
2199 if (c->expr2)
2200 {
2201 fputs (" ERRMSG=", dumpfile);
2202 show_expr (c->expr2);
2203 }
2204
2205 for (a = c->ext.alloc.list; a; a = a->next)
2206 {
2207 fputc (' ', dumpfile);
2208 show_expr (a->expr);
2209 }
2210
2211 break;
2212
2213 case EXEC_OPEN:
2214 fputs ("OPEN", dumpfile);
2215 open = c->ext.open;
2216
2217 if (open->unit)
2218 {
2219 fputs (" UNIT=", dumpfile);
2220 show_expr (open->unit);
2221 }
2222 if (open->iomsg)
2223 {
2224 fputs (" IOMSG=", dumpfile);
2225 show_expr (open->iomsg);
2226 }
2227 if (open->iostat)
2228 {
2229 fputs (" IOSTAT=", dumpfile);
2230 show_expr (open->iostat);
2231 }
2232 if (open->file)
2233 {
2234 fputs (" FILE=", dumpfile);
2235 show_expr (open->file);
2236 }
2237 if (open->status)
2238 {
2239 fputs (" STATUS=", dumpfile);
2240 show_expr (open->status);
2241 }
2242 if (open->access)
2243 {
2244 fputs (" ACCESS=", dumpfile);
2245 show_expr (open->access);
2246 }
2247 if (open->form)
2248 {
2249 fputs (" FORM=", dumpfile);
2250 show_expr (open->form);
2251 }
2252 if (open->recl)
2253 {
2254 fputs (" RECL=", dumpfile);
2255 show_expr (open->recl);
2256 }
2257 if (open->blank)
2258 {
2259 fputs (" BLANK=", dumpfile);
2260 show_expr (open->blank);
2261 }
2262 if (open->position)
2263 {
2264 fputs (" POSITION=", dumpfile);
2265 show_expr (open->position);
2266 }
2267 if (open->action)
2268 {
2269 fputs (" ACTION=", dumpfile);
2270 show_expr (open->action);
2271 }
2272 if (open->delim)
2273 {
2274 fputs (" DELIM=", dumpfile);
2275 show_expr (open->delim);
2276 }
2277 if (open->pad)
2278 {
2279 fputs (" PAD=", dumpfile);
2280 show_expr (open->pad);
2281 }
2282 if (open->decimal)
2283 {
2284 fputs (" DECIMAL=", dumpfile);
2285 show_expr (open->decimal);
2286 }
2287 if (open->encoding)
2288 {
2289 fputs (" ENCODING=", dumpfile);
2290 show_expr (open->encoding);
2291 }
2292 if (open->round)
2293 {
2294 fputs (" ROUND=", dumpfile);
2295 show_expr (open->round);
2296 }
2297 if (open->sign)
2298 {
2299 fputs (" SIGN=", dumpfile);
2300 show_expr (open->sign);
2301 }
2302 if (open->convert)
2303 {
2304 fputs (" CONVERT=", dumpfile);
2305 show_expr (open->convert);
2306 }
2307 if (open->asynchronous)
2308 {
2309 fputs (" ASYNCHRONOUS=", dumpfile);
2310 show_expr (open->asynchronous);
2311 }
2312 if (open->err != NULL)
2313 fprintf (dumpfile, " ERR=%d", open->err->value);
2314
2315 break;
2316
2317 case EXEC_CLOSE:
2318 fputs ("CLOSE", dumpfile);
2319 close = c->ext.close;
2320
2321 if (close->unit)
2322 {
2323 fputs (" UNIT=", dumpfile);
2324 show_expr (close->unit);
2325 }
2326 if (close->iomsg)
2327 {
2328 fputs (" IOMSG=", dumpfile);
2329 show_expr (close->iomsg);
2330 }
2331 if (close->iostat)
2332 {
2333 fputs (" IOSTAT=", dumpfile);
2334 show_expr (close->iostat);
2335 }
2336 if (close->status)
2337 {
2338 fputs (" STATUS=", dumpfile);
2339 show_expr (close->status);
2340 }
2341 if (close->err != NULL)
2342 fprintf (dumpfile, " ERR=%d", close->err->value);
2343 break;
2344
2345 case EXEC_BACKSPACE:
2346 fputs ("BACKSPACE", dumpfile);
2347 goto show_filepos;
2348
2349 case EXEC_ENDFILE:
2350 fputs ("ENDFILE", dumpfile);
2351 goto show_filepos;
2352
2353 case EXEC_REWIND:
2354 fputs ("REWIND", dumpfile);
2355 goto show_filepos;
2356
2357 case EXEC_FLUSH:
2358 fputs ("FLUSH", dumpfile);
2359
2360 show_filepos:
2361 fp = c->ext.filepos;
2362
2363 if (fp->unit)
2364 {
2365 fputs (" UNIT=", dumpfile);
2366 show_expr (fp->unit);
2367 }
2368 if (fp->iomsg)
2369 {
2370 fputs (" IOMSG=", dumpfile);
2371 show_expr (fp->iomsg);
2372 }
2373 if (fp->iostat)
2374 {
2375 fputs (" IOSTAT=", dumpfile);
2376 show_expr (fp->iostat);
2377 }
2378 if (fp->err != NULL)
2379 fprintf (dumpfile, " ERR=%d", fp->err->value);
2380 break;
2381
2382 case EXEC_INQUIRE:
2383 fputs ("INQUIRE", dumpfile);
2384 i = c->ext.inquire;
2385
2386 if (i->unit)
2387 {
2388 fputs (" UNIT=", dumpfile);
2389 show_expr (i->unit);
2390 }
2391 if (i->file)
2392 {
2393 fputs (" FILE=", dumpfile);
2394 show_expr (i->file);
2395 }
2396
2397 if (i->iomsg)
2398 {
2399 fputs (" IOMSG=", dumpfile);
2400 show_expr (i->iomsg);
2401 }
2402 if (i->iostat)
2403 {
2404 fputs (" IOSTAT=", dumpfile);
2405 show_expr (i->iostat);
2406 }
2407 if (i->exist)
2408 {
2409 fputs (" EXIST=", dumpfile);
2410 show_expr (i->exist);
2411 }
2412 if (i->opened)
2413 {
2414 fputs (" OPENED=", dumpfile);
2415 show_expr (i->opened);
2416 }
2417 if (i->number)
2418 {
2419 fputs (" NUMBER=", dumpfile);
2420 show_expr (i->number);
2421 }
2422 if (i->named)
2423 {
2424 fputs (" NAMED=", dumpfile);
2425 show_expr (i->named);
2426 }
2427 if (i->name)
2428 {
2429 fputs (" NAME=", dumpfile);
2430 show_expr (i->name);
2431 }
2432 if (i->access)
2433 {
2434 fputs (" ACCESS=", dumpfile);
2435 show_expr (i->access);
2436 }
2437 if (i->sequential)
2438 {
2439 fputs (" SEQUENTIAL=", dumpfile);
2440 show_expr (i->sequential);
2441 }
2442
2443 if (i->direct)
2444 {
2445 fputs (" DIRECT=", dumpfile);
2446 show_expr (i->direct);
2447 }
2448 if (i->form)
2449 {
2450 fputs (" FORM=", dumpfile);
2451 show_expr (i->form);
2452 }
2453 if (i->formatted)
2454 {
2455 fputs (" FORMATTED", dumpfile);
2456 show_expr (i->formatted);
2457 }
2458 if (i->unformatted)
2459 {
2460 fputs (" UNFORMATTED=", dumpfile);
2461 show_expr (i->unformatted);
2462 }
2463 if (i->recl)
2464 {
2465 fputs (" RECL=", dumpfile);
2466 show_expr (i->recl);
2467 }
2468 if (i->nextrec)
2469 {
2470 fputs (" NEXTREC=", dumpfile);
2471 show_expr (i->nextrec);
2472 }
2473 if (i->blank)
2474 {
2475 fputs (" BLANK=", dumpfile);
2476 show_expr (i->blank);
2477 }
2478 if (i->position)
2479 {
2480 fputs (" POSITION=", dumpfile);
2481 show_expr (i->position);
2482 }
2483 if (i->action)
2484 {
2485 fputs (" ACTION=", dumpfile);
2486 show_expr (i->action);
2487 }
2488 if (i->read)
2489 {
2490 fputs (" READ=", dumpfile);
2491 show_expr (i->read);
2492 }
2493 if (i->write)
2494 {
2495 fputs (" WRITE=", dumpfile);
2496 show_expr (i->write);
2497 }
2498 if (i->readwrite)
2499 {
2500 fputs (" READWRITE=", dumpfile);
2501 show_expr (i->readwrite);
2502 }
2503 if (i->delim)
2504 {
2505 fputs (" DELIM=", dumpfile);
2506 show_expr (i->delim);
2507 }
2508 if (i->pad)
2509 {
2510 fputs (" PAD=", dumpfile);
2511 show_expr (i->pad);
2512 }
2513 if (i->convert)
2514 {
2515 fputs (" CONVERT=", dumpfile);
2516 show_expr (i->convert);
2517 }
2518 if (i->asynchronous)
2519 {
2520 fputs (" ASYNCHRONOUS=", dumpfile);
2521 show_expr (i->asynchronous);
2522 }
2523 if (i->decimal)
2524 {
2525 fputs (" DECIMAL=", dumpfile);
2526 show_expr (i->decimal);
2527 }
2528 if (i->encoding)
2529 {
2530 fputs (" ENCODING=", dumpfile);
2531 show_expr (i->encoding);
2532 }
2533 if (i->pending)
2534 {
2535 fputs (" PENDING=", dumpfile);
2536 show_expr (i->pending);
2537 }
2538 if (i->round)
2539 {
2540 fputs (" ROUND=", dumpfile);
2541 show_expr (i->round);
2542 }
2543 if (i->sign)
2544 {
2545 fputs (" SIGN=", dumpfile);
2546 show_expr (i->sign);
2547 }
2548 if (i->size)
2549 {
2550 fputs (" SIZE=", dumpfile);
2551 show_expr (i->size);
2552 }
2553 if (i->id)
2554 {
2555 fputs (" ID=", dumpfile);
2556 show_expr (i->id);
2557 }
2558
2559 if (i->err != NULL)
2560 fprintf (dumpfile, " ERR=%d", i->err->value);
2561 break;
2562
2563 case EXEC_IOLENGTH:
2564 fputs ("IOLENGTH ", dumpfile);
2565 show_expr (c->expr1);
2566 goto show_dt_code;
2567 break;
2568
2569 case EXEC_READ:
2570 fputs ("READ", dumpfile);
2571 goto show_dt;
2572
2573 case EXEC_WRITE:
2574 fputs ("WRITE", dumpfile);
2575
2576 show_dt:
2577 dt = c->ext.dt;
2578 if (dt->io_unit)
2579 {
2580 fputs (" UNIT=", dumpfile);
2581 show_expr (dt->io_unit);
2582 }
2583
2584 if (dt->format_expr)
2585 {
2586 fputs (" FMT=", dumpfile);
2587 show_expr (dt->format_expr);
2588 }
2589
2590 if (dt->format_label != NULL)
2591 fprintf (dumpfile, " FMT=%d", dt->format_label->value);
2592 if (dt->namelist)
2593 fprintf (dumpfile, " NML=%s", dt->namelist->name);
2594
2595 if (dt->iomsg)
2596 {
2597 fputs (" IOMSG=", dumpfile);
2598 show_expr (dt->iomsg);
2599 }
2600 if (dt->iostat)
2601 {
2602 fputs (" IOSTAT=", dumpfile);
2603 show_expr (dt->iostat);
2604 }
2605 if (dt->size)
2606 {
2607 fputs (" SIZE=", dumpfile);
2608 show_expr (dt->size);
2609 }
2610 if (dt->rec)
2611 {
2612 fputs (" REC=", dumpfile);
2613 show_expr (dt->rec);
2614 }
2615 if (dt->advance)
2616 {
2617 fputs (" ADVANCE=", dumpfile);
2618 show_expr (dt->advance);
2619 }
2620 if (dt->id)
2621 {
2622 fputs (" ID=", dumpfile);
2623 show_expr (dt->id);
2624 }
2625 if (dt->pos)
2626 {
2627 fputs (" POS=", dumpfile);
2628 show_expr (dt->pos);
2629 }
2630 if (dt->asynchronous)
2631 {
2632 fputs (" ASYNCHRONOUS=", dumpfile);
2633 show_expr (dt->asynchronous);
2634 }
2635 if (dt->blank)
2636 {
2637 fputs (" BLANK=", dumpfile);
2638 show_expr (dt->blank);
2639 }
2640 if (dt->decimal)
2641 {
2642 fputs (" DECIMAL=", dumpfile);
2643 show_expr (dt->decimal);
2644 }
2645 if (dt->delim)
2646 {
2647 fputs (" DELIM=", dumpfile);
2648 show_expr (dt->delim);
2649 }
2650 if (dt->pad)
2651 {
2652 fputs (" PAD=", dumpfile);
2653 show_expr (dt->pad);
2654 }
2655 if (dt->round)
2656 {
2657 fputs (" ROUND=", dumpfile);
2658 show_expr (dt->round);
2659 }
2660 if (dt->sign)
2661 {
2662 fputs (" SIGN=", dumpfile);
2663 show_expr (dt->sign);
2664 }
2665
2666 show_dt_code:
2667 for (c = c->block->next; c; c = c->next)
2668 show_code_node (level + (c->next != NULL), c);
2669 return;
2670
2671 case EXEC_TRANSFER:
2672 fputs ("TRANSFER ", dumpfile);
2673 show_expr (c->expr1);
2674 break;
2675
2676 case EXEC_DT_END:
2677 fputs ("DT_END", dumpfile);
2678 dt = c->ext.dt;
2679
2680 if (dt->err != NULL)
2681 fprintf (dumpfile, " ERR=%d", dt->err->value);
2682 if (dt->end != NULL)
2683 fprintf (dumpfile, " END=%d", dt->end->value);
2684 if (dt->eor != NULL)
2685 fprintf (dumpfile, " EOR=%d", dt->eor->value);
2686 break;
2687
2688 case EXEC_OACC_PARALLEL_LOOP:
2689 case EXEC_OACC_PARALLEL:
2690 case EXEC_OACC_KERNELS_LOOP:
2691 case EXEC_OACC_KERNELS:
2692 case EXEC_OACC_DATA:
2693 case EXEC_OACC_HOST_DATA:
2694 case EXEC_OACC_LOOP:
2695 case EXEC_OACC_UPDATE:
2696 case EXEC_OACC_WAIT:
2697 case EXEC_OACC_CACHE:
2698 case EXEC_OACC_ENTER_DATA:
2699 case EXEC_OACC_EXIT_DATA:
2700 case EXEC_OMP_ATOMIC:
2701 case EXEC_OMP_CANCEL:
2702 case EXEC_OMP_CANCELLATION_POINT:
2703 case EXEC_OMP_BARRIER:
2704 case EXEC_OMP_CRITICAL:
2705 case EXEC_OMP_DISTRIBUTE:
2706 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
2707 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
2708 case EXEC_OMP_DISTRIBUTE_SIMD:
2709 case EXEC_OMP_DO:
2710 case EXEC_OMP_DO_SIMD:
2711 case EXEC_OMP_FLUSH:
2712 case EXEC_OMP_MASTER:
2713 case EXEC_OMP_ORDERED:
2714 case EXEC_OMP_PARALLEL:
2715 case EXEC_OMP_PARALLEL_DO:
2716 case EXEC_OMP_PARALLEL_DO_SIMD:
2717 case EXEC_OMP_PARALLEL_SECTIONS:
2718 case EXEC_OMP_PARALLEL_WORKSHARE:
2719 case EXEC_OMP_SECTIONS:
2720 case EXEC_OMP_SIMD:
2721 case EXEC_OMP_SINGLE:
2722 case EXEC_OMP_TARGET:
2723 case EXEC_OMP_TARGET_DATA:
2724 case EXEC_OMP_TARGET_ENTER_DATA:
2725 case EXEC_OMP_TARGET_EXIT_DATA:
2726 case EXEC_OMP_TARGET_PARALLEL:
2727 case EXEC_OMP_TARGET_PARALLEL_DO:
2728 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
2729 case EXEC_OMP_TARGET_SIMD:
2730 case EXEC_OMP_TARGET_TEAMS:
2731 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
2732 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
2733 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2734 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
2735 case EXEC_OMP_TARGET_UPDATE:
2736 case EXEC_OMP_TASK:
2737 case EXEC_OMP_TASKGROUP:
2738 case EXEC_OMP_TASKLOOP:
2739 case EXEC_OMP_TASKLOOP_SIMD:
2740 case EXEC_OMP_TASKWAIT:
2741 case EXEC_OMP_TASKYIELD:
2742 case EXEC_OMP_TEAMS:
2743 case EXEC_OMP_TEAMS_DISTRIBUTE:
2744 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
2745 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2746 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
2747 case EXEC_OMP_WORKSHARE:
2748 show_omp_node (level, c);
2749 break;
2750
2751 default:
2752 gfc_internal_error ("show_code_node(): Bad statement code");
2753 }
2754 }
2755
2756
2757 /* Show an equivalence chain. */
2758
2759 static void
2760 show_equiv (gfc_equiv *eq)
2761 {
2762 show_indent ();
2763 fputs ("Equivalence: ", dumpfile);
2764 while (eq)
2765 {
2766 show_expr (eq->expr);
2767 eq = eq->eq;
2768 if (eq)
2769 fputs (", ", dumpfile);
2770 }
2771 }
2772
2773
2774 /* Show a freakin' whole namespace. */
2775
2776 static void
2777 show_namespace (gfc_namespace *ns)
2778 {
2779 gfc_interface *intr;
2780 gfc_namespace *save;
2781 int op;
2782 gfc_equiv *eq;
2783 int i;
2784
2785 gcc_assert (ns);
2786 save = gfc_current_ns;
2787
2788 show_indent ();
2789 fputs ("Namespace:", dumpfile);
2790
2791 i = 0;
2792 do
2793 {
2794 int l = i;
2795 while (i < GFC_LETTERS - 1
2796 && gfc_compare_types (&ns->default_type[i+1],
2797 &ns->default_type[l]))
2798 i++;
2799
2800 if (i > l)
2801 fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
2802 else
2803 fprintf (dumpfile, " %c: ", l+'A');
2804
2805 show_typespec(&ns->default_type[l]);
2806 i++;
2807 } while (i < GFC_LETTERS);
2808
2809 if (ns->proc_name != NULL)
2810 {
2811 show_indent ();
2812 fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
2813 }
2814
2815 ++show_level;
2816 gfc_current_ns = ns;
2817 gfc_traverse_symtree (ns->common_root, show_common);
2818
2819 gfc_traverse_symtree (ns->sym_root, show_symtree);
2820
2821 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
2822 {
2823 /* User operator interfaces */
2824 intr = ns->op[op];
2825 if (intr == NULL)
2826 continue;
2827
2828 show_indent ();
2829 fprintf (dumpfile, "Operator interfaces for %s:",
2830 gfc_op2string ((gfc_intrinsic_op) op));
2831
2832 for (; intr; intr = intr->next)
2833 fprintf (dumpfile, " %s", intr->sym->name);
2834 }
2835
2836 if (ns->uop_root != NULL)
2837 {
2838 show_indent ();
2839 fputs ("User operators:\n", dumpfile);
2840 gfc_traverse_user_op (ns, show_uop);
2841 }
2842
2843 for (eq = ns->equiv; eq; eq = eq->next)
2844 show_equiv (eq);
2845
2846 if (ns->oacc_declare)
2847 {
2848 struct gfc_oacc_declare *decl;
2849 /* Dump !$ACC DECLARE clauses. */
2850 for (decl = ns->oacc_declare; decl; decl = decl->next)
2851 {
2852 show_indent ();
2853 fprintf (dumpfile, "!$ACC DECLARE");
2854 show_omp_clauses (decl->clauses);
2855 }
2856 }
2857
2858 fputc ('\n', dumpfile);
2859 show_indent ();
2860 fputs ("code:", dumpfile);
2861 show_code (show_level, ns->code);
2862 --show_level;
2863
2864 for (ns = ns->contained; ns; ns = ns->sibling)
2865 {
2866 fputs ("\nCONTAINS\n", dumpfile);
2867 ++show_level;
2868 show_namespace (ns);
2869 --show_level;
2870 }
2871
2872 fputc ('\n', dumpfile);
2873 gfc_current_ns = save;
2874 }
2875
2876
2877 /* Main function for dumping a parse tree. */
2878
2879 void
2880 gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
2881 {
2882 dumpfile = file;
2883 show_namespace (ns);
2884 }
2885
Mirror of the offical gcc git repository hosted at gcc.gnu.org