2 Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009
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 /* Keep track of indentation for symbol tree dumps. */
38 static int show_level
= 0;
40 /* The file handle we're dumping to is kept in a static variable. This
41 is not too cool, but it avoids a lot of passing it around. */
42 static FILE *dumpfile
;
44 /* Forward declaration of some of the functions. */
45 static void show_expr (gfc_expr
*p
);
46 static void show_code_node (int, gfc_code
*);
47 static void show_namespace (gfc_namespace
*ns
);
50 /* Do indentation for a specific level. */
53 code_indent (int level
, gfc_st_label
*label
)
58 fprintf (dumpfile
, "%-5d ", label
->value
);
60 fputs (" ", dumpfile
);
62 for (i
= 0; i
< 2 * level
; i
++)
63 fputc (' ', dumpfile
);
67 /* Simple indentation at the current level. This one
68 is used to show symbols. */
73 fputc ('\n', dumpfile
);
74 code_indent (show_level
, NULL
);
78 /* Show type-specific information. */
81 show_typespec (gfc_typespec
*ts
)
83 fprintf (dumpfile
, "(%s ", gfc_basic_typename (ts
->type
));
88 fprintf (dumpfile
, "%s", ts
->derived
->name
);
92 show_expr (ts
->cl
->length
);
96 fprintf (dumpfile
, "%d", ts
->kind
);
100 fputc (')', dumpfile
);
104 /* Show an actual argument list. */
107 show_actual_arglist (gfc_actual_arglist
*a
)
109 fputc ('(', dumpfile
);
111 for (; a
; a
= a
->next
)
113 fputc ('(', dumpfile
);
115 fprintf (dumpfile
, "%s = ", a
->name
);
119 fputs ("(arg not-present)", dumpfile
);
121 fputc (')', dumpfile
);
123 fputc (' ', dumpfile
);
126 fputc (')', dumpfile
);
130 /* Show a gfc_array_spec array specification structure. */
133 show_array_spec (gfc_array_spec
*as
)
140 fputs ("()", dumpfile
);
144 fprintf (dumpfile
, "(%d", as
->rank
);
150 case AS_EXPLICIT
: c
= "AS_EXPLICIT"; break;
151 case AS_DEFERRED
: c
= "AS_DEFERRED"; break;
152 case AS_ASSUMED_SIZE
: c
= "AS_ASSUMED_SIZE"; break;
153 case AS_ASSUMED_SHAPE
: c
= "AS_ASSUMED_SHAPE"; break;
155 gfc_internal_error ("show_array_spec(): Unhandled array shape "
158 fprintf (dumpfile
, " %s ", c
);
160 for (i
= 0; i
< as
->rank
; i
++)
162 show_expr (as
->lower
[i
]);
163 fputc (' ', dumpfile
);
164 show_expr (as
->upper
[i
]);
165 fputc (' ', dumpfile
);
169 fputc (')', dumpfile
);
173 /* Show a gfc_array_ref array reference structure. */
176 show_array_ref (gfc_array_ref
* ar
)
180 fputc ('(', dumpfile
);
185 fputs ("FULL", dumpfile
);
189 for (i
= 0; i
< ar
->dimen
; i
++)
191 /* There are two types of array sections: either the
192 elements are identified by an integer array ('vector'),
193 or by an index range. In the former case we only have to
194 print the start expression which contains the vector, in
195 the latter case we have to print any of lower and upper
196 bound and the stride, if they're present. */
198 if (ar
->start
[i
] != NULL
)
199 show_expr (ar
->start
[i
]);
201 if (ar
->dimen_type
[i
] == DIMEN_RANGE
)
203 fputc (':', dumpfile
);
205 if (ar
->end
[i
] != NULL
)
206 show_expr (ar
->end
[i
]);
208 if (ar
->stride
[i
] != NULL
)
210 fputc (':', dumpfile
);
211 show_expr (ar
->stride
[i
]);
215 if (i
!= ar
->dimen
- 1)
216 fputs (" , ", dumpfile
);
221 for (i
= 0; i
< ar
->dimen
; i
++)
223 show_expr (ar
->start
[i
]);
224 if (i
!= ar
->dimen
- 1)
225 fputs (" , ", dumpfile
);
230 fputs ("UNKNOWN", dumpfile
);
234 gfc_internal_error ("show_array_ref(): Unknown array reference");
237 fputc (')', dumpfile
);
241 /* Show a list of gfc_ref structures. */
244 show_ref (gfc_ref
*p
)
246 for (; p
; p
= p
->next
)
250 show_array_ref (&p
->u
.ar
);
254 fprintf (dumpfile
, " %% %s", p
->u
.c
.component
->name
);
258 fputc ('(', dumpfile
);
259 show_expr (p
->u
.ss
.start
);
260 fputc (':', dumpfile
);
261 show_expr (p
->u
.ss
.end
);
262 fputc (')', dumpfile
);
266 gfc_internal_error ("show_ref(): Bad component code");
271 /* Display a constructor. Works recursively for array constructors. */
274 show_constructor (gfc_constructor
*c
)
276 for (; c
; c
= c
->next
)
278 if (c
->iterator
== NULL
)
282 fputc ('(', dumpfile
);
285 fputc (' ', dumpfile
);
286 show_expr (c
->iterator
->var
);
287 fputc ('=', dumpfile
);
288 show_expr (c
->iterator
->start
);
289 fputc (',', dumpfile
);
290 show_expr (c
->iterator
->end
);
291 fputc (',', dumpfile
);
292 show_expr (c
->iterator
->step
);
294 fputc (')', dumpfile
);
298 fputs (" , ", dumpfile
);
304 show_char_const (const gfc_char_t
*c
, int length
)
308 fputc ('\'', dumpfile
);
309 for (i
= 0; i
< length
; i
++)
312 fputs ("''", dumpfile
);
314 fputs (gfc_print_wide_char (c
[i
]), dumpfile
);
316 fputc ('\'', dumpfile
);
320 /* Show a component-call expression. */
323 show_compcall (gfc_expr
* p
)
325 gcc_assert (p
->expr_type
== EXPR_COMPCALL
);
327 fprintf (dumpfile
, "%s", p
->symtree
->n
.sym
->name
);
329 fprintf (dumpfile
, "%s", p
->value
.compcall
.name
);
331 show_actual_arglist (p
->value
.compcall
.actual
);
335 /* Show an expression. */
338 show_expr (gfc_expr
*p
)
345 fputs ("()", dumpfile
);
349 switch (p
->expr_type
)
352 show_char_const (p
->value
.character
.string
, p
->value
.character
.length
);
357 fprintf (dumpfile
, "%s(", p
->ts
.derived
->name
);
358 show_constructor (p
->value
.constructor
);
359 fputc (')', dumpfile
);
363 fputs ("(/ ", dumpfile
);
364 show_constructor (p
->value
.constructor
);
365 fputs (" /)", dumpfile
);
371 fputs ("NULL()", dumpfile
);
378 mpz_out_str (stdout
, 10, p
->value
.integer
);
380 if (p
->ts
.kind
!= gfc_default_integer_kind
)
381 fprintf (dumpfile
, "_%d", p
->ts
.kind
);
385 if (p
->value
.logical
)
386 fputs (".true.", dumpfile
);
388 fputs (".false.", dumpfile
);
392 mpfr_out_str (stdout
, 10, 0, p
->value
.real
, GFC_RND_MODE
);
393 if (p
->ts
.kind
!= gfc_default_real_kind
)
394 fprintf (dumpfile
, "_%d", p
->ts
.kind
);
398 show_char_const (p
->value
.character
.string
,
399 p
->value
.character
.length
);
403 fputs ("(complex ", dumpfile
);
405 mpfr_out_str (stdout
, 10, 0, p
->value
.complex.r
, GFC_RND_MODE
);
406 if (p
->ts
.kind
!= gfc_default_complex_kind
)
407 fprintf (dumpfile
, "_%d", p
->ts
.kind
);
409 fputc (' ', dumpfile
);
411 mpfr_out_str (stdout
, 10, 0, p
->value
.complex.i
, GFC_RND_MODE
);
412 if (p
->ts
.kind
!= gfc_default_complex_kind
)
413 fprintf (dumpfile
, "_%d", p
->ts
.kind
);
415 fputc (')', dumpfile
);
419 fprintf (dumpfile
, "%dH", p
->representation
.length
);
420 c
= p
->representation
.string
;
421 for (i
= 0; i
< p
->representation
.length
; i
++, c
++)
423 fputc (*c
, dumpfile
);
428 fputs ("???", dumpfile
);
432 if (p
->representation
.string
)
434 fputs (" {", dumpfile
);
435 c
= p
->representation
.string
;
436 for (i
= 0; i
< p
->representation
.length
; i
++, c
++)
438 fprintf (dumpfile
, "%.2x", (unsigned int) *c
);
439 if (i
< p
->representation
.length
- 1)
440 fputc (',', dumpfile
);
442 fputc ('}', dumpfile
);
448 if (p
->symtree
->n
.sym
->ns
&& p
->symtree
->n
.sym
->ns
->proc_name
)
449 fprintf (dumpfile
, "%s:", p
->symtree
->n
.sym
->ns
->proc_name
->name
);
450 fprintf (dumpfile
, "%s", p
->symtree
->n
.sym
->name
);
455 fputc ('(', dumpfile
);
456 switch (p
->value
.op
.op
)
458 case INTRINSIC_UPLUS
:
459 fputs ("U+ ", dumpfile
);
461 case INTRINSIC_UMINUS
:
462 fputs ("U- ", dumpfile
);
465 fputs ("+ ", dumpfile
);
467 case INTRINSIC_MINUS
:
468 fputs ("- ", dumpfile
);
470 case INTRINSIC_TIMES
:
471 fputs ("* ", dumpfile
);
473 case INTRINSIC_DIVIDE
:
474 fputs ("/ ", dumpfile
);
476 case INTRINSIC_POWER
:
477 fputs ("** ", dumpfile
);
479 case INTRINSIC_CONCAT
:
480 fputs ("// ", dumpfile
);
483 fputs ("AND ", dumpfile
);
486 fputs ("OR ", dumpfile
);
489 fputs ("EQV ", dumpfile
);
492 fputs ("NEQV ", dumpfile
);
495 case INTRINSIC_EQ_OS
:
496 fputs ("= ", dumpfile
);
499 case INTRINSIC_NE_OS
:
500 fputs ("/= ", dumpfile
);
503 case INTRINSIC_GT_OS
:
504 fputs ("> ", dumpfile
);
507 case INTRINSIC_GE_OS
:
508 fputs (">= ", dumpfile
);
511 case INTRINSIC_LT_OS
:
512 fputs ("< ", dumpfile
);
515 case INTRINSIC_LE_OS
:
516 fputs ("<= ", dumpfile
);
519 fputs ("NOT ", dumpfile
);
521 case INTRINSIC_PARENTHESES
:
522 fputs ("parens", dumpfile
);
527 ("show_expr(): Bad intrinsic in expression!");
530 show_expr (p
->value
.op
.op1
);
534 fputc (' ', dumpfile
);
535 show_expr (p
->value
.op
.op2
);
538 fputc (')', dumpfile
);
542 if (p
->value
.function
.name
== NULL
)
544 fprintf (dumpfile
, "%s", p
->symtree
->n
.sym
->name
);
545 if (is_proc_ptr_comp (p
, NULL
))
547 fputc ('[', dumpfile
);
548 show_actual_arglist (p
->value
.function
.actual
);
549 fputc (']', dumpfile
);
553 fprintf (dumpfile
, "%s", p
->value
.function
.name
);
554 if (is_proc_ptr_comp (p
, NULL
))
556 fputc ('[', dumpfile
);
557 fputc ('[', dumpfile
);
558 show_actual_arglist (p
->value
.function
.actual
);
559 fputc (']', dumpfile
);
560 fputc (']', dumpfile
);
570 gfc_internal_error ("show_expr(): Don't know how to show expr");
574 /* Show symbol attributes. The flavor and intent are followed by
575 whatever single bit attributes are present. */
578 show_attr (symbol_attribute
*attr
)
581 fprintf (dumpfile
, "(%s %s %s %s %s",
582 gfc_code2string (flavors
, attr
->flavor
),
583 gfc_intent_string (attr
->intent
),
584 gfc_code2string (access_types
, attr
->access
),
585 gfc_code2string (procedures
, attr
->proc
),
586 gfc_code2string (save_status
, attr
->save
));
588 if (attr
->allocatable
)
589 fputs (" ALLOCATABLE", dumpfile
);
591 fputs (" DIMENSION", dumpfile
);
593 fputs (" EXTERNAL", dumpfile
);
595 fputs (" INTRINSIC", dumpfile
);
597 fputs (" OPTIONAL", dumpfile
);
599 fputs (" POINTER", dumpfile
);
600 if (attr
->is_protected
)
601 fputs (" PROTECTED", dumpfile
);
603 fputs (" VALUE", dumpfile
);
605 fputs (" VOLATILE", dumpfile
);
606 if (attr
->threadprivate
)
607 fputs (" THREADPRIVATE", dumpfile
);
609 fputs (" TARGET", dumpfile
);
611 fputs (" DUMMY", dumpfile
);
613 fputs (" RESULT", dumpfile
);
615 fputs (" ENTRY", dumpfile
);
617 fputs (" BIND(C)", dumpfile
);
620 fputs (" DATA", dumpfile
);
622 fputs (" USE-ASSOC", dumpfile
);
623 if (attr
->in_namelist
)
624 fputs (" IN-NAMELIST", dumpfile
);
626 fputs (" IN-COMMON", dumpfile
);
629 fputs (" ABSTRACT", dumpfile
);
631 fputs (" FUNCTION", dumpfile
);
632 if (attr
->subroutine
)
633 fputs (" SUBROUTINE", dumpfile
);
634 if (attr
->implicit_type
)
635 fputs (" IMPLICIT-TYPE", dumpfile
);
638 fputs (" SEQUENCE", dumpfile
);
640 fputs (" ELEMENTAL", dumpfile
);
642 fputs (" PURE", dumpfile
);
644 fputs (" RECURSIVE", dumpfile
);
646 fputc (')', dumpfile
);
650 /* Show components of a derived type. */
653 show_components (gfc_symbol
*sym
)
657 for (c
= sym
->components
; c
; c
= c
->next
)
659 fprintf (dumpfile
, "(%s ", c
->name
);
660 show_typespec (&c
->ts
);
662 fputs (" POINTER", dumpfile
);
663 if (c
->attr
.proc_pointer
)
664 fputs (" PPC", dumpfile
);
665 if (c
->attr
.dimension
)
666 fputs (" DIMENSION", dumpfile
);
667 fputc (' ', dumpfile
);
668 show_array_spec (c
->as
);
670 fprintf (dumpfile
, " %s", gfc_code2string (access_types
, c
->attr
.access
));
671 fputc (')', dumpfile
);
673 fputc (' ', dumpfile
);
678 /* Show the f2k_derived namespace with procedure bindings. */
681 show_typebound (gfc_symtree
* st
)
683 gcc_assert (st
->n
.tb
);
686 if (st
->n
.tb
->is_generic
)
687 fputs ("GENERIC", dumpfile
);
690 fputs ("PROCEDURE, ", dumpfile
);
691 if (st
->n
.tb
->nopass
)
692 fputs ("NOPASS", dumpfile
);
695 if (st
->n
.tb
->pass_arg
)
696 fprintf (dumpfile
, "PASS(%s)", st
->n
.tb
->pass_arg
);
698 fputs ("PASS", dumpfile
);
700 if (st
->n
.tb
->non_overridable
)
701 fputs (", NON_OVERRIDABLE", dumpfile
);
704 if (st
->n
.tb
->access
== ACCESS_PUBLIC
)
705 fputs (", PUBLIC", dumpfile
);
707 fputs (", PRIVATE", dumpfile
);
709 fprintf (dumpfile
, " :: %s => ", st
->name
);
711 if (st
->n
.tb
->is_generic
)
714 for (g
= st
->n
.tb
->u
.generic
; g
; g
= g
->next
)
716 fputs (g
->specific_st
->name
, dumpfile
);
718 fputs (", ", dumpfile
);
722 fputs (st
->n
.tb
->u
.specific
->n
.sym
->name
, dumpfile
);
726 show_f2k_derived (gfc_namespace
* f2k
)
732 /* Finalizer bindings. */
733 for (f
= f2k
->finalizers
; f
; f
= f
->next
)
736 fprintf (dumpfile
, "FINAL %s", f
->proc_sym
->name
);
739 /* Type-bound procedures. */
740 gfc_traverse_symtree (f2k
->tb_sym_root
, &show_typebound
);
746 /* Show a symbol. If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
747 show the interface. Information needed to reconstruct the list of
748 specific interfaces associated with a generic symbol is done within
752 show_symbol (gfc_symbol
*sym
)
754 gfc_formal_arglist
*formal
;
762 fprintf (dumpfile
, "symbol %s ", sym
->name
);
763 show_typespec (&sym
->ts
);
764 show_attr (&sym
->attr
);
769 fputs ("value: ", dumpfile
);
770 show_expr (sym
->value
);
776 fputs ("Array spec:", dumpfile
);
777 show_array_spec (sym
->as
);
783 fputs ("Generic interfaces:", dumpfile
);
784 for (intr
= sym
->generic
; intr
; intr
= intr
->next
)
785 fprintf (dumpfile
, " %s", intr
->sym
->name
);
791 fprintf (dumpfile
, "result: %s", sym
->result
->name
);
797 fputs ("components: ", dumpfile
);
798 show_components (sym
);
801 if (sym
->f2k_derived
)
804 fputs ("Procedure bindings:\n", dumpfile
);
805 show_f2k_derived (sym
->f2k_derived
);
811 fputs ("Formal arglist:", dumpfile
);
813 for (formal
= sym
->formal
; formal
; formal
= formal
->next
)
815 if (formal
->sym
!= NULL
)
816 fprintf (dumpfile
, " %s", formal
->sym
->name
);
818 fputs (" [Alt Return]", dumpfile
);
825 fputs ("Formal namespace", dumpfile
);
826 show_namespace (sym
->formal_ns
);
829 fputc ('\n', dumpfile
);
833 /* Show a user-defined operator. Just prints an operator
834 and the name of the associated subroutine, really. */
837 show_uop (gfc_user_op
*uop
)
842 fprintf (dumpfile
, "%s:", uop
->name
);
844 for (intr
= uop
->op
; intr
; intr
= intr
->next
)
845 fprintf (dumpfile
, " %s", intr
->sym
->name
);
849 /* Workhorse function for traversing the user operator symtree. */
852 traverse_uop (gfc_symtree
*st
, void (*func
) (gfc_user_op
*))
859 traverse_uop (st
->left
, func
);
860 traverse_uop (st
->right
, func
);
864 /* Traverse the tree of user operator nodes. */
867 gfc_traverse_user_op (gfc_namespace
*ns
, void (*func
) (gfc_user_op
*))
869 traverse_uop (ns
->uop_root
, func
);
873 /* Function to display a common block. */
876 show_common (gfc_symtree
*st
)
881 fprintf (dumpfile
, "common: /%s/ ", st
->name
);
883 s
= st
->n
.common
->head
;
886 fprintf (dumpfile
, "%s", s
->name
);
889 fputs (", ", dumpfile
);
891 fputc ('\n', dumpfile
);
895 /* Worker function to display the symbol tree. */
898 show_symtree (gfc_symtree
*st
)
901 fprintf (dumpfile
, "symtree: %s Ambig %d", st
->name
, st
->ambiguous
);
903 if (st
->n
.sym
->ns
!= gfc_current_ns
)
904 fprintf (dumpfile
, " from namespace %s", st
->n
.sym
->ns
->proc_name
->name
);
906 show_symbol (st
->n
.sym
);
910 /******************* Show gfc_code structures **************/
913 /* Show a list of code structures. Mutually recursive with
917 show_code (int level
, gfc_code
*c
)
919 for (; c
; c
= c
->next
)
920 show_code_node (level
, c
);
924 show_namelist (gfc_namelist
*n
)
926 for (; n
->next
; n
= n
->next
)
927 fprintf (dumpfile
, "%s,", n
->sym
->name
);
928 fprintf (dumpfile
, "%s", n
->sym
->name
);
931 /* Show a single OpenMP directive node and everything underneath it
935 show_omp_node (int level
, gfc_code
*c
)
937 gfc_omp_clauses
*omp_clauses
= NULL
;
938 const char *name
= NULL
;
942 case EXEC_OMP_ATOMIC
: name
= "ATOMIC"; break;
943 case EXEC_OMP_BARRIER
: name
= "BARRIER"; break;
944 case EXEC_OMP_CRITICAL
: name
= "CRITICAL"; break;
945 case EXEC_OMP_FLUSH
: name
= "FLUSH"; break;
946 case EXEC_OMP_DO
: name
= "DO"; break;
947 case EXEC_OMP_MASTER
: name
= "MASTER"; break;
948 case EXEC_OMP_ORDERED
: name
= "ORDERED"; break;
949 case EXEC_OMP_PARALLEL
: name
= "PARALLEL"; break;
950 case EXEC_OMP_PARALLEL_DO
: name
= "PARALLEL DO"; break;
951 case EXEC_OMP_PARALLEL_SECTIONS
: name
= "PARALLEL SECTIONS"; break;
952 case EXEC_OMP_PARALLEL_WORKSHARE
: name
= "PARALLEL WORKSHARE"; break;
953 case EXEC_OMP_SECTIONS
: name
= "SECTIONS"; break;
954 case EXEC_OMP_SINGLE
: name
= "SINGLE"; break;
955 case EXEC_OMP_TASK
: name
= "TASK"; break;
956 case EXEC_OMP_TASKWAIT
: name
= "TASKWAIT"; break;
957 case EXEC_OMP_WORKSHARE
: name
= "WORKSHARE"; break;
961 fprintf (dumpfile
, "!$OMP %s", name
);
965 case EXEC_OMP_PARALLEL
:
966 case EXEC_OMP_PARALLEL_DO
:
967 case EXEC_OMP_PARALLEL_SECTIONS
:
968 case EXEC_OMP_SECTIONS
:
969 case EXEC_OMP_SINGLE
:
970 case EXEC_OMP_WORKSHARE
:
971 case EXEC_OMP_PARALLEL_WORKSHARE
:
973 omp_clauses
= c
->ext
.omp_clauses
;
975 case EXEC_OMP_CRITICAL
:
977 fprintf (dumpfile
, " (%s)", c
->ext
.omp_name
);
980 if (c
->ext
.omp_namelist
)
982 fputs (" (", dumpfile
);
983 show_namelist (c
->ext
.omp_namelist
);
984 fputc (')', dumpfile
);
987 case EXEC_OMP_BARRIER
:
988 case EXEC_OMP_TASKWAIT
:
997 if (omp_clauses
->if_expr
)
999 fputs (" IF(", dumpfile
);
1000 show_expr (omp_clauses
->if_expr
);
1001 fputc (')', dumpfile
);
1003 if (omp_clauses
->num_threads
)
1005 fputs (" NUM_THREADS(", dumpfile
);
1006 show_expr (omp_clauses
->num_threads
);
1007 fputc (')', dumpfile
);
1009 if (omp_clauses
->sched_kind
!= OMP_SCHED_NONE
)
1012 switch (omp_clauses
->sched_kind
)
1014 case OMP_SCHED_STATIC
: type
= "STATIC"; break;
1015 case OMP_SCHED_DYNAMIC
: type
= "DYNAMIC"; break;
1016 case OMP_SCHED_GUIDED
: type
= "GUIDED"; break;
1017 case OMP_SCHED_RUNTIME
: type
= "RUNTIME"; break;
1018 case OMP_SCHED_AUTO
: type
= "AUTO"; break;
1022 fprintf (dumpfile
, " SCHEDULE (%s", type
);
1023 if (omp_clauses
->chunk_size
)
1025 fputc (',', dumpfile
);
1026 show_expr (omp_clauses
->chunk_size
);
1028 fputc (')', dumpfile
);
1030 if (omp_clauses
->default_sharing
!= OMP_DEFAULT_UNKNOWN
)
1033 switch (omp_clauses
->default_sharing
)
1035 case OMP_DEFAULT_NONE
: type
= "NONE"; break;
1036 case OMP_DEFAULT_PRIVATE
: type
= "PRIVATE"; break;
1037 case OMP_DEFAULT_SHARED
: type
= "SHARED"; break;
1038 case OMP_DEFAULT_FIRSTPRIVATE
: type
= "FIRSTPRIVATE"; break;
1042 fprintf (dumpfile
, " DEFAULT(%s)", type
);
1044 if (omp_clauses
->ordered
)
1045 fputs (" ORDERED", dumpfile
);
1046 if (omp_clauses
->untied
)
1047 fputs (" UNTIED", dumpfile
);
1048 if (omp_clauses
->collapse
)
1049 fprintf (dumpfile
, " COLLAPSE(%d)", omp_clauses
->collapse
);
1050 for (list_type
= 0; list_type
< OMP_LIST_NUM
; list_type
++)
1051 if (omp_clauses
->lists
[list_type
] != NULL
1052 && list_type
!= OMP_LIST_COPYPRIVATE
)
1055 if (list_type
>= OMP_LIST_REDUCTION_FIRST
)
1059 case OMP_LIST_PLUS
: type
= "+"; break;
1060 case OMP_LIST_MULT
: type
= "*"; break;
1061 case OMP_LIST_SUB
: type
= "-"; break;
1062 case OMP_LIST_AND
: type
= ".AND."; break;
1063 case OMP_LIST_OR
: type
= ".OR."; break;
1064 case OMP_LIST_EQV
: type
= ".EQV."; break;
1065 case OMP_LIST_NEQV
: type
= ".NEQV."; break;
1066 case OMP_LIST_MAX
: type
= "MAX"; break;
1067 case OMP_LIST_MIN
: type
= "MIN"; break;
1068 case OMP_LIST_IAND
: type
= "IAND"; break;
1069 case OMP_LIST_IOR
: type
= "IOR"; break;
1070 case OMP_LIST_IEOR
: type
= "IEOR"; break;
1074 fprintf (dumpfile
, " REDUCTION(%s:", type
);
1080 case OMP_LIST_PRIVATE
: type
= "PRIVATE"; break;
1081 case OMP_LIST_FIRSTPRIVATE
: type
= "FIRSTPRIVATE"; break;
1082 case OMP_LIST_LASTPRIVATE
: type
= "LASTPRIVATE"; break;
1083 case OMP_LIST_SHARED
: type
= "SHARED"; break;
1084 case OMP_LIST_COPYIN
: type
= "COPYIN"; break;
1088 fprintf (dumpfile
, " %s(", type
);
1090 show_namelist (omp_clauses
->lists
[list_type
]);
1091 fputc (')', dumpfile
);
1094 fputc ('\n', dumpfile
);
1095 if (c
->op
== EXEC_OMP_SECTIONS
|| c
->op
== EXEC_OMP_PARALLEL_SECTIONS
)
1097 gfc_code
*d
= c
->block
;
1100 show_code (level
+ 1, d
->next
);
1101 if (d
->block
== NULL
)
1103 code_indent (level
, 0);
1104 fputs ("!$OMP SECTION\n", dumpfile
);
1109 show_code (level
+ 1, c
->block
->next
);
1110 if (c
->op
== EXEC_OMP_ATOMIC
)
1112 code_indent (level
, 0);
1113 fprintf (dumpfile
, "!$OMP END %s", name
);
1114 if (omp_clauses
!= NULL
)
1116 if (omp_clauses
->lists
[OMP_LIST_COPYPRIVATE
])
1118 fputs (" COPYPRIVATE(", dumpfile
);
1119 show_namelist (omp_clauses
->lists
[OMP_LIST_COPYPRIVATE
]);
1120 fputc (')', dumpfile
);
1122 else if (omp_clauses
->nowait
)
1123 fputs (" NOWAIT", dumpfile
);
1125 else if (c
->op
== EXEC_OMP_CRITICAL
&& c
->ext
.omp_name
)
1126 fprintf (dumpfile
, " (%s)", c
->ext
.omp_name
);
1130 /* Show a single code node and everything underneath it if necessary. */
1133 show_code_node (int level
, gfc_code
*c
)
1135 gfc_forall_iterator
*fa
;
1145 code_indent (level
, c
->here
);
1149 case EXEC_END_PROCEDURE
:
1153 fputs ("NOP", dumpfile
);
1157 fputs ("CONTINUE", dumpfile
);
1161 fprintf (dumpfile
, "ENTRY %s", c
->ext
.entry
->sym
->name
);
1164 case EXEC_INIT_ASSIGN
:
1166 fputs ("ASSIGN ", dumpfile
);
1167 show_expr (c
->expr1
);
1168 fputc (' ', dumpfile
);
1169 show_expr (c
->expr2
);
1172 case EXEC_LABEL_ASSIGN
:
1173 fputs ("LABEL ASSIGN ", dumpfile
);
1174 show_expr (c
->expr1
);
1175 fprintf (dumpfile
, " %d", c
->label1
->value
);
1178 case EXEC_POINTER_ASSIGN
:
1179 fputs ("POINTER ASSIGN ", dumpfile
);
1180 show_expr (c
->expr1
);
1181 fputc (' ', dumpfile
);
1182 show_expr (c
->expr2
);
1186 fputs ("GOTO ", dumpfile
);
1188 fprintf (dumpfile
, "%d", c
->label1
->value
);
1191 show_expr (c
->expr1
);
1195 fputs (", (", dumpfile
);
1196 for (; d
; d
= d
->block
)
1198 code_indent (level
, d
->label1
);
1199 if (d
->block
!= NULL
)
1200 fputc (',', dumpfile
);
1202 fputc (')', dumpfile
);
1209 case EXEC_ASSIGN_CALL
:
1210 if (c
->resolved_sym
)
1211 fprintf (dumpfile
, "CALL %s ", c
->resolved_sym
->name
);
1212 else if (c
->symtree
)
1213 fprintf (dumpfile
, "CALL %s ", c
->symtree
->name
);
1215 fputs ("CALL ?? ", dumpfile
);
1217 show_actual_arglist (c
->ext
.actual
);
1221 fputs ("CALL ", dumpfile
);
1222 show_compcall (c
->expr1
);
1226 fputs ("CALL ", dumpfile
);
1227 show_expr (c
->expr1
);
1228 show_actual_arglist (c
->ext
.actual
);
1232 fputs ("RETURN ", dumpfile
);
1234 show_expr (c
->expr1
);
1238 fputs ("PAUSE ", dumpfile
);
1240 if (c
->expr1
!= NULL
)
1241 show_expr (c
->expr1
);
1243 fprintf (dumpfile
, "%d", c
->ext
.stop_code
);
1248 fputs ("STOP ", dumpfile
);
1250 if (c
->expr1
!= NULL
)
1251 show_expr (c
->expr1
);
1253 fprintf (dumpfile
, "%d", c
->ext
.stop_code
);
1257 case EXEC_ARITHMETIC_IF
:
1258 fputs ("IF ", dumpfile
);
1259 show_expr (c
->expr1
);
1260 fprintf (dumpfile
, " %d, %d, %d",
1261 c
->label1
->value
, c
->label2
->value
, c
->label3
->value
);
1266 fputs ("IF ", dumpfile
);
1267 show_expr (d
->expr1
);
1268 fputc ('\n', dumpfile
);
1269 show_code (level
+ 1, d
->next
);
1272 for (; d
; d
= d
->block
)
1274 code_indent (level
, 0);
1276 if (d
->expr1
== NULL
)
1277 fputs ("ELSE\n", dumpfile
);
1280 fputs ("ELSE IF ", dumpfile
);
1281 show_expr (d
->expr1
);
1282 fputc ('\n', dumpfile
);
1285 show_code (level
+ 1, d
->next
);
1288 code_indent (level
, c
->label1
);
1290 fputs ("ENDIF", dumpfile
);
1295 fputs ("SELECT CASE ", dumpfile
);
1296 show_expr (c
->expr1
);
1297 fputc ('\n', dumpfile
);
1299 for (; d
; d
= d
->block
)
1301 code_indent (level
, 0);
1303 fputs ("CASE ", dumpfile
);
1304 for (cp
= d
->ext
.case_list
; cp
; cp
= cp
->next
)
1306 fputc ('(', dumpfile
);
1307 show_expr (cp
->low
);
1308 fputc (' ', dumpfile
);
1309 show_expr (cp
->high
);
1310 fputc (')', dumpfile
);
1311 fputc (' ', dumpfile
);
1313 fputc ('\n', dumpfile
);
1315 show_code (level
+ 1, d
->next
);
1318 code_indent (level
, c
->label1
);
1319 fputs ("END SELECT", dumpfile
);
1323 fputs ("WHERE ", dumpfile
);
1326 show_expr (d
->expr1
);
1327 fputc ('\n', dumpfile
);
1329 show_code (level
+ 1, d
->next
);
1331 for (d
= d
->block
; d
; d
= d
->block
)
1333 code_indent (level
, 0);
1334 fputs ("ELSE WHERE ", dumpfile
);
1335 show_expr (d
->expr1
);
1336 fputc ('\n', dumpfile
);
1337 show_code (level
+ 1, d
->next
);
1340 code_indent (level
, 0);
1341 fputs ("END WHERE", dumpfile
);
1346 fputs ("FORALL ", dumpfile
);
1347 for (fa
= c
->ext
.forall_iterator
; fa
; fa
= fa
->next
)
1349 show_expr (fa
->var
);
1350 fputc (' ', dumpfile
);
1351 show_expr (fa
->start
);
1352 fputc (':', dumpfile
);
1353 show_expr (fa
->end
);
1354 fputc (':', dumpfile
);
1355 show_expr (fa
->stride
);
1357 if (fa
->next
!= NULL
)
1358 fputc (',', dumpfile
);
1361 if (c
->expr1
!= NULL
)
1363 fputc (',', dumpfile
);
1364 show_expr (c
->expr1
);
1366 fputc ('\n', dumpfile
);
1368 show_code (level
+ 1, c
->block
->next
);
1370 code_indent (level
, 0);
1371 fputs ("END FORALL", dumpfile
);
1375 fputs ("DO ", dumpfile
);
1377 show_expr (c
->ext
.iterator
->var
);
1378 fputc ('=', dumpfile
);
1379 show_expr (c
->ext
.iterator
->start
);
1380 fputc (' ', dumpfile
);
1381 show_expr (c
->ext
.iterator
->end
);
1382 fputc (' ', dumpfile
);
1383 show_expr (c
->ext
.iterator
->step
);
1384 fputc ('\n', dumpfile
);
1386 show_code (level
+ 1, c
->block
->next
);
1388 code_indent (level
, 0);
1389 fputs ("END DO", dumpfile
);
1393 fputs ("DO WHILE ", dumpfile
);
1394 show_expr (c
->expr1
);
1395 fputc ('\n', dumpfile
);
1397 show_code (level
+ 1, c
->block
->next
);
1399 code_indent (level
, c
->label1
);
1400 fputs ("END DO", dumpfile
);
1404 fputs ("CYCLE", dumpfile
);
1406 fprintf (dumpfile
, " %s", c
->symtree
->n
.sym
->name
);
1410 fputs ("EXIT", dumpfile
);
1412 fprintf (dumpfile
, " %s", c
->symtree
->n
.sym
->name
);
1416 fputs ("ALLOCATE ", dumpfile
);
1419 fputs (" STAT=", dumpfile
);
1420 show_expr (c
->expr1
);
1425 fputs (" ERRMSG=", dumpfile
);
1426 show_expr (c
->expr2
);
1429 for (a
= c
->ext
.alloc_list
; a
; a
= a
->next
)
1431 fputc (' ', dumpfile
);
1432 show_expr (a
->expr
);
1437 case EXEC_DEALLOCATE
:
1438 fputs ("DEALLOCATE ", dumpfile
);
1441 fputs (" STAT=", dumpfile
);
1442 show_expr (c
->expr1
);
1447 fputs (" ERRMSG=", dumpfile
);
1448 show_expr (c
->expr2
);
1451 for (a
= c
->ext
.alloc_list
; a
; a
= a
->next
)
1453 fputc (' ', dumpfile
);
1454 show_expr (a
->expr
);
1460 fputs ("OPEN", dumpfile
);
1465 fputs (" UNIT=", dumpfile
);
1466 show_expr (open
->unit
);
1470 fputs (" IOMSG=", dumpfile
);
1471 show_expr (open
->iomsg
);
1475 fputs (" IOSTAT=", dumpfile
);
1476 show_expr (open
->iostat
);
1480 fputs (" FILE=", dumpfile
);
1481 show_expr (open
->file
);
1485 fputs (" STATUS=", dumpfile
);
1486 show_expr (open
->status
);
1490 fputs (" ACCESS=", dumpfile
);
1491 show_expr (open
->access
);
1495 fputs (" FORM=", dumpfile
);
1496 show_expr (open
->form
);
1500 fputs (" RECL=", dumpfile
);
1501 show_expr (open
->recl
);
1505 fputs (" BLANK=", dumpfile
);
1506 show_expr (open
->blank
);
1510 fputs (" POSITION=", dumpfile
);
1511 show_expr (open
->position
);
1515 fputs (" ACTION=", dumpfile
);
1516 show_expr (open
->action
);
1520 fputs (" DELIM=", dumpfile
);
1521 show_expr (open
->delim
);
1525 fputs (" PAD=", dumpfile
);
1526 show_expr (open
->pad
);
1530 fputs (" DECIMAL=", dumpfile
);
1531 show_expr (open
->decimal
);
1535 fputs (" ENCODING=", dumpfile
);
1536 show_expr (open
->encoding
);
1540 fputs (" ROUND=", dumpfile
);
1541 show_expr (open
->round
);
1545 fputs (" SIGN=", dumpfile
);
1546 show_expr (open
->sign
);
1550 fputs (" CONVERT=", dumpfile
);
1551 show_expr (open
->convert
);
1553 if (open
->asynchronous
)
1555 fputs (" ASYNCHRONOUS=", dumpfile
);
1556 show_expr (open
->asynchronous
);
1558 if (open
->err
!= NULL
)
1559 fprintf (dumpfile
, " ERR=%d", open
->err
->value
);
1564 fputs ("CLOSE", dumpfile
);
1565 close
= c
->ext
.close
;
1569 fputs (" UNIT=", dumpfile
);
1570 show_expr (close
->unit
);
1574 fputs (" IOMSG=", dumpfile
);
1575 show_expr (close
->iomsg
);
1579 fputs (" IOSTAT=", dumpfile
);
1580 show_expr (close
->iostat
);
1584 fputs (" STATUS=", dumpfile
);
1585 show_expr (close
->status
);
1587 if (close
->err
!= NULL
)
1588 fprintf (dumpfile
, " ERR=%d", close
->err
->value
);
1591 case EXEC_BACKSPACE
:
1592 fputs ("BACKSPACE", dumpfile
);
1596 fputs ("ENDFILE", dumpfile
);
1600 fputs ("REWIND", dumpfile
);
1604 fputs ("FLUSH", dumpfile
);
1607 fp
= c
->ext
.filepos
;
1611 fputs (" UNIT=", dumpfile
);
1612 show_expr (fp
->unit
);
1616 fputs (" IOMSG=", dumpfile
);
1617 show_expr (fp
->iomsg
);
1621 fputs (" IOSTAT=", dumpfile
);
1622 show_expr (fp
->iostat
);
1624 if (fp
->err
!= NULL
)
1625 fprintf (dumpfile
, " ERR=%d", fp
->err
->value
);
1629 fputs ("INQUIRE", dumpfile
);
1634 fputs (" UNIT=", dumpfile
);
1635 show_expr (i
->unit
);
1639 fputs (" FILE=", dumpfile
);
1640 show_expr (i
->file
);
1645 fputs (" IOMSG=", dumpfile
);
1646 show_expr (i
->iomsg
);
1650 fputs (" IOSTAT=", dumpfile
);
1651 show_expr (i
->iostat
);
1655 fputs (" EXIST=", dumpfile
);
1656 show_expr (i
->exist
);
1660 fputs (" OPENED=", dumpfile
);
1661 show_expr (i
->opened
);
1665 fputs (" NUMBER=", dumpfile
);
1666 show_expr (i
->number
);
1670 fputs (" NAMED=", dumpfile
);
1671 show_expr (i
->named
);
1675 fputs (" NAME=", dumpfile
);
1676 show_expr (i
->name
);
1680 fputs (" ACCESS=", dumpfile
);
1681 show_expr (i
->access
);
1685 fputs (" SEQUENTIAL=", dumpfile
);
1686 show_expr (i
->sequential
);
1691 fputs (" DIRECT=", dumpfile
);
1692 show_expr (i
->direct
);
1696 fputs (" FORM=", dumpfile
);
1697 show_expr (i
->form
);
1701 fputs (" FORMATTED", dumpfile
);
1702 show_expr (i
->formatted
);
1706 fputs (" UNFORMATTED=", dumpfile
);
1707 show_expr (i
->unformatted
);
1711 fputs (" RECL=", dumpfile
);
1712 show_expr (i
->recl
);
1716 fputs (" NEXTREC=", dumpfile
);
1717 show_expr (i
->nextrec
);
1721 fputs (" BLANK=", dumpfile
);
1722 show_expr (i
->blank
);
1726 fputs (" POSITION=", dumpfile
);
1727 show_expr (i
->position
);
1731 fputs (" ACTION=", dumpfile
);
1732 show_expr (i
->action
);
1736 fputs (" READ=", dumpfile
);
1737 show_expr (i
->read
);
1741 fputs (" WRITE=", dumpfile
);
1742 show_expr (i
->write
);
1746 fputs (" READWRITE=", dumpfile
);
1747 show_expr (i
->readwrite
);
1751 fputs (" DELIM=", dumpfile
);
1752 show_expr (i
->delim
);
1756 fputs (" PAD=", dumpfile
);
1761 fputs (" CONVERT=", dumpfile
);
1762 show_expr (i
->convert
);
1764 if (i
->asynchronous
)
1766 fputs (" ASYNCHRONOUS=", dumpfile
);
1767 show_expr (i
->asynchronous
);
1771 fputs (" DECIMAL=", dumpfile
);
1772 show_expr (i
->decimal
);
1776 fputs (" ENCODING=", dumpfile
);
1777 show_expr (i
->encoding
);
1781 fputs (" PENDING=", dumpfile
);
1782 show_expr (i
->pending
);
1786 fputs (" ROUND=", dumpfile
);
1787 show_expr (i
->round
);
1791 fputs (" SIGN=", dumpfile
);
1792 show_expr (i
->sign
);
1796 fputs (" SIZE=", dumpfile
);
1797 show_expr (i
->size
);
1801 fputs (" ID=", dumpfile
);
1806 fprintf (dumpfile
, " ERR=%d", i
->err
->value
);
1810 fputs ("IOLENGTH ", dumpfile
);
1811 show_expr (c
->expr1
);
1816 fputs ("READ", dumpfile
);
1820 fputs ("WRITE", dumpfile
);
1826 fputs (" UNIT=", dumpfile
);
1827 show_expr (dt
->io_unit
);
1830 if (dt
->format_expr
)
1832 fputs (" FMT=", dumpfile
);
1833 show_expr (dt
->format_expr
);
1836 if (dt
->format_label
!= NULL
)
1837 fprintf (dumpfile
, " FMT=%d", dt
->format_label
->value
);
1839 fprintf (dumpfile
, " NML=%s", dt
->namelist
->name
);
1843 fputs (" IOMSG=", dumpfile
);
1844 show_expr (dt
->iomsg
);
1848 fputs (" IOSTAT=", dumpfile
);
1849 show_expr (dt
->iostat
);
1853 fputs (" SIZE=", dumpfile
);
1854 show_expr (dt
->size
);
1858 fputs (" REC=", dumpfile
);
1859 show_expr (dt
->rec
);
1863 fputs (" ADVANCE=", dumpfile
);
1864 show_expr (dt
->advance
);
1868 fputs (" ID=", dumpfile
);
1873 fputs (" POS=", dumpfile
);
1874 show_expr (dt
->pos
);
1876 if (dt
->asynchronous
)
1878 fputs (" ASYNCHRONOUS=", dumpfile
);
1879 show_expr (dt
->asynchronous
);
1883 fputs (" BLANK=", dumpfile
);
1884 show_expr (dt
->blank
);
1888 fputs (" DECIMAL=", dumpfile
);
1889 show_expr (dt
->decimal
);
1893 fputs (" DELIM=", dumpfile
);
1894 show_expr (dt
->delim
);
1898 fputs (" PAD=", dumpfile
);
1899 show_expr (dt
->pad
);
1903 fputs (" ROUND=", dumpfile
);
1904 show_expr (dt
->round
);
1908 fputs (" SIGN=", dumpfile
);
1909 show_expr (dt
->sign
);
1913 fputc ('\n', dumpfile
);
1914 for (c
= c
->block
->next
; c
; c
= c
->next
)
1915 show_code_node (level
+ (c
->next
!= NULL
), c
);
1919 fputs ("TRANSFER ", dumpfile
);
1920 show_expr (c
->expr1
);
1924 fputs ("DT_END", dumpfile
);
1927 if (dt
->err
!= NULL
)
1928 fprintf (dumpfile
, " ERR=%d", dt
->err
->value
);
1929 if (dt
->end
!= NULL
)
1930 fprintf (dumpfile
, " END=%d", dt
->end
->value
);
1931 if (dt
->eor
!= NULL
)
1932 fprintf (dumpfile
, " EOR=%d", dt
->eor
->value
);
1935 case EXEC_OMP_ATOMIC
:
1936 case EXEC_OMP_BARRIER
:
1937 case EXEC_OMP_CRITICAL
:
1938 case EXEC_OMP_FLUSH
:
1940 case EXEC_OMP_MASTER
:
1941 case EXEC_OMP_ORDERED
:
1942 case EXEC_OMP_PARALLEL
:
1943 case EXEC_OMP_PARALLEL_DO
:
1944 case EXEC_OMP_PARALLEL_SECTIONS
:
1945 case EXEC_OMP_PARALLEL_WORKSHARE
:
1946 case EXEC_OMP_SECTIONS
:
1947 case EXEC_OMP_SINGLE
:
1949 case EXEC_OMP_TASKWAIT
:
1950 case EXEC_OMP_WORKSHARE
:
1951 show_omp_node (level
, c
);
1955 gfc_internal_error ("show_code_node(): Bad statement code");
1958 fputc ('\n', dumpfile
);
1962 /* Show an equivalence chain. */
1965 show_equiv (gfc_equiv
*eq
)
1968 fputs ("Equivalence: ", dumpfile
);
1971 show_expr (eq
->expr
);
1974 fputs (", ", dumpfile
);
1979 /* Show a freakin' whole namespace. */
1982 show_namespace (gfc_namespace
*ns
)
1984 gfc_interface
*intr
;
1985 gfc_namespace
*save
;
1990 save
= gfc_current_ns
;
1994 fputs ("Namespace:", dumpfile
);
2002 while (i
< GFC_LETTERS
- 1
2003 && gfc_compare_types(&ns
->default_type
[i
+1],
2004 &ns
->default_type
[l
]))
2008 fprintf (dumpfile
, " %c-%c: ", l
+'A', i
+'A');
2010 fprintf (dumpfile
, " %c: ", l
+'A');
2012 show_typespec(&ns
->default_type
[l
]);
2014 } while (i
< GFC_LETTERS
);
2016 if (ns
->proc_name
!= NULL
)
2019 fprintf (dumpfile
, "procedure name = %s", ns
->proc_name
->name
);
2022 gfc_current_ns
= ns
;
2023 gfc_traverse_symtree (ns
->common_root
, show_common
);
2025 gfc_traverse_symtree (ns
->sym_root
, show_symtree
);
2027 for (op
= GFC_INTRINSIC_BEGIN
; op
!= GFC_INTRINSIC_END
; op
++)
2029 /* User operator interfaces */
2035 fprintf (dumpfile
, "Operator interfaces for %s:",
2036 gfc_op2string ((gfc_intrinsic_op
) op
));
2038 for (; intr
; intr
= intr
->next
)
2039 fprintf (dumpfile
, " %s", intr
->sym
->name
);
2042 if (ns
->uop_root
!= NULL
)
2045 fputs ("User operators:\n", dumpfile
);
2046 gfc_traverse_user_op (ns
, show_uop
);
2050 for (eq
= ns
->equiv
; eq
; eq
= eq
->next
)
2053 fputc ('\n', dumpfile
);
2054 fputc ('\n', dumpfile
);
2056 show_code (0, ns
->code
);
2058 for (ns
= ns
->contained
; ns
; ns
= ns
->sibling
)
2061 fputs ("CONTAINS\n", dumpfile
);
2062 show_namespace (ns
);
2066 fputc ('\n', dumpfile
);
2067 gfc_current_ns
= save
;
2071 /* Main function for dumping a parse tree. */
2074 gfc_dump_parse_tree (gfc_namespace
*ns
, FILE *file
)
2077 show_namespace (ns
);