]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/dump-parse-tree.c
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
[arm] Make ACLE builtins use arm_* namespace for expanders
[thirdparty/gcc.git] / gcc / fortran / dump-parse-tree.c
CommitLineData
6de9cd9a 1/* Parse tree dumper
a5544970 2 Copyright (C) 2003-2019 Free Software Foundation, Inc.
6de9cd9a
DN		 3 Contributed by Steven Bosscher
4
9fc4d79b 5This file is part of GCC.
6de9cd9a 6
9fc4d79b
TS		 7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
d234d788 9Software Foundation; either version 3, or (at your option) any later
9fc4d79b 10version.
6de9cd9a 11
9fc4d79b
TS		 12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
6de9cd9a
DN		 16
17You should have received a copy of the GNU General Public License
d234d788
NC		 18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
6de9cd9a
DN		 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"
7274feea 34#include "system.h"
953bee7c 35#include "coretypes.h"
6de9cd9a 36#include "gfortran.h"
b7e75771 37#include "constructor.h"
6328ce1f 38#include "version.h"
6de9cd9a
DN		 39
40/* Keep track of indentation for symbol tree dumps. */
41static int show_level = 0;
42
6c1abb5c
FXC		 43/* The file handle we're dumping to is kept in a static variable. This
44 is not too cool, but it avoids a lot of passing it around. */
45static FILE *dumpfile;
46
47/* Forward declaration of some of the functions. */
48static void show_expr (gfc_expr *p);
49static void show_code_node (int, gfc_code *);
50static void show_namespace (gfc_namespace *ns);
d32e1fd8 51static void show_code (int, gfc_code *);
5ea0d4df
TK		 52static void show_symbol (gfc_symbol *);
53static void show_typespec (gfc_typespec *);
60e8cda6
TK		 54static void show_ref (gfc_ref *);
55static void show_attr (symbol_attribute *, const char *);
6c1abb5c 56
3c7ac37e
TB		 57/* Allow dumping of an expression in the debugger. */
58void gfc_debug_expr (gfc_expr *);
59
60e8cda6
TK		 60void debug (symbol_attribute *attr)
61{
62 FILE *tmp = dumpfile;
63 dumpfile = stderr;
64 show_attr (attr, NULL);
65 fputc ('\n', dumpfile);
66 dumpfile = tmp;
67}
68
2d86d751
TK		 69void debug (gfc_formal_arglist *formal)
70{
71 FILE *tmp = dumpfile;
72 dumpfile = stderr;
73 for (; formal; formal = formal->next)
74 {
75 fputc ('\n', dumpfile);
76 show_symbol (formal->sym);
77 }
78 fputc ('\n', dumpfile);
79 dumpfile = tmp;
80}
81
60e8cda6
TK		 82void debug (symbol_attribute attr)
83{
84 debug (&attr);
85}
86
5ea0d4df
TK		 87void debug (gfc_expr *e)
88{
89 FILE *tmp = dumpfile;
90 dumpfile = stderr;
2d86d751
TK		 91 if (e != NULL)
92 {
93 show_expr (e);
94 fputc (' ', dumpfile);
95 show_typespec (&e->ts);
96 }
97 else
98 fputs ("() ", dumpfile);
99
5ea0d4df
TK		 100 fputc ('\n', dumpfile);
101 dumpfile = tmp;
102}
103
104void debug (gfc_typespec *ts)
105{
106 FILE *tmp = dumpfile;
107 dumpfile = stderr;
108 show_typespec (ts);
109 fputc ('\n', dumpfile);
110 dumpfile = tmp;
111}
112
113void debug (gfc_typespec ts)
114{
115 debug (&ts);
116}
117
60e8cda6
TK		 118void debug (gfc_ref *p)
119{
120 FILE *tmp = dumpfile;
121 dumpfile = stderr;
122 show_ref (p);
123 fputc ('\n', dumpfile);
124 dumpfile = tmp;
125}
126
3c7ac37e
TB		 127void
128gfc_debug_expr (gfc_expr *e)
129{
130 FILE *tmp = dumpfile;
f973b648 131 dumpfile = stderr;
3c7ac37e
TB		 132 show_expr (e);
133 fputc ('\n', dumpfile);
134 dumpfile = tmp;
135}
136
d32e1fd8
TK		 137/* Allow for dumping of a piece of code in the debugger. */
138void gfc_debug_code (gfc_code *c);
139
140void
141gfc_debug_code (gfc_code *c)
142{
143 FILE *tmp = dumpfile;
144 dumpfile = stderr;
145 show_code (1, c);
146 fputc ('\n', dumpfile);
147 dumpfile = tmp;
148}
3c7ac37e 149
5ea0d4df
TK		 150void debug (gfc_symbol *sym)
151{
152 FILE *tmp = dumpfile;
153 dumpfile = stderr;
154 show_symbol (sym);
155 fputc ('\n', dumpfile);
156 dumpfile = tmp;
157}
158
6de9cd9a
DN		 159/* Do indentation for a specific level. */
160
161static inline void
636dff67 162code_indent (int level, gfc_st_label *label)
6de9cd9a
DN		 163{
164 int i;
165
166 if (label != NULL)
6c1abb5c 167 fprintf (dumpfile, "%-5d ", label->value);
6de9cd9a 168
8cf8ca52 169 for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
6c1abb5c 170 fputc (' ', dumpfile);
6de9cd9a
DN		 171}
172
173
174/* Simple indentation at the current level. This one
175 is used to show symbols. */
30c05595 176
6de9cd9a
DN		 177static inline void
178show_indent (void)
179{
6c1abb5c 180 fputc ('\n', dumpfile);
6de9cd9a
DN		 181 code_indent (show_level, NULL);
182}
183
184
185/* Show type-specific information. */
30c05595 186
6c1abb5c
FXC		 187static void
188show_typespec (gfc_typespec *ts)
6de9cd9a 189{
45a69325
TB		 190 if (ts->type == BT_ASSUMED)
191 {
192 fputs ("(TYPE(*))", dumpfile);
193 return;
194 }
195
6c1abb5c 196 fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
6de9cd9a
DN		 197
198 switch (ts->type)
199 {
200 case BT_DERIVED:
8cf8ca52 201 case BT_CLASS:
f6288c24 202 case BT_UNION:
bc21d315 203 fprintf (dumpfile, "%s", ts->u.derived->name);
6de9cd9a
DN		 204 break;
205
206 case BT_CHARACTER:
85dabaed
JW		 207 if (ts->u.cl)
208 show_expr (ts->u.cl->length);
e3210543 209 fprintf(dumpfile, " %d", ts->kind);
6de9cd9a
DN		 210 break;
211
212 default:
6c1abb5c 213 fprintf (dumpfile, "%d", ts->kind);
6de9cd9a
DN		 214 break;
215 }
874be74a
TK		 216 if (ts->is_c_interop)
217 fputs (" C_INTEROP", dumpfile);
218
219 if (ts->is_iso_c)
220 fputs (" ISO_C", dumpfile);
221
222 if (ts->deferred)
223 fputs (" DEFERRED", dumpfile);
6de9cd9a 224
6c1abb5c 225 fputc (')', dumpfile);
6de9cd9a
DN		 226}
227
228
229/* Show an actual argument list. */
230
6c1abb5c
FXC		 231static void
232show_actual_arglist (gfc_actual_arglist *a)
6de9cd9a 233{
6c1abb5c 234 fputc ('(', dumpfile);
6de9cd9a
DN		 235
236 for (; a; a = a->next)
237 {
6c1abb5c 238 fputc ('(', dumpfile);
cb9e4f55 239 if (a->name != NULL)
6c1abb5c 240 fprintf (dumpfile, "%s = ", a->name);
6de9cd9a 241 if (a->expr != NULL)
6c1abb5c 242 show_expr (a->expr);
6de9cd9a 243 else
6c1abb5c 244 fputs ("(arg not-present)", dumpfile);
6de9cd9a 245
6c1abb5c 246 fputc (')', dumpfile);
6de9cd9a 247 if (a->next != NULL)
6c1abb5c 248 fputc (' ', dumpfile);
6de9cd9a
DN		 249 }
250
6c1abb5c 251 fputc (')', dumpfile);
6de9cd9a
DN		 252}
253
254
49de9e73 255/* Show a gfc_array_spec array specification structure. */
6de9cd9a 256
6c1abb5c
FXC		 257static void
258show_array_spec (gfc_array_spec *as)
6de9cd9a
DN		 259{
260 const char *c;
261 int i;
262
263 if (as == NULL)
264 {
6c1abb5c 265 fputs ("()", dumpfile);
6de9cd9a
DN		 266 return;
267 }
268
be59db2d 269 fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
6de9cd9a 270
c62c6622 271 if (as->rank + as->corank > 0 || as->rank == -1)
6de9cd9a
DN		 272 {
273 switch (as->type)
274 {
275 case AS_EXPLICIT: c = "AS_EXPLICIT"; break;
276 case AS_DEFERRED: c = "AS_DEFERRED"; break;
277 case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break;
278 case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
c62c6622 279 case AS_ASSUMED_RANK: c = "AS_ASSUMED_RANK"; break;
6de9cd9a 280 default:
6c1abb5c 281 gfc_internal_error ("show_array_spec(): Unhandled array shape "
636dff67 282 "type.");
6de9cd9a 283 }
6c1abb5c 284 fprintf (dumpfile, " %s ", c);
6de9cd9a 285
be59db2d 286 for (i = 0; i < as->rank + as->corank; i++)
6de9cd9a 287 {
6c1abb5c
FXC		 288 show_expr (as->lower[i]);
289 fputc (' ', dumpfile);
290 show_expr (as->upper[i]);
291 fputc (' ', dumpfile);
6de9cd9a
DN		 292 }
293 }
294
6c1abb5c 295 fputc (')', dumpfile);
6de9cd9a
DN		 296}
297
298
49de9e73 299/* Show a gfc_array_ref array reference structure. */
6de9cd9a 300
6c1abb5c
FXC		 301static void
302show_array_ref (gfc_array_ref * ar)
6de9cd9a
DN		 303{
304 int i;
305
6c1abb5c 306 fputc ('(', dumpfile);
6de9cd9a
DN		 307
308 switch (ar->type)
309 {
310 case AR_FULL:
6c1abb5c 311 fputs ("FULL", dumpfile);
6de9cd9a
DN		 312 break;
313
314 case AR_SECTION:
315 for (i = 0; i < ar->dimen; i++)
316 {
fb89e8bd
TS		 317 /* There are two types of array sections: either the
318 elements are identified by an integer array ('vector'),
319 or by an index range. In the former case we only have to
320 print the start expression which contains the vector, in
321 the latter case we have to print any of lower and upper
322 bound and the stride, if they're present. */
dfd6231e 323
6de9cd9a 324 if (ar->start[i] != NULL)
6c1abb5c 325 show_expr (ar->start[i]);
6de9cd9a 326
fb89e8bd 327 if (ar->dimen_type[i] == DIMEN_RANGE)
6de9cd9a 328 {
6c1abb5c 329 fputc (':', dumpfile);
fb89e8bd
TS		 330
331 if (ar->end[i] != NULL)
6c1abb5c 332 show_expr (ar->end[i]);
fb89e8bd
TS		 333
334 if (ar->stride[i] != NULL)
335 {
6c1abb5c
FXC		 336 fputc (':', dumpfile);
337 show_expr (ar->stride[i]);
fb89e8bd 338 }
6de9cd9a
DN		 339 }
340
341 if (i != ar->dimen - 1)
6c1abb5c 342 fputs (" , ", dumpfile);
6de9cd9a
DN		 343 }
344 break;
345
346 case AR_ELEMENT:
347 for (i = 0; i < ar->dimen; i++)
348 {
6c1abb5c 349 show_expr (ar->start[i]);
6de9cd9a 350 if (i != ar->dimen - 1)
6c1abb5c 351 fputs (" , ", dumpfile);
6de9cd9a
DN		 352 }
353 break;
354
355 case AR_UNKNOWN:
6c1abb5c 356 fputs ("UNKNOWN", dumpfile);
6de9cd9a
DN		 357 break;
358
359 default:
6c1abb5c 360 gfc_internal_error ("show_array_ref(): Unknown array reference");
6de9cd9a
DN		 361 }
362
6c1abb5c 363 fputc (')', dumpfile);
6de9cd9a
DN		 364}
365
366
367/* Show a list of gfc_ref structures. */
368
6c1abb5c
FXC		 369static void
370show_ref (gfc_ref *p)
6de9cd9a 371{
6de9cd9a
DN		 372 for (; p; p = p->next)
373 switch (p->type)
374 {
375 case REF_ARRAY:
6c1abb5c 376 show_array_ref (&p->u.ar);
6de9cd9a
DN		 377 break;
378
379 case REF_COMPONENT:
6c1abb5c 380 fprintf (dumpfile, " %% %s", p->u.c.component->name);
6de9cd9a
DN		 381 break;
382
383 case REF_SUBSTRING:
6c1abb5c
FXC		 384 fputc ('(', dumpfile);
385 show_expr (p->u.ss.start);
386 fputc (':', dumpfile);
387 show_expr (p->u.ss.end);
388 fputc (')', dumpfile);
6de9cd9a
DN		 389 break;
390
a5fbc2f3
PT		 391 case REF_INQUIRY:
392 switch (p->u.i)
393 {
394 case INQUIRY_KIND:
395 fprintf (dumpfile, " INQUIRY_KIND ");
396 break;
397 case INQUIRY_LEN:
398 fprintf (dumpfile, " INQUIRY_LEN ");
399 break;
400 case INQUIRY_RE:
401 fprintf (dumpfile, " INQUIRY_RE ");
402 break;
403 case INQUIRY_IM:
404 fprintf (dumpfile, " INQUIRY_IM ");
405 }
406 break;
407
6de9cd9a 408 default:
6c1abb5c 409 gfc_internal_error ("show_ref(): Bad component code");
6de9cd9a
DN		 410 }
411}
412
413
414/* Display a constructor. Works recursively for array constructors. */
415
6c1abb5c 416static void
b7e75771 417show_constructor (gfc_constructor_base base)
6de9cd9a 418{
b7e75771
JD		 419 gfc_constructor *c;
420 for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
6de9cd9a
DN		 421 {
422 if (c->iterator == NULL)
6c1abb5c 423 show_expr (c->expr);
6de9cd9a
DN		 424 else
425 {
6c1abb5c
FXC		 426 fputc ('(', dumpfile);
427 show_expr (c->expr);
6de9cd9a 428
6c1abb5c
FXC		 429 fputc (' ', dumpfile);
430 show_expr (c->iterator->var);
431 fputc ('=', dumpfile);
432 show_expr (c->iterator->start);
433 fputc (',', dumpfile);
434 show_expr (c->iterator->end);
435 fputc (',', dumpfile);
436 show_expr (c->iterator->step);
6de9cd9a 437
6c1abb5c 438 fputc (')', dumpfile);
6de9cd9a
DN		 439 }
440
b7e75771 441 if (gfc_constructor_next (c) != NULL)
6c1abb5c 442 fputs (" , ", dumpfile);
6de9cd9a
DN		 443 }
444}
445
446
b35c5f01 447static void
f622221a 448show_char_const (const gfc_char_t *c, gfc_charlen_t length)
b35c5f01 449{
6c1abb5c 450 fputc ('\'', dumpfile);
f622221a 451 for (size_t i = 0; i < (size_t) length; i++)
b35c5f01
TS		 452 {
453 if (c[i] == '\'')
6c1abb5c 454 fputs ("''", dumpfile);
b35c5f01 455 else
00660189 456 fputs (gfc_print_wide_char (c[i]), dumpfile);
b35c5f01 457 }
6c1abb5c 458 fputc ('\'', dumpfile);
b35c5f01
TS		 459}
460
a64a8f2f
DK		 461
462/* Show a component-call expression. */
463
464static void
465show_compcall (gfc_expr* p)
466{
467 gcc_assert (p->expr_type == EXPR_COMPCALL);
468
469 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
470 show_ref (p->ref);
471 fprintf (dumpfile, "%s", p->value.compcall.name);
472
473 show_actual_arglist (p->value.compcall.actual);
474}
475
476
6de9cd9a
DN		 477/* Show an expression. */
478
6c1abb5c
FXC		 479static void
480show_expr (gfc_expr *p)
6de9cd9a
DN		 481{
482 const char *c;
483 int i;
484
485 if (p == NULL)
486 {
6c1abb5c 487 fputs ("()", dumpfile);
6de9cd9a
DN		 488 return;
489 }
490
491 switch (p->expr_type)
492 {
493 case EXPR_SUBSTRING:
b35c5f01 494 show_char_const (p->value.character.string, p->value.character.length);
6c1abb5c 495 show_ref (p->ref);
6de9cd9a
DN		 496 break;
497
498 case EXPR_STRUCTURE:
bc21d315 499 fprintf (dumpfile, "%s(", p->ts.u.derived->name);
6c1abb5c
FXC		 500 show_constructor (p->value.constructor);
501 fputc (')', dumpfile);
6de9cd9a
DN		 502 break;
503
504 case EXPR_ARRAY:
6c1abb5c
FXC		 505 fputs ("(/ ", dumpfile);
506 show_constructor (p->value.constructor);
507 fputs (" /)", dumpfile);
6de9cd9a 508
6c1abb5c 509 show_ref (p->ref);
6de9cd9a
DN		 510 break;
511
512 case EXPR_NULL:
6c1abb5c 513 fputs ("NULL()", dumpfile);
6de9cd9a
DN		 514 break;
515
516 case EXPR_CONSTANT:
517 switch (p->ts.type)
518 {
519 case BT_INTEGER:
a79b9474 520 mpz_out_str (dumpfile, 10, p->value.integer);
6de9cd9a 521
9d64df18 522 if (p->ts.kind != gfc_default_integer_kind)
6c1abb5c 523 fprintf (dumpfile, "_%d", p->ts.kind);
6de9cd9a
DN		 524 break;
525
526 case BT_LOGICAL:
527 if (p->value.logical)
6c1abb5c 528 fputs (".true.", dumpfile);
6de9cd9a 529 else
6c1abb5c 530 fputs (".false.", dumpfile);
6de9cd9a
DN		 531 break;
532
533 case BT_REAL:
a79b9474 534 mpfr_out_str (dumpfile, 10, 0, p->value.real, GFC_RND_MODE);
9d64df18 535 if (p->ts.kind != gfc_default_real_kind)
6c1abb5c 536 fprintf (dumpfile, "_%d", p->ts.kind);
6de9cd9a
DN		 537 break;
538
539 case BT_CHARACTER:
dfd6231e 540 show_char_const (p->value.character.string,
b35c5f01 541 p->value.character.length);
6de9cd9a
DN		 542 break;
543
544 case BT_COMPLEX:
6c1abb5c 545 fputs ("(complex ", dumpfile);
6de9cd9a 546
a79b9474 547 mpfr_out_str (dumpfile, 10, 0, mpc_realref (p->value.complex),
eb6f9a86 548 GFC_RND_MODE);
9d64df18 549 if (p->ts.kind != gfc_default_complex_kind)
6c1abb5c 550 fprintf (dumpfile, "_%d", p->ts.kind);
6de9cd9a 551
6c1abb5c 552 fputc (' ', dumpfile);
6de9cd9a 553
8442a5fb 554 mpfr_out_str (dumpfile, 10, 0, mpc_imagref (p->value.complex),
eb6f9a86 555 GFC_RND_MODE);
9d64df18 556 if (p->ts.kind != gfc_default_complex_kind)
6c1abb5c 557 fprintf (dumpfile, "_%d", p->ts.kind);
6de9cd9a 558
6c1abb5c 559 fputc (')', dumpfile);
6de9cd9a
DN		 560 break;
561
20585ad6 562 case BT_HOLLERITH:
f622221a
JB		 563 fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
564 p->representation.length);
20585ad6
BM		 565 c = p->representation.string;
566 for (i = 0; i < p->representation.length; i++, c++)
567 {
6c1abb5c 568 fputc (*c, dumpfile);
20585ad6
BM		 569 }
570 break;
571
6de9cd9a 572 default:
6c1abb5c 573 fputs ("???", dumpfile);
6de9cd9a
DN		 574 break;
575 }
576
20585ad6
BM		 577 if (p->representation.string)
578 {
6c1abb5c 579 fputs (" {", dumpfile);
20585ad6
BM		 580 c = p->representation.string;
581 for (i = 0; i < p->representation.length; i++, c++)
582 {
6c1abb5c 583 fprintf (dumpfile, "%.2x", (unsigned int) *c);
20585ad6 584 if (i < p->representation.length - 1)
6c1abb5c 585 fputc (',', dumpfile);
20585ad6 586 }
6c1abb5c 587 fputc ('}', dumpfile);
20585ad6
BM		 588 }
589
6de9cd9a
DN		 590 break;
591
592 case EXPR_VARIABLE:
9439ae41 593 if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
6c1abb5c
FXC		 594 fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
595 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
596 show_ref (p->ref);
6de9cd9a
DN		 597 break;
598
599 case EXPR_OP:
6c1abb5c 600 fputc ('(', dumpfile);
a1ee985f 601 switch (p->value.op.op)
6de9cd9a
DN		 602 {
603 case INTRINSIC_UPLUS:
6c1abb5c 604 fputs ("U+ ", dumpfile);
6de9cd9a
DN		 605 break;
606 case INTRINSIC_UMINUS:
6c1abb5c 607 fputs ("U- ", dumpfile);
6de9cd9a
DN		 608 break;
609 case INTRINSIC_PLUS:
6c1abb5c 610 fputs ("+ ", dumpfile);
6de9cd9a
DN		 611 break;
612 case INTRINSIC_MINUS:
6c1abb5c 613 fputs ("- ", dumpfile);
6de9cd9a
DN		 614 break;
615 case INTRINSIC_TIMES:
6c1abb5c 616 fputs ("* ", dumpfile);
6de9cd9a
DN		 617 break;
618 case INTRINSIC_DIVIDE:
6c1abb5c 619 fputs ("/ ", dumpfile);
6de9cd9a
DN		 620 break;
621 case INTRINSIC_POWER:
6c1abb5c 622 fputs ("** ", dumpfile);
6de9cd9a
DN		 623 break;
624 case INTRINSIC_CONCAT:
6c1abb5c 625 fputs ("// ", dumpfile);
6de9cd9a
DN		 626 break;
627 case INTRINSIC_AND:
6c1abb5c 628 fputs ("AND ", dumpfile);
6de9cd9a
DN		 629 break;
630 case INTRINSIC_OR:
6c1abb5c 631 fputs ("OR ", dumpfile);
6de9cd9a
DN		 632 break;
633 case INTRINSIC_EQV:
6c1abb5c 634 fputs ("EQV ", dumpfile);
6de9cd9a
DN		 635 break;
636 case INTRINSIC_NEQV:
6c1abb5c 637 fputs ("NEQV ", dumpfile);
6de9cd9a
DN		 638 break;
639 case INTRINSIC_EQ:
3bed9dd0 640 case INTRINSIC_EQ_OS:
6c1abb5c 641 fputs ("= ", dumpfile);
6de9cd9a
DN		 642 break;
643 case INTRINSIC_NE:
3bed9dd0 644 case INTRINSIC_NE_OS:
6c1abb5c 645 fputs ("/= ", dumpfile);
6de9cd9a
DN		 646 break;
647 case INTRINSIC_GT:
3bed9dd0 648 case INTRINSIC_GT_OS:
6c1abb5c 649 fputs ("> ", dumpfile);
6de9cd9a
DN		 650 break;
651 case INTRINSIC_GE:
3bed9dd0 652 case INTRINSIC_GE_OS:
6c1abb5c 653 fputs (">= ", dumpfile);
6de9cd9a
DN		 654 break;
655 case INTRINSIC_LT:
3bed9dd0 656 case INTRINSIC_LT_OS:
6c1abb5c 657 fputs ("< ", dumpfile);
6de9cd9a
DN		 658 break;
659 case INTRINSIC_LE:
3bed9dd0 660 case INTRINSIC_LE_OS:
6c1abb5c 661 fputs ("<= ", dumpfile);
6de9cd9a
DN		 662 break;
663 case INTRINSIC_NOT:
6c1abb5c 664 fputs ("NOT ", dumpfile);
6de9cd9a 665 break;
2414e1d6 666 case INTRINSIC_PARENTHESES:
f4679a55 667 fputs ("parens ", dumpfile);
2414e1d6 668 break;
6de9cd9a
DN		 669
670 default:
671 gfc_internal_error
546c8974 672 ("show_expr(): Bad intrinsic in expression");
6de9cd9a
DN		 673 }
674
6c1abb5c 675 show_expr (p->value.op.op1);
6de9cd9a 676
58b03ab2 677 if (p->value.op.op2)
6de9cd9a 678 {
6c1abb5c
FXC		 679 fputc (' ', dumpfile);
680 show_expr (p->value.op.op2);
6de9cd9a
DN		 681 }
682
6c1abb5c 683 fputc (')', dumpfile);
6de9cd9a
DN		 684 break;
685
686 case EXPR_FUNCTION:
687 if (p->value.function.name == NULL)
688 {
713485cc 689 fprintf (dumpfile, "%s", p->symtree->n.sym->name);
2a573572 690 if (gfc_is_proc_ptr_comp (p))
713485cc
JW		 691 show_ref (p->ref);
692 fputc ('[', dumpfile);
6c1abb5c
FXC		 693 show_actual_arglist (p->value.function.actual);
694 fputc (']', dumpfile);
6de9cd9a
DN		 695 }
696 else
697 {
713485cc 698 fprintf (dumpfile, "%s", p->value.function.name);
2a573572 699 if (gfc_is_proc_ptr_comp (p))
713485cc
JW		 700 show_ref (p->ref);
701 fputc ('[', dumpfile);
702 fputc ('[', dumpfile);
6c1abb5c
FXC		 703 show_actual_arglist (p->value.function.actual);
704 fputc (']', dumpfile);
705 fputc (']', dumpfile);
6de9cd9a
DN		 706 }
707
708 break;
709
a64a8f2f
DK		 710 case EXPR_COMPCALL:
711 show_compcall (p);
712 break;
713
6de9cd9a 714 default:
6c1abb5c 715 gfc_internal_error ("show_expr(): Don't know how to show expr");
6de9cd9a
DN		 716 }
717}
718
6de9cd9a
DN		 719/* Show symbol attributes. The flavor and intent are followed by
720 whatever single bit attributes are present. */
721
6c1abb5c 722static void
8cf8ca52 723show_attr (symbol_attribute *attr, const char * module)
6de9cd9a 724{
8cf8ca52 725 if (attr->flavor != FL_UNKNOWN)
5bab4c96
PT		 726 {
727 if (attr->flavor == FL_DERIVED && attr->pdt_template)
728 fputs (" (PDT template", dumpfile);
729 else
8cf8ca52 730 fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
5bab4c96 731 }
8cf8ca52
TK		 732 if (attr->access != ACCESS_UNKNOWN)
733 fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
734 if (attr->proc != PROC_UNKNOWN)
735 fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
736 if (attr->save != SAVE_NONE)
737 fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
6de9cd9a 738
8e54f139
TB		 739 if (attr->artificial)
740 fputs (" ARTIFICIAL", dumpfile);
6de9cd9a 741 if (attr->allocatable)
6c1abb5c 742 fputs (" ALLOCATABLE", dumpfile);
1eee5628
TB		 743 if (attr->asynchronous)
744 fputs (" ASYNCHRONOUS", dumpfile);
be59db2d
TB		 745 if (attr->codimension)
746 fputs (" CODIMENSION", dumpfile);
6de9cd9a 747 if (attr->dimension)
6c1abb5c 748 fputs (" DIMENSION", dumpfile);
fe4e525c
TB		 749 if (attr->contiguous)
750 fputs (" CONTIGUOUS", dumpfile);
6de9cd9a 751 if (attr->external)
6c1abb5c 752 fputs (" EXTERNAL", dumpfile);
6de9cd9a 753 if (attr->intrinsic)
6c1abb5c 754 fputs (" INTRINSIC", dumpfile);
6de9cd9a 755 if (attr->optional)
6c1abb5c 756 fputs (" OPTIONAL", dumpfile);
5bab4c96
PT		 757 if (attr->pdt_kind)
758 fputs (" KIND", dumpfile);
759 if (attr->pdt_len)
760 fputs (" LEN", dumpfile);
6de9cd9a 761 if (attr->pointer)
6c1abb5c 762 fputs (" POINTER", dumpfile);
9aa433c2 763 if (attr->is_protected)
6c1abb5c 764 fputs (" PROTECTED", dumpfile);
06469efd 765 if (attr->value)
6c1abb5c 766 fputs (" VALUE", dumpfile);
775e6c3a 767 if (attr->volatile_)
6c1abb5c 768 fputs (" VOLATILE", dumpfile);
6c7a4dfd 769 if (attr->threadprivate)
6c1abb5c 770 fputs (" THREADPRIVATE", dumpfile);
6de9cd9a 771 if (attr->target)
6c1abb5c 772 fputs (" TARGET", dumpfile);
6de9cd9a 773 if (attr->dummy)
8cf8ca52
TK		 774 {
775 fputs (" DUMMY", dumpfile);
776 if (attr->intent != INTENT_UNKNOWN)
777 fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
778 }
779
6de9cd9a 780 if (attr->result)
6c1abb5c 781 fputs (" RESULT", dumpfile);
6de9cd9a 782 if (attr->entry)
6c1abb5c 783 fputs (" ENTRY", dumpfile);
e6ef7325 784 if (attr->is_bind_c)
6c1abb5c 785 fputs (" BIND(C)", dumpfile);
6de9cd9a
DN		 786
787 if (attr->data)
6c1abb5c 788 fputs (" DATA", dumpfile);
6de9cd9a 789 if (attr->use_assoc)
8cf8ca52
TK		 790 {
791 fputs (" USE-ASSOC", dumpfile);
792 if (module != NULL)
793 fprintf (dumpfile, "(%s)", module);
794 }
795
6de9cd9a 796 if (attr->in_namelist)
6c1abb5c 797 fputs (" IN-NAMELIST", dumpfile);
6de9cd9a 798 if (attr->in_common)
6c1abb5c 799 fputs (" IN-COMMON", dumpfile);
6de9cd9a 800
9e1d712c 801 if (attr->abstract)
52f49934 802 fputs (" ABSTRACT", dumpfile);
6de9cd9a 803 if (attr->function)
6c1abb5c 804 fputs (" FUNCTION", dumpfile);
6de9cd9a 805 if (attr->subroutine)
6c1abb5c 806 fputs (" SUBROUTINE", dumpfile);
6de9cd9a 807 if (attr->implicit_type)
6c1abb5c 808 fputs (" IMPLICIT-TYPE", dumpfile);
6de9cd9a
DN		 809
810 if (attr->sequence)
6c1abb5c 811 fputs (" SEQUENCE", dumpfile);
6de9cd9a 812 if (attr->elemental)
6c1abb5c 813 fputs (" ELEMENTAL", dumpfile);
6de9cd9a 814 if (attr->pure)
6c1abb5c 815 fputs (" PURE", dumpfile);
6457b1f0
JW		 816 if (attr->implicit_pure)
817 fputs (" IMPLICIT_PURE", dumpfile);
6de9cd9a 818 if (attr->recursive)
6c1abb5c 819 fputs (" RECURSIVE", dumpfile);
6de9cd9a 820
6c1abb5c 821 fputc (')', dumpfile);
6de9cd9a
DN		 822}
823
824
825/* Show components of a derived type. */
826
6c1abb5c
FXC		 827static void
828show_components (gfc_symbol *sym)
6de9cd9a
DN		 829{
830 gfc_component *c;
831
832 for (c = sym->components; c; c = c->next)
833 {
5bab4c96 834 show_indent ();
6c1abb5c
FXC		 835 fprintf (dumpfile, "(%s ", c->name);
836 show_typespec (&c->ts);
5bab4c96
PT		 837 if (c->kind_expr)
838 {
839 fputs (" kind_expr: ", dumpfile);
840 show_expr (c->kind_expr);
841 }
842 if (c->param_list)
843 {
844 fputs ("PDT parameters", dumpfile);
845 show_actual_arglist (c->param_list);
846 }
847
d6c63324
TK		 848 if (c->attr.allocatable)
849 fputs (" ALLOCATABLE", dumpfile);
5bab4c96
PT		 850 if (c->attr.pdt_kind)
851 fputs (" KIND", dumpfile);
852 if (c->attr.pdt_len)
853 fputs (" LEN", dumpfile);
d4b7d0f0 854 if (c->attr.pointer)
6c1abb5c 855 fputs (" POINTER", dumpfile);
713485cc
JW		 856 if (c->attr.proc_pointer)
857 fputs (" PPC", dumpfile);
d4b7d0f0 858 if (c->attr.dimension)
6c1abb5c
FXC		 859 fputs (" DIMENSION", dumpfile);
860 fputc (' ', dumpfile);
861 show_array_spec (c->as);
d4b7d0f0
JW		 862 if (c->attr.access)
863 fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
6c1abb5c 864 fputc (')', dumpfile);
6de9cd9a 865 if (c->next != NULL)
6c1abb5c 866 fputc (' ', dumpfile);
6de9cd9a
DN		 867 }
868}
869
870
a64a8f2f
DK		 871/* Show the f2k_derived namespace with procedure bindings. */
872
873static void
26ef2b42 874show_typebound_proc (gfc_typebound_proc* tb, const char* name)
a64a8f2f 875{
a64a8f2f
DK		 876 show_indent ();
877
26ef2b42 878 if (tb->is_generic)
a64a8f2f
DK		 879 fputs ("GENERIC", dumpfile);
880 else
881 {
882 fputs ("PROCEDURE, ", dumpfile);
26ef2b42 883 if (tb->nopass)
a64a8f2f
DK		 884 fputs ("NOPASS", dumpfile);
885 else
886 {
26ef2b42
DK		 887 if (tb->pass_arg)
888 fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
a64a8f2f
DK		 889 else
890 fputs ("PASS", dumpfile);
891 }
26ef2b42 892 if (tb->non_overridable)
a64a8f2f
DK		 893 fputs (", NON_OVERRIDABLE", dumpfile);
894 }
895
26ef2b42 896 if (tb->access == ACCESS_PUBLIC)
a64a8f2f
DK		 897 fputs (", PUBLIC", dumpfile);
898 else
899 fputs (", PRIVATE", dumpfile);
900
26ef2b42 901 fprintf (dumpfile, " :: %s => ", name);
a64a8f2f 902
26ef2b42 903 if (tb->is_generic)
a64a8f2f
DK		 904 {
905 gfc_tbp_generic* g;
26ef2b42 906 for (g = tb->u.generic; g; g = g->next)
a64a8f2f
DK		 907 {
908 fputs (g->specific_st->name, dumpfile);
909 if (g->next)
910 fputs (", ", dumpfile);
911 }
912 }
913 else
26ef2b42
DK		 914 fputs (tb->u.specific->n.sym->name, dumpfile);
915}
916
917static void
918show_typebound_symtree (gfc_symtree* st)
919{
920 gcc_assert (st->n.tb);
921 show_typebound_proc (st->n.tb, st->name);
a64a8f2f
DK		 922}
923
924static void
925show_f2k_derived (gfc_namespace* f2k)
926{
927 gfc_finalizer* f;
26ef2b42 928 int op;
a64a8f2f 929
26ef2b42
DK		 930 show_indent ();
931 fputs ("Procedure bindings:", dumpfile);
a64a8f2f
DK		 932 ++show_level;
933
934 /* Finalizer bindings. */
935 for (f = f2k->finalizers; f; f = f->next)
936 {
937 show_indent ();
8e54f139 938 fprintf (dumpfile, "FINAL %s", f->proc_tree->n.sym->name);
a64a8f2f
DK		 939 }
940
941 /* Type-bound procedures. */
26ef2b42
DK		 942 gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
943
944 --show_level;
945
946 show_indent ();
947 fputs ("Operator bindings:", dumpfile);
948 ++show_level;
949
950 /* User-defined operators. */
951 gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
952
953 /* Intrinsic operators. */
954 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
955 if (f2k->tb_op[op])
956 show_typebound_proc (f2k->tb_op[op],
957 gfc_op2string ((gfc_intrinsic_op) op));
a64a8f2f
DK		 958
959 --show_level;
960}
961
962
6de9cd9a
DN		 963/* Show a symbol. If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
964 show the interface. Information needed to reconstruct the list of
965 specific interfaces associated with a generic symbol is done within
966 that symbol. */
967
6c1abb5c
FXC		 968static void
969show_symbol (gfc_symbol *sym)
6de9cd9a
DN		 970{
971 gfc_formal_arglist *formal;
972 gfc_interface *intr;
8cf8ca52 973 int i,len;
6de9cd9a
DN		 974
975 if (sym == NULL)
976 return;
977
8cf8ca52
TK		 978 fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
979 len = strlen (sym->name);
980 for (i=len; i<12; i++)
981 fputc(' ', dumpfile);
6de9cd9a 982
cedc228d
TK		 983 if (sym->binding_label)
984 fprintf (dumpfile,"|| binding_label: '%s' ", sym->binding_label);
985
8cf8ca52 986 ++show_level;
7ed979b9 987
8cf8ca52
TK		 988 show_indent ();
989 fputs ("type spec : ", dumpfile);
990 show_typespec (&sym->ts);
7ed979b9 991
8cf8ca52
TK		 992 show_indent ();
993 fputs ("attributes: ", dumpfile);
994 show_attr (&sym->attr, sym->module);
6de9cd9a
DN		 995
996 if (sym->value)
997 {
998 show_indent ();
6c1abb5c
FXC		 999 fputs ("value: ", dumpfile);
1000 show_expr (sym->value);
6de9cd9a
DN		 1001 }
1002
1003 if (sym->as)
1004 {
1005 show_indent ();
6c1abb5c
FXC		 1006 fputs ("Array spec:", dumpfile);
1007 show_array_spec (sym->as);
6de9cd9a
DN		 1008 }
1009
1010 if (sym->generic)
1011 {
1012 show_indent ();
6c1abb5c 1013 fputs ("Generic interfaces:", dumpfile);
6de9cd9a 1014 for (intr = sym->generic; intr; intr = intr->next)
6c1abb5c 1015 fprintf (dumpfile, " %s", intr->sym->name);
6de9cd9a
DN		 1016 }
1017
6de9cd9a
DN		 1018 if (sym->result)
1019 {
1020 show_indent ();
6c1abb5c 1021 fprintf (dumpfile, "result: %s", sym->result->name);
6de9cd9a
DN		 1022 }
1023
1024 if (sym->components)
1025 {
1026 show_indent ();
6c1abb5c
FXC		 1027 fputs ("components: ", dumpfile);
1028 show_components (sym);
6de9cd9a
DN		 1029 }
1030
a64a8f2f 1031 if (sym->f2k_derived)
cf2b3c22
TB		 1032 {
1033 show_indent ();
7c1dab0d
JW		 1034 if (sym->hash_value)
1035 fprintf (dumpfile, "hash: %d", sym->hash_value);
cf2b3c22
TB		 1036 show_f2k_derived (sym->f2k_derived);
1037 }
a64a8f2f 1038
6de9cd9a
DN		 1039 if (sym->formal)
1040 {
1041 show_indent ();
6c1abb5c 1042 fputs ("Formal arglist:", dumpfile);
6de9cd9a
DN		 1043
1044 for (formal = sym->formal; formal; formal = formal->next)
636dff67
SK		 1045 {
1046 if (formal->sym != NULL)
6c1abb5c 1047 fprintf (dumpfile, " %s", formal->sym->name);
636dff67 1048 else
6c1abb5c 1049 fputs (" [Alt Return]", dumpfile);
636dff67 1050 }
6de9cd9a
DN		 1051 }
1052
3609dfbf 1053 if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
142f5e4a
AS		 1054 && sym->attr.proc != PROC_ST_FUNCTION
1055 && !sym->attr.entry)
6de9cd9a
DN		 1056 {
1057 show_indent ();
6c1abb5c
FXC		 1058 fputs ("Formal namespace", dumpfile);
1059 show_namespace (sym->formal_ns);
6de9cd9a 1060 }
5bab4c96
PT		 1061
1062 if (sym->attr.flavor == FL_VARIABLE
1063 && sym->param_list)
1064 {
1065 show_indent ();
1066 fputs ("PDT parameters", dumpfile);
1067 show_actual_arglist (sym->param_list);
cebb1919 1068 }
5bab4c96 1069
cebb1919
TK		 1070 if (sym->attr.flavor == FL_NAMELIST)
1071 {
1072 gfc_namelist *nl;
1073 show_indent ();
1074 fputs ("variables : ", dumpfile);
1075 for (nl = sym->namelist; nl; nl = nl->next)
1076 fprintf (dumpfile, " %s",nl->sym->name);
5bab4c96 1077 }
cebb1919 1078
8cf8ca52 1079 --show_level;
0a164a3c
PT		 1080}
1081
1082
6de9cd9a
DN		 1083/* Show a user-defined operator. Just prints an operator
1084 and the name of the associated subroutine, really. */
30c05595 1085
6de9cd9a 1086static void
636dff67 1087show_uop (gfc_user_op *uop)
6de9cd9a
DN		 1088{
1089 gfc_interface *intr;
1090
1091 show_indent ();
6c1abb5c 1092 fprintf (dumpfile, "%s:", uop->name);
6de9cd9a 1093
a1ee985f 1094 for (intr = uop->op; intr; intr = intr->next)
6c1abb5c 1095 fprintf (dumpfile, " %s", intr->sym->name);
6de9cd9a
DN		 1096}
1097
1098
1099/* Workhorse function for traversing the user operator symtree. */
1100
1101static void
636dff67 1102traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
6de9cd9a 1103{
6de9cd9a
DN		 1104 if (st == NULL)
1105 return;
1106
1107 (*func) (st->n.uop);
1108
1109 traverse_uop (st->left, func);
1110 traverse_uop (st->right, func);
1111}
1112
1113
1114/* Traverse the tree of user operator nodes. */
1115
1116void
636dff67 1117gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
6de9cd9a 1118{
6de9cd9a
DN		 1119 traverse_uop (ns->uop_root, func);
1120}
1121
1122
fbc9b453
TS		 1123/* Function to display a common block. */
1124
1125static void
636dff67 1126show_common (gfc_symtree *st)
fbc9b453
TS		 1127{
1128 gfc_symbol *s;
1129
1130 show_indent ();
6c1abb5c 1131 fprintf (dumpfile, "common: /%s/ ", st->name);
fbc9b453
TS		 1132
1133 s = st->n.common->head;
1134 while (s)
1135 {
6c1abb5c 1136 fprintf (dumpfile, "%s", s->name);
fbc9b453
TS		 1137 s = s->common_next;
1138 if (s)
6c1abb5c 1139 fputs (", ", dumpfile);
fbc9b453 1140 }
6c1abb5c 1141 fputc ('\n', dumpfile);
dfd6231e 1142}
fbc9b453 1143
30c05595 1144
6de9cd9a
DN		 1145/* Worker function to display the symbol tree. */
1146
1147static void
636dff67 1148show_symtree (gfc_symtree *st)
6de9cd9a 1149{
8cf8ca52
TK		 1150 int len, i;
1151
6de9cd9a 1152 show_indent ();
8cf8ca52
TK		 1153
1154 len = strlen(st->name);
1155 fprintf (dumpfile, "symtree: '%s'", st->name);
1156
1157 for (i=len; i<12; i++)
1158 fputc(' ', dumpfile);
1159
1160 if (st->ambiguous)
1161 fputs( " Ambiguous", dumpfile);
6de9cd9a
DN		 1162
1163 if (st->n.sym->ns != gfc_current_ns)
8cf8ca52
TK		 1164 fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
1165 st->n.sym->ns->proc_name->name);
6de9cd9a 1166 else
6c1abb5c 1167 show_symbol (st->n.sym);
6de9cd9a
DN		 1168}
1169
1170
1171/******************* Show gfc_code structures **************/
1172
1173
6de9cd9a 1174/* Show a list of code structures. Mutually recursive with
6c1abb5c 1175 show_code_node(). */
6de9cd9a 1176
6c1abb5c
FXC		 1177static void
1178show_code (int level, gfc_code *c)
6de9cd9a 1179{
6de9cd9a 1180 for (; c; c = c->next)
6c1abb5c 1181 show_code_node (level, c);
6de9cd9a
DN		 1182}
1183
6c1abb5c 1184static void
f014c653 1185show_omp_namelist (int list_type, gfc_omp_namelist *n)
6c7a4dfd 1186{
dd2fc525
JJ		 1187 for (; n; n = n->next)
1188 {
f014c653
JJ		 1189 if (list_type == OMP_LIST_REDUCTION)
1190 switch (n->u.reduction_op)
1191 {
1192 case OMP_REDUCTION_PLUS:
1193 case OMP_REDUCTION_TIMES:
1194 case OMP_REDUCTION_MINUS:
1195 case OMP_REDUCTION_AND:
1196 case OMP_REDUCTION_OR:
1197 case OMP_REDUCTION_EQV:
1198 case OMP_REDUCTION_NEQV:
1199 fprintf (dumpfile, "%s:",
1200 gfc_op2string ((gfc_intrinsic_op) n->u.reduction_op));
1201 break;
1202 case OMP_REDUCTION_MAX: fputs ("max:", dumpfile); break;
1203 case OMP_REDUCTION_MIN: fputs ("min:", dumpfile); break;
1204 case OMP_REDUCTION_IAND: fputs ("iand:", dumpfile); break;
1205 case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break;
1206 case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
1207 case OMP_REDUCTION_USER:
1208 if (n->udr)
b46ebd6c 1209 fprintf (dumpfile, "%s:", n->udr->udr->name);
f014c653
JJ		 1210 break;
1211 default: break;
1212 }
1213 else if (list_type == OMP_LIST_DEPEND)
1214 switch (n->u.depend_op)
1215 {
1216 case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
1217 case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
1218 case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
b4c3a85b
JJ		 1219 case OMP_DEPEND_SINK_FIRST:
1220 fputs ("sink:", dumpfile);
1221 while (1)
1222 {
1223 fprintf (dumpfile, "%s", n->sym->name);
1224 if (n->expr)
1225 {
1226 fputc ('+', dumpfile);
1227 show_expr (n->expr);
1228 }
1229 if (n->next == NULL)
1230 break;
1231 else if (n->next->u.depend_op != OMP_DEPEND_SINK)
1232 {
1233 fputs (") DEPEND(", dumpfile);
1234 break;
1235 }
1236 fputc (',', dumpfile);
1237 n = n->next;
1238 }
1239 continue;
f014c653
JJ		 1240 default: break;
1241 }
1242 else if (list_type == OMP_LIST_MAP)
1243 switch (n->u.map_op)
1244 {
1245 case OMP_MAP_ALLOC: fputs ("alloc:", dumpfile); break;
1246 case OMP_MAP_TO: fputs ("to:", dumpfile); break;
1247 case OMP_MAP_FROM: fputs ("from:", dumpfile); break;
1248 case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break;
1249 default: break;
1250 }
b4c3a85b
JJ		 1251 else if (list_type == OMP_LIST_LINEAR)
1252 switch (n->u.linear_op)
1253 {
1254 case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break;
1255 case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break;
1256 case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
1257 default: break;
1258 }
dd2fc525 1259 fprintf (dumpfile, "%s", n->sym->name);
b4c3a85b
JJ		 1260 if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
1261 fputc (')', dumpfile);
dd2fc525
JJ		 1262 if (n->expr)
1263 {
1264 fputc (':', dumpfile);
1265 show_expr (n->expr);
1266 }
1267 if (n->next)
1268 fputc (',', dumpfile);
1269 }
6c7a4dfd
JJ		 1270}
1271
41dbbb37
TS		 1272
1273/* Show OpenMP or OpenACC clauses. */
1274
1275static void
1276show_omp_clauses (gfc_omp_clauses *omp_clauses)
1277{
b4c3a85b 1278 int list_type, i;
41dbbb37
TS		 1279
1280 switch (omp_clauses->cancel)
1281 {
1282 case OMP_CANCEL_UNKNOWN:
1283 break;
1284 case OMP_CANCEL_PARALLEL:
1285 fputs (" PARALLEL", dumpfile);
1286 break;
1287 case OMP_CANCEL_SECTIONS:
1288 fputs (" SECTIONS", dumpfile);
1289 break;
1290 case OMP_CANCEL_DO:
1291 fputs (" DO", dumpfile);
1292 break;
1293 case OMP_CANCEL_TASKGROUP:
1294 fputs (" TASKGROUP", dumpfile);
1295 break;
1296 }
1297 if (omp_clauses->if_expr)
1298 {
1299 fputs (" IF(", dumpfile);
1300 show_expr (omp_clauses->if_expr);
1301 fputc (')', dumpfile);
1302 }
1303 if (omp_clauses->final_expr)
1304 {
1305 fputs (" FINAL(", dumpfile);
1306 show_expr (omp_clauses->final_expr);
1307 fputc (')', dumpfile);
1308 }
1309 if (omp_clauses->num_threads)
1310 {
1311 fputs (" NUM_THREADS(", dumpfile);
1312 show_expr (omp_clauses->num_threads);
1313 fputc (')', dumpfile);
1314 }
1315 if (omp_clauses->async)
1316 {
1317 fputs (" ASYNC", dumpfile);
1318 if (omp_clauses->async_expr)
1319 {
1320 fputc ('(', dumpfile);
1321 show_expr (omp_clauses->async_expr);
1322 fputc (')', dumpfile);
1323 }
1324 }
1325 if (omp_clauses->num_gangs_expr)
1326 {
1327 fputs (" NUM_GANGS(", dumpfile);
1328 show_expr (omp_clauses->num_gangs_expr);
1329 fputc (')', dumpfile);
1330 }
1331 if (omp_clauses->num_workers_expr)
1332 {
1333 fputs (" NUM_WORKERS(", dumpfile);
1334 show_expr (omp_clauses->num_workers_expr);
1335 fputc (')', dumpfile);
1336 }
1337 if (omp_clauses->vector_length_expr)
1338 {
1339 fputs (" VECTOR_LENGTH(", dumpfile);
1340 show_expr (omp_clauses->vector_length_expr);
1341 fputc (')', dumpfile);
1342 }
1343 if (omp_clauses->gang)
1344 {
1345 fputs (" GANG", dumpfile);
2a70708e 1346 if (omp_clauses->gang_num_expr || omp_clauses->gang_static_expr)
41dbbb37
TS		 1347 {
1348 fputc ('(', dumpfile);
2a70708e
CP		 1349 if (omp_clauses->gang_num_expr)
1350 {
1351 fprintf (dumpfile, "num:");
1352 show_expr (omp_clauses->gang_num_expr);
1353 }
1354 if (omp_clauses->gang_num_expr && omp_clauses->gang_static)
1355 fputc (',', dumpfile);
1356 if (omp_clauses->gang_static)
1357 {
1358 fprintf (dumpfile, "static:");
1359 if (omp_clauses->gang_static_expr)
1360 show_expr (omp_clauses->gang_static_expr);
1361 else
1362 fputc ('*', dumpfile);
1363 }
41dbbb37
TS		 1364 fputc (')', dumpfile);
1365 }
1366 }
1367 if (omp_clauses->worker)
1368 {
1369 fputs (" WORKER", dumpfile);
1370 if (omp_clauses->worker_expr)
1371 {
1372 fputc ('(', dumpfile);
1373 show_expr (omp_clauses->worker_expr);
1374 fputc (')', dumpfile);
1375 }
1376 }
1377 if (omp_clauses->vector)
1378 {
1379 fputs (" VECTOR", dumpfile);
1380 if (omp_clauses->vector_expr)
1381 {
1382 fputc ('(', dumpfile);
1383 show_expr (omp_clauses->vector_expr);
1384 fputc (')', dumpfile);
1385 }
1386 }
1387 if (omp_clauses->sched_kind != OMP_SCHED_NONE)
1388 {
1389 const char *type;
1390 switch (omp_clauses->sched_kind)
1391 {
1392 case OMP_SCHED_STATIC: type = "STATIC"; break;
1393 case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
1394 case OMP_SCHED_GUIDED: type = "GUIDED"; break;
1395 case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
1396 case OMP_SCHED_AUTO: type = "AUTO"; break;
1397 default:
1398 gcc_unreachable ();
1399 }
b4c3a85b
JJ		 1400 fputs (" SCHEDULE (", dumpfile);
1401 if (omp_clauses->sched_simd)
1402 {
1403 if (omp_clauses->sched_monotonic
1404 || omp_clauses->sched_nonmonotonic)
1405 fputs ("SIMD, ", dumpfile);
1406 else
1407 fputs ("SIMD: ", dumpfile);
1408 }
1409 if (omp_clauses->sched_monotonic)
1410 fputs ("MONOTONIC: ", dumpfile);
1411 else if (omp_clauses->sched_nonmonotonic)
1412 fputs ("NONMONOTONIC: ", dumpfile);
1413 fputs (type, dumpfile);
41dbbb37
TS		 1414 if (omp_clauses->chunk_size)
1415 {
1416 fputc (',', dumpfile);
1417 show_expr (omp_clauses->chunk_size);
1418 }
1419 fputc (')', dumpfile);
1420 }
1421 if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
1422 {
1423 const char *type;
1424 switch (omp_clauses->default_sharing)
1425 {
1426 case OMP_DEFAULT_NONE: type = "NONE"; break;
1427 case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
1428 case OMP_DEFAULT_SHARED: type = "SHARED"; break;
1429 case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
7fd549d2 1430 case OMP_DEFAULT_PRESENT: type = "PRESENT"; break;
41dbbb37
TS		 1431 default:
1432 gcc_unreachable ();
1433 }
1434 fprintf (dumpfile, " DEFAULT(%s)", type);
1435 }
1436 if (omp_clauses->tile_list)
1437 {
1438 gfc_expr_list *list;
1439 fputs (" TILE(", dumpfile);
1440 for (list = omp_clauses->tile_list; list; list = list->next)
1441 {
1442 show_expr (list->expr);
dfd6231e 1443 if (list->next)
41dbbb37
TS		 1444 fputs (", ", dumpfile);
1445 }
1446 fputc (')', dumpfile);
1447 }
1448 if (omp_clauses->wait_list)
1449 {
1450 gfc_expr_list *list;
1451 fputs (" WAIT(", dumpfile);
1452 for (list = omp_clauses->wait_list; list; list = list->next)
1453 {
1454 show_expr (list->expr);
dfd6231e 1455 if (list->next)
41dbbb37
TS		 1456 fputs (", ", dumpfile);
1457 }
1458 fputc (')', dumpfile);
1459 }
1460 if (omp_clauses->seq)
1461 fputs (" SEQ", dumpfile);
1462 if (omp_clauses->independent)
1463 fputs (" INDEPENDENT", dumpfile);
1464 if (omp_clauses->ordered)
b4c3a85b
JJ		 1465 {
1466 if (omp_clauses->orderedc)
1467 fprintf (dumpfile, " ORDERED(%d)", omp_clauses->orderedc);
1468 else
1469 fputs (" ORDERED", dumpfile);
1470 }
41dbbb37
TS		 1471 if (omp_clauses->untied)
1472 fputs (" UNTIED", dumpfile);
1473 if (omp_clauses->mergeable)
1474 fputs (" MERGEABLE", dumpfile);
1475 if (omp_clauses->collapse)
1476 fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
1477 for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
1478 if (omp_clauses->lists[list_type] != NULL
1479 && list_type != OMP_LIST_COPYPRIVATE)
1480 {
1481 const char *type = NULL;
1482 switch (list_type)
1483 {
41dbbb37
TS		 1484 case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
1485 case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
1486 case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
aecbc4ff 1487 case OMP_LIST_COPYPRIVATE: type = "COPYPRIVATE"; break;
41dbbb37
TS		 1488 case OMP_LIST_SHARED: type = "SHARED"; break;
1489 case OMP_LIST_COPYIN: type = "COPYIN"; break;
1490 case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
1491 case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
1492 case OMP_LIST_LINEAR: type = "LINEAR"; break;
aecbc4ff
CP		 1493 case OMP_LIST_DEPEND: type = "DEPEND"; break;
1494 case OMP_LIST_MAP: type = "MAP"; break;
1495 case OMP_LIST_TO: type = "TO"; break;
1496 case OMP_LIST_FROM: type = "FROM"; break;
41dbbb37 1497 case OMP_LIST_REDUCTION: type = "REDUCTION"; break;
aecbc4ff
CP		 1498 case OMP_LIST_DEVICE_RESIDENT: type = "DEVICE_RESIDENT"; break;
1499 case OMP_LIST_LINK: type = "LINK"; break;
1500 case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
1501 case OMP_LIST_CACHE: type = "CACHE"; break;
b4c3a85b
JJ		 1502 case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break;
1503 case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
41dbbb37
TS		 1504 default:
1505 gcc_unreachable ();
1506 }
1507 fprintf (dumpfile, " %s(", type);
1508 show_omp_namelist (list_type, omp_clauses->lists[list_type]);
1509 fputc (')', dumpfile);
1510 }
1511 if (omp_clauses->safelen_expr)
1512 {
1513 fputs (" SAFELEN(", dumpfile);
1514 show_expr (omp_clauses->safelen_expr);
1515 fputc (')', dumpfile);
1516 }
1517 if (omp_clauses->simdlen_expr)
1518 {
1519 fputs (" SIMDLEN(", dumpfile);
1520 show_expr (omp_clauses->simdlen_expr);
1521 fputc (')', dumpfile);
1522 }
1523 if (omp_clauses->inbranch)
1524 fputs (" INBRANCH", dumpfile);
1525 if (omp_clauses->notinbranch)
1526 fputs (" NOTINBRANCH", dumpfile);
1527 if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
1528 {
1529 const char *type;
1530 switch (omp_clauses->proc_bind)
1531 {
1532 case OMP_PROC_BIND_MASTER: type = "MASTER"; break;
1533 case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break;
1534 case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break;
1535 default:
1536 gcc_unreachable ();
1537 }
1538 fprintf (dumpfile, " PROC_BIND(%s)", type);
1539 }
1540 if (omp_clauses->num_teams)
1541 {
1542 fputs (" NUM_TEAMS(", dumpfile);
1543 show_expr (omp_clauses->num_teams);
1544 fputc (')', dumpfile);
1545 }
1546 if (omp_clauses->device)
1547 {
1548 fputs (" DEVICE(", dumpfile);
1549 show_expr (omp_clauses->device);
1550 fputc (')', dumpfile);
1551 }
1552 if (omp_clauses->thread_limit)
1553 {
1554 fputs (" THREAD_LIMIT(", dumpfile);
1555 show_expr (omp_clauses->thread_limit);
1556 fputc (')', dumpfile);
1557 }
1558 if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE)
1559 {
b4c3a85b 1560 fprintf (dumpfile, " DIST_SCHEDULE (STATIC");
41dbbb37
TS		 1561 if (omp_clauses->dist_chunk_size)
1562 {
1563 fputc (',', dumpfile);
1564 show_expr (omp_clauses->dist_chunk_size);
1565 }
1566 fputc (')', dumpfile);
1567 }
b4c3a85b
JJ		 1568 if (omp_clauses->defaultmap)
1569 fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile);
1570 if (omp_clauses->nogroup)
1571 fputs (" NOGROUP", dumpfile);
1572 if (omp_clauses->simd)
1573 fputs (" SIMD", dumpfile);
1574 if (omp_clauses->threads)
1575 fputs (" THREADS", dumpfile);
1576 if (omp_clauses->grainsize)
1577 {
1578 fputs (" GRAINSIZE(", dumpfile);
1579 show_expr (omp_clauses->grainsize);
1580 fputc (')', dumpfile);
1581 }
1582 if (omp_clauses->hint)
1583 {
1584 fputs (" HINT(", dumpfile);
1585 show_expr (omp_clauses->hint);
1586 fputc (')', dumpfile);
1587 }
1588 if (omp_clauses->num_tasks)
1589 {
1590 fputs (" NUM_TASKS(", dumpfile);
1591 show_expr (omp_clauses->num_tasks);
1592 fputc (')', dumpfile);
1593 }
1594 if (omp_clauses->priority)
1595 {
1596 fputs (" PRIORITY(", dumpfile);
1597 show_expr (omp_clauses->priority);
1598 fputc (')', dumpfile);
1599 }
1600 for (i = 0; i < OMP_IF_LAST; i++)
1601 if (omp_clauses->if_exprs[i])
1602 {
1603 static const char *ifs[] = {
1604 "PARALLEL",
1605 "TASK",
1606 "TASKLOOP",
1607 "TARGET",
1608 "TARGET DATA",
1609 "TARGET UPDATE",
1610 "TARGET ENTER DATA",
1611 "TARGET EXIT DATA"
1612 };
1613 fputs (" IF(", dumpfile);
1614 fputs (ifs[i], dumpfile);
1615 fputs (": ", dumpfile);
1616 show_expr (omp_clauses->if_exprs[i]);
1617 fputc (')', dumpfile);
1618 }
1619 if (omp_clauses->depend_source)
1620 fputs (" DEPEND(source)", dumpfile);
41dbbb37
TS		 1621}
1622
1623/* Show a single OpenMP or OpenACC directive node and everything underneath it
6c7a4dfd
JJ		 1624 if necessary. */
1625
1626static void
6c1abb5c 1627show_omp_node (int level, gfc_code *c)
6c7a4dfd
JJ		 1628{
1629 gfc_omp_clauses *omp_clauses = NULL;
1630 const char *name = NULL;
41dbbb37 1631 bool is_oacc = false;
6c7a4dfd
JJ		 1632
1633 switch (c->op)
1634 {
b4c3a85b
JJ		 1635 case EXEC_OACC_PARALLEL_LOOP:
1636 name = "PARALLEL LOOP"; is_oacc = true; break;
41dbbb37
TS		 1637 case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break;
1638 case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break;
1639 case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break;
1640 case EXEC_OACC_DATA: name = "DATA"; is_oacc = true; break;
1641 case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; is_oacc = true; break;
1642 case EXEC_OACC_LOOP: name = "LOOP"; is_oacc = true; break;
1643 case EXEC_OACC_UPDATE: name = "UPDATE"; is_oacc = true; break;
1644 case EXEC_OACC_WAIT: name = "WAIT"; is_oacc = true; break;
1645 case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
1646 case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
1647 case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
6c7a4dfd
JJ		 1648 case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
1649 case EXEC_OMP_BARRIER: name = "BARRIER"; break;
dd2fc525
JJ		 1650 case EXEC_OMP_CANCEL: name = "CANCEL"; break;
1651 case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break;
6c7a4dfd 1652 case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
b4c3a85b
JJ		 1653 case EXEC_OMP_DISTRIBUTE: name = "DISTRIBUTE"; break;
1654 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
1655 name = "DISTRIBUTE PARALLEL DO"; break;
1656 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
1657 name = "DISTRIBUTE PARALLEL DO SIMD"; break;
1658 case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break;
6c7a4dfd 1659 case EXEC_OMP_DO: name = "DO"; break;
dd2fc525 1660 case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
b4c3a85b 1661 case EXEC_OMP_FLUSH: name = "FLUSH"; break;
6c7a4dfd
JJ		 1662 case EXEC_OMP_MASTER: name = "MASTER"; break;
1663 case EXEC_OMP_ORDERED: name = "ORDERED"; break;
1664 case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
1665 case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
dd2fc525 1666 case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
6c7a4dfd
JJ		 1667 case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
1668 case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
1669 case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
dd2fc525 1670 case EXEC_OMP_SIMD: name = "SIMD"; break;
6c7a4dfd 1671 case EXEC_OMP_SINGLE: name = "SINGLE"; break;
b4c3a85b
JJ		 1672 case EXEC_OMP_TARGET: name = "TARGET"; break;
1673 case EXEC_OMP_TARGET_DATA: name = "TARGET DATA"; break;
1674 case EXEC_OMP_TARGET_ENTER_DATA: name = "TARGET ENTER DATA"; break;
1675 case EXEC_OMP_TARGET_EXIT_DATA: name = "TARGET EXIT DATA"; break;
1676 case EXEC_OMP_TARGET_PARALLEL: name = "TARGET PARALLEL"; break;
1677 case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break;
1678 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
1679 name = "TARGET_PARALLEL_DO_SIMD"; break;
1680 case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break;
1681 case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break;
1682 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
1683 name = "TARGET TEAMS DISTRIBUTE"; break;
1684 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
1685 name = "TARGET TEAMS DISTRIBUTE PARALLEL DO"; break;
1686 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1687 name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
1688 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
1689 name = "TARGET TEAMS DISTRIBUTE SIMD"; break;
1690 case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break;
a68ab351 1691 case EXEC_OMP_TASK: name = "TASK"; break;
dd2fc525 1692 case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break;
b4c3a85b
JJ		 1693 case EXEC_OMP_TASKLOOP: name = "TASKLOOP"; break;
1694 case EXEC_OMP_TASKLOOP_SIMD: name = "TASKLOOP SIMD"; break;
a68ab351 1695 case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
20906c66 1696 case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
b4c3a85b
JJ		 1697 case EXEC_OMP_TEAMS: name = "TEAMS"; break;
1698 case EXEC_OMP_TEAMS_DISTRIBUTE: name = "TEAMS DISTRIBUTE"; break;
1699 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
1700 name = "TEAMS DISTRIBUTE PARALLEL DO"; break;
1701 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1702 name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
1703 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break;
6c7a4dfd
JJ		 1704 case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
1705 default:
1706 gcc_unreachable ();
1707 }
41dbbb37 1708 fprintf (dumpfile, "!$%s %s", is_oacc ? "ACC" : "OMP", name);
6c7a4dfd
JJ		 1709 switch (c->op)
1710 {
41dbbb37
TS		 1711 case EXEC_OACC_PARALLEL_LOOP:
1712 case EXEC_OACC_PARALLEL:
1713 case EXEC_OACC_KERNELS_LOOP:
1714 case EXEC_OACC_KERNELS:
1715 case EXEC_OACC_DATA:
1716 case EXEC_OACC_HOST_DATA:
1717 case EXEC_OACC_LOOP:
1718 case EXEC_OACC_UPDATE:
1719 case EXEC_OACC_WAIT:
1720 case EXEC_OACC_CACHE:
1721 case EXEC_OACC_ENTER_DATA:
1722 case EXEC_OACC_EXIT_DATA:
dd2fc525
JJ		 1723 case EXEC_OMP_CANCEL:
1724 case EXEC_OMP_CANCELLATION_POINT:
b4c3a85b
JJ		 1725 case EXEC_OMP_DISTRIBUTE:
1726 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
1727 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
1728 case EXEC_OMP_DISTRIBUTE_SIMD:
6c7a4dfd 1729 case EXEC_OMP_DO:
dd2fc525 1730 case EXEC_OMP_DO_SIMD:
b4c3a85b 1731 case EXEC_OMP_ORDERED:
6c7a4dfd
JJ		 1732 case EXEC_OMP_PARALLEL:
1733 case EXEC_OMP_PARALLEL_DO:
dd2fc525 1734 case EXEC_OMP_PARALLEL_DO_SIMD:
6c7a4dfd 1735 case EXEC_OMP_PARALLEL_SECTIONS:
b4c3a85b 1736 case EXEC_OMP_PARALLEL_WORKSHARE:
6c7a4dfd 1737 case EXEC_OMP_SECTIONS:
dd2fc525 1738 case EXEC_OMP_SIMD:
6c7a4dfd 1739 case EXEC_OMP_SINGLE:
b4c3a85b
JJ		 1740 case EXEC_OMP_TARGET:
1741 case EXEC_OMP_TARGET_DATA:
1742 case EXEC_OMP_TARGET_ENTER_DATA:
1743 case EXEC_OMP_TARGET_EXIT_DATA:
1744 case EXEC_OMP_TARGET_PARALLEL:
1745 case EXEC_OMP_TARGET_PARALLEL_DO:
1746 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
1747 case EXEC_OMP_TARGET_SIMD:
1748 case EXEC_OMP_TARGET_TEAMS:
1749 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
1750 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
1751 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1752 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
1753 case EXEC_OMP_TARGET_UPDATE:
a68ab351 1754 case EXEC_OMP_TASK:
b4c3a85b
JJ		 1755 case EXEC_OMP_TASKLOOP:
1756 case EXEC_OMP_TASKLOOP_SIMD:
1757 case EXEC_OMP_TEAMS:
1758 case EXEC_OMP_TEAMS_DISTRIBUTE:
1759 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
1760 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1761 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
1762 case EXEC_OMP_WORKSHARE:
6c7a4dfd
JJ		 1763 omp_clauses = c->ext.omp_clauses;
1764 break;
1765 case EXEC_OMP_CRITICAL:
b4c3a85b
JJ		 1766 omp_clauses = c->ext.omp_clauses;
1767 if (omp_clauses)
1768 fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
6c7a4dfd
JJ		 1769 break;
1770 case EXEC_OMP_FLUSH:
1771 if (c->ext.omp_namelist)
1772 {
6c1abb5c 1773 fputs (" (", dumpfile);
f014c653 1774 show_omp_namelist (OMP_LIST_NUM, c->ext.omp_namelist);
6c1abb5c 1775 fputc (')', dumpfile);
6c7a4dfd
JJ		 1776 }
1777 return;
1778 case EXEC_OMP_BARRIER:
a68ab351 1779 case EXEC_OMP_TASKWAIT:
20906c66 1780 case EXEC_OMP_TASKYIELD:
6c7a4dfd
JJ		 1781 return;
1782 default:
1783 break;
1784 }
1785 if (omp_clauses)
41dbbb37 1786 show_omp_clauses (omp_clauses);
6c1abb5c 1787 fputc ('\n', dumpfile);
41dbbb37 1788
b4c3a85b 1789 /* OpenMP and OpenACC executable directives don't have associated blocks. */
41dbbb37 1790 if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
b4c3a85b
JJ		 1791 || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
1792 || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
1793 || c->op == EXEC_OMP_TARGET_EXIT_DATA
1794 || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
41dbbb37 1795 return;
6c7a4dfd
JJ		 1796 if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
1797 {
1798 gfc_code *d = c->block;
1799 while (d != NULL)
1800 {
6c1abb5c 1801 show_code (level + 1, d->next);
6c7a4dfd
JJ		 1802 if (d->block == NULL)
1803 break;
1804 code_indent (level, 0);
6c1abb5c 1805 fputs ("!$OMP SECTION\n", dumpfile);
6c7a4dfd
JJ		 1806 d = d->block;
1807 }
1808 }
1809 else
6c1abb5c 1810 show_code (level + 1, c->block->next);
6c7a4dfd
JJ		 1811 if (c->op == EXEC_OMP_ATOMIC)
1812 return;
dd2fc525 1813 fputc ('\n', dumpfile);
6c7a4dfd 1814 code_indent (level, 0);
41dbbb37 1815 fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
6c7a4dfd
JJ		 1816 if (omp_clauses != NULL)
1817 {
1818 if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
1819 {
6c1abb5c 1820 fputs (" COPYPRIVATE(", dumpfile);
f014c653
JJ		 1821 show_omp_namelist (OMP_LIST_COPYPRIVATE,
1822 omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
6c1abb5c 1823 fputc (')', dumpfile);
6c7a4dfd
JJ		 1824 }
1825 else if (omp_clauses->nowait)
6c1abb5c 1826 fputs (" NOWAIT", dumpfile);
6c7a4dfd 1827 }
b4c3a85b
JJ		 1828 else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
1829 fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
6c7a4dfd 1830}
6de9cd9a 1831
636dff67 1832
6de9cd9a
DN		 1833/* Show a single code node and everything underneath it if necessary. */
1834
1835static void
6c1abb5c 1836show_code_node (int level, gfc_code *c)
6de9cd9a
DN		 1837{
1838 gfc_forall_iterator *fa;
1839 gfc_open *open;
1840 gfc_case *cp;
1841 gfc_alloc *a;
1842 gfc_code *d;
1843 gfc_close *close;
1844 gfc_filepos *fp;
1845 gfc_inquire *i;
1846 gfc_dt *dt;
c6c15a14 1847 gfc_namespace *ns;
6de9cd9a 1848
8cf8ca52
TK		 1849 if (c->here)
1850 {
1851 fputc ('\n', dumpfile);
1852 code_indent (level, c->here);
1853 }
1854 else
1855 show_indent ();
6de9cd9a
DN		 1856
1857 switch (c->op)
1858 {
5c71a5e0
TB		 1859 case EXEC_END_PROCEDURE:
1860 break;
1861
6de9cd9a 1862 case EXEC_NOP:
6c1abb5c 1863 fputs ("NOP", dumpfile);
6de9cd9a
DN		 1864 break;
1865
1866 case EXEC_CONTINUE:
6c1abb5c 1867 fputs ("CONTINUE", dumpfile);
6de9cd9a
DN		 1868 break;
1869
3d79abbd 1870 case EXEC_ENTRY:
6c1abb5c 1871 fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
3d79abbd
PB		 1872 break;
1873
6b591ec0 1874 case EXEC_INIT_ASSIGN:
6de9cd9a 1875 case EXEC_ASSIGN:
6c1abb5c 1876 fputs ("ASSIGN ", dumpfile);
a513927a 1877 show_expr (c->expr1);
6c1abb5c
FXC		 1878 fputc (' ', dumpfile);
1879 show_expr (c->expr2);
6de9cd9a 1880 break;
3d79abbd 1881
6de9cd9a 1882 case EXEC_LABEL_ASSIGN:
6c1abb5c 1883 fputs ("LABEL ASSIGN ", dumpfile);
a513927a 1884 show_expr (c->expr1);
79bd1948 1885 fprintf (dumpfile, " %d", c->label1->value);
6de9cd9a
DN		 1886 break;
1887
1888 case EXEC_POINTER_ASSIGN:
6c1abb5c 1889 fputs ("POINTER ASSIGN ", dumpfile);
a513927a 1890 show_expr (c->expr1);
6c1abb5c
FXC		 1891 fputc (' ', dumpfile);
1892 show_expr (c->expr2);
6de9cd9a
DN		 1893 break;
1894
1895 case EXEC_GOTO:
6c1abb5c 1896 fputs ("GOTO ", dumpfile);
79bd1948
SK		 1897 if (c->label1)
1898 fprintf (dumpfile, "%d", c->label1->value);
6de9cd9a 1899 else
636dff67 1900 {
a513927a 1901 show_expr (c->expr1);
636dff67
SK		 1902 d = c->block;
1903 if (d != NULL)
1904 {
6c1abb5c 1905 fputs (", (", dumpfile);
636dff67
SK		 1906 for (; d; d = d ->block)
1907 {
79bd1948 1908 code_indent (level, d->label1);
636dff67 1909 if (d->block != NULL)
6c1abb5c 1910 fputc (',', dumpfile);
636dff67 1911 else
6c1abb5c 1912 fputc (')', dumpfile);
636dff67
SK		 1913 }
1914 }
1915 }
6de9cd9a
DN		 1916 break;
1917
1918 case EXEC_CALL:
aa84a9a5 1919 case EXEC_ASSIGN_CALL:
bfaacea7 1920 if (c->resolved_sym)
6c1abb5c 1921 fprintf (dumpfile, "CALL %s ", c->resolved_sym->name);
bfaacea7 1922 else if (c->symtree)
6c1abb5c 1923 fprintf (dumpfile, "CALL %s ", c->symtree->name);
bfaacea7 1924 else
6c1abb5c 1925 fputs ("CALL ?? ", dumpfile);
bfaacea7 1926
6c1abb5c 1927 show_actual_arglist (c->ext.actual);
6de9cd9a
DN		 1928 break;
1929
a64a8f2f
DK		 1930 case EXEC_COMPCALL:
1931 fputs ("CALL ", dumpfile);
a513927a 1932 show_compcall (c->expr1);
a64a8f2f
DK		 1933 break;
1934
713485cc
JW		 1935 case EXEC_CALL_PPC:
1936 fputs ("CALL ", dumpfile);
a513927a 1937 show_expr (c->expr1);
713485cc
JW		 1938 show_actual_arglist (c->ext.actual);
1939 break;
1940
6de9cd9a 1941 case EXEC_RETURN:
6c1abb5c 1942 fputs ("RETURN ", dumpfile);
a513927a
SK		 1943 if (c->expr1)
1944 show_expr (c->expr1);
6de9cd9a
DN		 1945 break;
1946
1947 case EXEC_PAUSE:
6c1abb5c 1948 fputs ("PAUSE ", dumpfile);
6de9cd9a 1949
a513927a
SK		 1950 if (c->expr1 != NULL)
1951 show_expr (c->expr1);
6de9cd9a 1952 else
6c1abb5c 1953 fprintf (dumpfile, "%d", c->ext.stop_code);
6de9cd9a
DN		 1954
1955 break;
1956
d0a4a61c
TB		 1957 case EXEC_ERROR_STOP:
1958 fputs ("ERROR ", dumpfile);
1959 /* Fall through. */
1960
6de9cd9a 1961 case EXEC_STOP:
6c1abb5c 1962 fputs ("STOP ", dumpfile);
6de9cd9a 1963
a513927a
SK		 1964 if (c->expr1 != NULL)
1965 show_expr (c->expr1);
6de9cd9a 1966 else
6c1abb5c 1967 fprintf (dumpfile, "%d", c->ext.stop_code);
6de9cd9a
DN		 1968
1969 break;
1970
ef78bc3c
AV		 1971 case EXEC_FAIL_IMAGE:
1972 fputs ("FAIL IMAGE ", dumpfile);
1973 break;
1974
f8862a1b
DR		 1975 case EXEC_CHANGE_TEAM:
1976 fputs ("CHANGE TEAM", dumpfile);
1977 break;
1978
1979 case EXEC_END_TEAM:
1980 fputs ("END TEAM", dumpfile);
1981 break;
1982
1983 case EXEC_FORM_TEAM:
1984 fputs ("FORM TEAM", dumpfile);
1985 break;
1986
1987 case EXEC_SYNC_TEAM:
1988 fputs ("SYNC TEAM", dumpfile);
1989 break;
1990
d0a4a61c
TB		 1991 case EXEC_SYNC_ALL:
1992 fputs ("SYNC ALL ", dumpfile);
1993 if (c->expr2 != NULL)
1994 {
1995 fputs (" stat=", dumpfile);
1996 show_expr (c->expr2);
1997 }
1998 if (c->expr3 != NULL)
1999 {
2000 fputs (" errmsg=", dumpfile);
2001 show_expr (c->expr3);
2002 }
2003 break;
2004
2005 case EXEC_SYNC_MEMORY:
2006 fputs ("SYNC MEMORY ", dumpfile);
2007 if (c->expr2 != NULL)
2008 {
2009 fputs (" stat=", dumpfile);
2010 show_expr (c->expr2);
2011 }
2012 if (c->expr3 != NULL)
2013 {
2014 fputs (" errmsg=", dumpfile);
2015 show_expr (c->expr3);
2016 }
2017 break;
2018
2019 case EXEC_SYNC_IMAGES:
2020 fputs ("SYNC IMAGES image-set=", dumpfile);
2021 if (c->expr1 != NULL)
2022 show_expr (c->expr1);
2023 else
2024 fputs ("* ", dumpfile);
2025 if (c->expr2 != NULL)
2026 {
2027 fputs (" stat=", dumpfile);
2028 show_expr (c->expr2);
2029 }
2030 if (c->expr3 != NULL)
2031 {
2032 fputs (" errmsg=", dumpfile);
2033 show_expr (c->expr3);
2034 }
2035 break;
2036
5df445a2
TB		 2037 case EXEC_EVENT_POST:
2038 case EXEC_EVENT_WAIT:
2039 if (c->op == EXEC_EVENT_POST)
2040 fputs ("EVENT POST ", dumpfile);
2041 else
2042 fputs ("EVENT WAIT ", dumpfile);
2043
2044 fputs ("event-variable=", dumpfile);
2045 if (c->expr1 != NULL)
2046 show_expr (c->expr1);
2047 if (c->expr4 != NULL)
2048 {
2049 fputs (" until_count=", dumpfile);
2050 show_expr (c->expr4);
2051 }
2052 if (c->expr2 != NULL)
2053 {
2054 fputs (" stat=", dumpfile);
2055 show_expr (c->expr2);
2056 }
2057 if (c->expr3 != NULL)
2058 {
2059 fputs (" errmsg=", dumpfile);
2060 show_expr (c->expr3);
2061 }
2062 break;
2063
5493aa17
TB		 2064 case EXEC_LOCK:
2065 case EXEC_UNLOCK:
2066 if (c->op == EXEC_LOCK)
2067 fputs ("LOCK ", dumpfile);
2068 else
2069 fputs ("UNLOCK ", dumpfile);
2070
2071 fputs ("lock-variable=", dumpfile);
2072 if (c->expr1 != NULL)
2073 show_expr (c->expr1);
2074 if (c->expr4 != NULL)
2075 {
2076 fputs (" acquired_lock=", dumpfile);
2077 show_expr (c->expr4);
2078 }
2079 if (c->expr2 != NULL)
2080 {
2081 fputs (" stat=", dumpfile);
2082 show_expr (c->expr2);
2083 }
2084 if (c->expr3 != NULL)
2085 {
2086 fputs (" errmsg=", dumpfile);
2087 show_expr (c->expr3);
2088 }
2089 break;
2090
6de9cd9a 2091 case EXEC_ARITHMETIC_IF:
6c1abb5c 2092 fputs ("IF ", dumpfile);
a513927a 2093 show_expr (c->expr1);
6c1abb5c 2094 fprintf (dumpfile, " %d, %d, %d",
79bd1948 2095 c->label1->value, c->label2->value, c->label3->value);
6de9cd9a
DN		 2096 break;
2097
2098 case EXEC_IF:
2099 d = c->block;
6c1abb5c 2100 fputs ("IF ", dumpfile);
a513927a 2101 show_expr (d->expr1);
8cf8ca52
TK		 2102
2103 ++show_level;
6c1abb5c 2104 show_code (level + 1, d->next);
8cf8ca52 2105 --show_level;
6de9cd9a
DN		 2106
2107 d = d->block;
2108 for (; d; d = d->block)
2109 {
cebb1919 2110 fputs("\n", dumpfile);
6de9cd9a 2111 code_indent (level, 0);
a513927a 2112 if (d->expr1 == NULL)
8cf8ca52 2113 fputs ("ELSE", dumpfile);
6de9cd9a
DN		 2114 else
2115 {
6c1abb5c 2116 fputs ("ELSE IF ", dumpfile);
a513927a 2117 show_expr (d->expr1);
6de9cd9a
DN		 2118 }
2119
8cf8ca52 2120 ++show_level;
6c1abb5c 2121 show_code (level + 1, d->next);
8cf8ca52 2122 --show_level;
6de9cd9a
DN		 2123 }
2124
8cf8ca52
TK		 2125 if (c->label1)
2126 code_indent (level, c->label1);
2127 else
2128 show_indent ();
6de9cd9a 2129
6c1abb5c 2130 fputs ("ENDIF", dumpfile);
6de9cd9a
DN		 2131 break;
2132
c6c15a14 2133 case EXEC_BLOCK:
7ed979b9
DK		 2134 {
2135 const char* blocktype;
03cf9837 2136 gfc_namespace *saved_ns;
3070e826 2137 gfc_association_list *alist;
03cf9837 2138
7ed979b9
DK		 2139 if (c->ext.block.assoc)
2140 blocktype = "ASSOCIATE";
2141 else
2142 blocktype = "BLOCK";
2143 show_indent ();
2144 fprintf (dumpfile, "%s ", blocktype);
3070e826
TK		 2145 for (alist = c->ext.block.assoc; alist; alist = alist->next)
2146 {
2147 fprintf (dumpfile, " %s = ", alist->name);
2148 show_expr (alist->target);
2149 }
2150
8cf8ca52 2151 ++show_level;
7ed979b9 2152 ns = c->ext.block.ns;
03cf9837
TK		 2153 saved_ns = gfc_current_ns;
2154 gfc_current_ns = ns;
8cf8ca52 2155 gfc_traverse_symtree (ns->sym_root, show_symtree);
03cf9837 2156 gfc_current_ns = saved_ns;
8cf8ca52
TK		 2157 show_code (show_level, ns->code);
2158 --show_level;
7ed979b9
DK		 2159 show_indent ();
2160 fprintf (dumpfile, "END %s ", blocktype);
2161 break;
2162 }
c6c15a14 2163
3070e826
TK		 2164 case EXEC_END_BLOCK:
2165 /* Only come here when there is a label on an
2166 END ASSOCIATE construct. */
2167 break;
2168
6de9cd9a 2169 case EXEC_SELECT:
dfd6231e 2170 case EXEC_SELECT_TYPE:
6de9cd9a 2171 d = c->block;
dfd6231e 2172 if (c->op == EXEC_SELECT_TYPE)
d32e1fd8 2173 fputs ("SELECT TYPE ", dumpfile);
dfd6231e
PT		 2174 else
2175 fputs ("SELECT CASE ", dumpfile);
a513927a 2176 show_expr (c->expr1);
6c1abb5c 2177 fputc ('\n', dumpfile);
6de9cd9a
DN		 2178
2179 for (; d; d = d->block)
2180 {
2181 code_indent (level, 0);
2182
6c1abb5c 2183 fputs ("CASE ", dumpfile);
29a63d67 2184 for (cp = d->ext.block.case_list; cp; cp = cp->next)
6de9cd9a 2185 {
6c1abb5c
FXC		 2186 fputc ('(', dumpfile);
2187 show_expr (cp->low);
2188 fputc (' ', dumpfile);
2189 show_expr (cp->high);
2190 fputc (')', dumpfile);
2191 fputc (' ', dumpfile);
6de9cd9a 2192 }
6c1abb5c 2193 fputc ('\n', dumpfile);
6de9cd9a 2194
6c1abb5c 2195 show_code (level + 1, d->next);
6de9cd9a
DN		 2196 }
2197
79bd1948 2198 code_indent (level, c->label1);
6c1abb5c 2199 fputs ("END SELECT", dumpfile);
6de9cd9a
DN		 2200 break;
2201
2202 case EXEC_WHERE:
6c1abb5c 2203 fputs ("WHERE ", dumpfile);
6de9cd9a
DN		 2204
2205 d = c->block;
a513927a 2206 show_expr (d->expr1);
6c1abb5c 2207 fputc ('\n', dumpfile);
6de9cd9a 2208
6c1abb5c 2209 show_code (level + 1, d->next);
6de9cd9a
DN		 2210
2211 for (d = d->block; d; d = d->block)
2212 {
2213 code_indent (level, 0);
6c1abb5c 2214 fputs ("ELSE WHERE ", dumpfile);
a513927a 2215 show_expr (d->expr1);
6c1abb5c
FXC		 2216 fputc ('\n', dumpfile);
2217 show_code (level + 1, d->next);
6de9cd9a
DN		 2218 }
2219
2220 code_indent (level, 0);
6c1abb5c 2221 fputs ("END WHERE", dumpfile);
6de9cd9a
DN		 2222 break;
2223
2224
2225 case EXEC_FORALL:
6c1abb5c 2226 fputs ("FORALL ", dumpfile);
6de9cd9a
DN		 2227 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
2228 {
6c1abb5c
FXC		 2229 show_expr (fa->var);
2230 fputc (' ', dumpfile);
2231 show_expr (fa->start);
2232 fputc (':', dumpfile);
2233 show_expr (fa->end);
2234 fputc (':', dumpfile);
2235 show_expr (fa->stride);
6de9cd9a
DN		 2236
2237 if (fa->next != NULL)
6c1abb5c 2238 fputc (',', dumpfile);
6de9cd9a
DN		 2239 }
2240
a513927a 2241 if (c->expr1 != NULL)
6de9cd9a 2242 {
6c1abb5c 2243 fputc (',', dumpfile);
a513927a 2244 show_expr (c->expr1);
6de9cd9a 2245 }
6c1abb5c 2246 fputc ('\n', dumpfile);
6de9cd9a 2247
6c1abb5c 2248 show_code (level + 1, c->block->next);
6de9cd9a
DN		 2249
2250 code_indent (level, 0);
6c1abb5c 2251 fputs ("END FORALL", dumpfile);
6de9cd9a
DN		 2252 break;
2253
d0a4a61c
TB		 2254 case EXEC_CRITICAL:
2255 fputs ("CRITICAL\n", dumpfile);
2256 show_code (level + 1, c->block->next);
2257 code_indent (level, 0);
2258 fputs ("END CRITICAL", dumpfile);
2259 break;
2260
6de9cd9a 2261 case EXEC_DO:
6c1abb5c 2262 fputs ("DO ", dumpfile);
8cf8ca52
TK		 2263 if (c->label1)
2264 fprintf (dumpfile, " %-5d ", c->label1->value);
6de9cd9a 2265
6c1abb5c
FXC		 2266 show_expr (c->ext.iterator->var);
2267 fputc ('=', dumpfile);
2268 show_expr (c->ext.iterator->start);
2269 fputc (' ', dumpfile);
2270 show_expr (c->ext.iterator->end);
2271 fputc (' ', dumpfile);
2272 show_expr (c->ext.iterator->step);
6de9cd9a 2273
8cf8ca52 2274 ++show_level;
6c1abb5c 2275 show_code (level + 1, c->block->next);
8cf8ca52 2276 --show_level;
6de9cd9a 2277
8cf8ca52
TK		 2278 if (c->label1)
2279 break;
2280
2281 show_indent ();
6c1abb5c 2282 fputs ("END DO", dumpfile);
6de9cd9a
DN		 2283 break;
2284
8c6a85e3
TB		 2285 case EXEC_DO_CONCURRENT:
2286 fputs ("DO CONCURRENT ", dumpfile);
2287 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
2288 {
2289 show_expr (fa->var);
2290 fputc (' ', dumpfile);
2291 show_expr (fa->start);
2292 fputc (':', dumpfile);
2293 show_expr (fa->end);
2294 fputc (':', dumpfile);
2295 show_expr (fa->stride);
2296
2297 if (fa->next != NULL)
2298 fputc (',', dumpfile);
2299 }
2300 show_expr (c->expr1);
cebb1919 2301 ++show_level;
8c6a85e3
TB		 2302
2303 show_code (level + 1, c->block->next);
cebb1919 2304 --show_level;
8c6a85e3 2305 code_indent (level, c->label1);
cebb1919 2306 show_indent ();
8c6a85e3
TB		 2307 fputs ("END DO", dumpfile);
2308 break;
2309
6de9cd9a 2310 case EXEC_DO_WHILE:
6c1abb5c 2311 fputs ("DO WHILE ", dumpfile);
a513927a 2312 show_expr (c->expr1);
6c1abb5c 2313 fputc ('\n', dumpfile);
6de9cd9a 2314
6c1abb5c 2315 show_code (level + 1, c->block->next);
6de9cd9a 2316
79bd1948 2317 code_indent (level, c->label1);
6c1abb5c 2318 fputs ("END DO", dumpfile);
6de9cd9a
DN		 2319 break;
2320
2321 case EXEC_CYCLE:
6c1abb5c 2322 fputs ("CYCLE", dumpfile);
6de9cd9a 2323 if (c->symtree)
6c1abb5c 2324 fprintf (dumpfile, " %s", c->symtree->n.sym->name);
6de9cd9a
DN		 2325 break;
2326
2327 case EXEC_EXIT:
6c1abb5c 2328 fputs ("EXIT", dumpfile);
6de9cd9a 2329 if (c->symtree)
6c1abb5c 2330 fprintf (dumpfile, " %s", c->symtree->n.sym->name);
6de9cd9a
DN		 2331 break;
2332
2333 case EXEC_ALLOCATE:
6c1abb5c 2334 fputs ("ALLOCATE ", dumpfile);
a513927a 2335 if (c->expr1)
6de9cd9a 2336 {
6c1abb5c 2337 fputs (" STAT=", dumpfile);
a513927a 2338 show_expr (c->expr1);
6de9cd9a
DN		 2339 }
2340
0511ddbb
SK		 2341 if (c->expr2)
2342 {
2343 fputs (" ERRMSG=", dumpfile);
2344 show_expr (c->expr2);
2345 }
2346
fabb6f8e
PT		 2347 if (c->expr3)
2348 {
2349 if (c->expr3->mold)
2350 fputs (" MOLD=", dumpfile);
2351 else
2352 fputs (" SOURCE=", dumpfile);
2353 show_expr (c->expr3);
2354 }
2355
cf2b3c22 2356 for (a = c->ext.alloc.list; a; a = a->next)
6de9cd9a 2357 {
6c1abb5c
FXC		 2358 fputc (' ', dumpfile);
2359 show_expr (a->expr);
6de9cd9a
DN		 2360 }
2361
2362 break;
2363
2364 case EXEC_DEALLOCATE:
6c1abb5c 2365 fputs ("DEALLOCATE ", dumpfile);
a513927a 2366 if (c->expr1)
6de9cd9a 2367 {
6c1abb5c 2368 fputs (" STAT=", dumpfile);
a513927a 2369 show_expr (c->expr1);
6de9cd9a
DN		 2370 }
2371
0511ddbb
SK		 2372 if (c->expr2)
2373 {
2374 fputs (" ERRMSG=", dumpfile);
2375 show_expr (c->expr2);
2376 }
2377
cf2b3c22 2378 for (a = c->ext.alloc.list; a; a = a->next)
6de9cd9a 2379 {
6c1abb5c
FXC		 2380 fputc (' ', dumpfile);
2381 show_expr (a->expr);
6de9cd9a
DN		 2382 }
2383
2384 break;
2385
2386 case EXEC_OPEN:
6c1abb5c 2387 fputs ("OPEN", dumpfile);
6de9cd9a
DN		 2388 open = c->ext.open;
2389
2390 if (open->unit)
2391 {
6c1abb5c
FXC		 2392 fputs (" UNIT=", dumpfile);
2393 show_expr (open->unit);
6de9cd9a 2394 }
7aba8abe
TK		 2395 if (open->iomsg)
2396 {
6c1abb5c
FXC		 2397 fputs (" IOMSG=", dumpfile);
2398 show_expr (open->iomsg);
7aba8abe 2399 }
6de9cd9a
DN		 2400 if (open->iostat)
2401 {
6c1abb5c
FXC		 2402 fputs (" IOSTAT=", dumpfile);
2403 show_expr (open->iostat);
6de9cd9a
DN		 2404 }
2405 if (open->file)
2406 {
6c1abb5c
FXC		 2407 fputs (" FILE=", dumpfile);
2408 show_expr (open->file);
6de9cd9a
DN		 2409 }
2410 if (open->status)
2411 {
6c1abb5c
FXC		 2412 fputs (" STATUS=", dumpfile);
2413 show_expr (open->status);
6de9cd9a
DN		 2414 }
2415 if (open->access)
2416 {
6c1abb5c
FXC		 2417 fputs (" ACCESS=", dumpfile);
2418 show_expr (open->access);
6de9cd9a
DN		 2419 }
2420 if (open->form)
2421 {
6c1abb5c
FXC		 2422 fputs (" FORM=", dumpfile);
2423 show_expr (open->form);
6de9cd9a
DN		 2424 }
2425 if (open->recl)
2426 {
6c1abb5c
FXC		 2427 fputs (" RECL=", dumpfile);
2428 show_expr (open->recl);
6de9cd9a
DN		 2429 }
2430 if (open->blank)
2431 {
6c1abb5c
FXC		 2432 fputs (" BLANK=", dumpfile);
2433 show_expr (open->blank);
6de9cd9a
DN		 2434 }
2435 if (open->position)
2436 {
6c1abb5c
FXC		 2437 fputs (" POSITION=", dumpfile);
2438 show_expr (open->position);
6de9cd9a
DN		 2439 }
2440 if (open->action)
2441 {
6c1abb5c
FXC		 2442 fputs (" ACTION=", dumpfile);
2443 show_expr (open->action);
6de9cd9a
DN		 2444 }
2445 if (open->delim)
2446 {
6c1abb5c
FXC		 2447 fputs (" DELIM=", dumpfile);
2448 show_expr (open->delim);
6de9cd9a
DN		 2449 }
2450 if (open->pad)
2451 {
6c1abb5c
FXC		 2452 fputs (" PAD=", dumpfile);
2453 show_expr (open->pad);
6de9cd9a 2454 }
6f0f0b2e
JD		 2455 if (open->decimal)
2456 {
6c1abb5c
FXC		 2457 fputs (" DECIMAL=", dumpfile);
2458 show_expr (open->decimal);
6f0f0b2e
JD		 2459 }
2460 if (open->encoding)
2461 {
6c1abb5c
FXC		 2462 fputs (" ENCODING=", dumpfile);
2463 show_expr (open->encoding);
6f0f0b2e
JD		 2464 }
2465 if (open->round)
2466 {
6c1abb5c
FXC		 2467 fputs (" ROUND=", dumpfile);
2468 show_expr (open->round);
6f0f0b2e
JD		 2469 }
2470 if (open->sign)
2471 {
6c1abb5c
FXC		 2472 fputs (" SIGN=", dumpfile);
2473 show_expr (open->sign);
6f0f0b2e 2474 }
181c9f4a
TK		 2475 if (open->convert)
2476 {
6c1abb5c
FXC		 2477 fputs (" CONVERT=", dumpfile);
2478 show_expr (open->convert);
181c9f4a 2479 }
6f0f0b2e
JD		 2480 if (open->asynchronous)
2481 {
6c1abb5c
FXC		 2482 fputs (" ASYNCHRONOUS=", dumpfile);
2483 show_expr (open->asynchronous);
6f0f0b2e 2484 }
6de9cd9a 2485 if (open->err != NULL)
6c1abb5c 2486 fprintf (dumpfile, " ERR=%d", open->err->value);
6de9cd9a
DN		 2487
2488 break;
2489
2490 case EXEC_CLOSE:
6c1abb5c 2491 fputs ("CLOSE", dumpfile);
6de9cd9a
DN		 2492 close = c->ext.close;
2493
2494 if (close->unit)
2495 {
6c1abb5c
FXC		 2496 fputs (" UNIT=", dumpfile);
2497 show_expr (close->unit);
6de9cd9a 2498 }
7aba8abe
TK		 2499 if (close->iomsg)
2500 {
6c1abb5c
FXC		 2501 fputs (" IOMSG=", dumpfile);
2502 show_expr (close->iomsg);
7aba8abe 2503 }
6de9cd9a
DN		 2504 if (close->iostat)
2505 {
6c1abb5c
FXC		 2506 fputs (" IOSTAT=", dumpfile);
2507 show_expr (close->iostat);
6de9cd9a
DN		 2508 }
2509 if (close->status)
2510 {
6c1abb5c
FXC		 2511 fputs (" STATUS=", dumpfile);
2512 show_expr (close->status);
6de9cd9a
DN		 2513 }
2514 if (close->err != NULL)
6c1abb5c 2515 fprintf (dumpfile, " ERR=%d", close->err->value);
6de9cd9a
DN		 2516 break;
2517
2518 case EXEC_BACKSPACE:
6c1abb5c 2519 fputs ("BACKSPACE", dumpfile);
6de9cd9a
DN		 2520 goto show_filepos;
2521
2522 case EXEC_ENDFILE:
6c1abb5c 2523 fputs ("ENDFILE", dumpfile);
6de9cd9a
DN		 2524 goto show_filepos;
2525
2526 case EXEC_REWIND:
6c1abb5c 2527 fputs ("REWIND", dumpfile);
6403ec5f
JB		 2528 goto show_filepos;
2529
2530 case EXEC_FLUSH:
6c1abb5c 2531 fputs ("FLUSH", dumpfile);
6de9cd9a
DN		 2532
2533 show_filepos:
2534 fp = c->ext.filepos;
2535
2536 if (fp->unit)
2537 {
6c1abb5c
FXC		 2538 fputs (" UNIT=", dumpfile);
2539 show_expr (fp->unit);
6de9cd9a 2540 }
7aba8abe
TK		 2541 if (fp->iomsg)
2542 {
6c1abb5c
FXC		 2543 fputs (" IOMSG=", dumpfile);
2544 show_expr (fp->iomsg);
7aba8abe 2545 }
6de9cd9a
DN		 2546 if (fp->iostat)
2547 {
6c1abb5c
FXC		 2548 fputs (" IOSTAT=", dumpfile);
2549 show_expr (fp->iostat);
6de9cd9a
DN		 2550 }
2551 if (fp->err != NULL)
6c1abb5c 2552 fprintf (dumpfile, " ERR=%d", fp->err->value);
6de9cd9a
DN		 2553 break;
2554
2555 case EXEC_INQUIRE:
6c1abb5c 2556 fputs ("INQUIRE", dumpfile);
6de9cd9a
DN		 2557 i = c->ext.inquire;
2558
2559 if (i->unit)
2560 {
6c1abb5c
FXC		 2561 fputs (" UNIT=", dumpfile);
2562 show_expr (i->unit);
6de9cd9a
DN		 2563 }
2564 if (i->file)
2565 {
6c1abb5c
FXC		 2566 fputs (" FILE=", dumpfile);
2567 show_expr (i->file);
6de9cd9a
DN		 2568 }
2569
7aba8abe
TK		 2570 if (i->iomsg)
2571 {
6c1abb5c
FXC		 2572 fputs (" IOMSG=", dumpfile);
2573 show_expr (i->iomsg);
7aba8abe 2574 }
6de9cd9a
DN		 2575 if (i->iostat)
2576 {
6c1abb5c
FXC		 2577 fputs (" IOSTAT=", dumpfile);
2578 show_expr (i->iostat);
6de9cd9a
DN		 2579 }
2580 if (i->exist)
2581 {
6c1abb5c
FXC		 2582 fputs (" EXIST=", dumpfile);
2583 show_expr (i->exist);
6de9cd9a
DN		 2584 }
2585 if (i->opened)
2586 {
6c1abb5c
FXC		 2587 fputs (" OPENED=", dumpfile);
2588 show_expr (i->opened);
6de9cd9a
DN		 2589 }
2590 if (i->number)
2591 {
6c1abb5c
FXC		 2592 fputs (" NUMBER=", dumpfile);
2593 show_expr (i->number);
6de9cd9a
DN		 2594 }
2595 if (i->named)
2596 {
6c1abb5c
FXC		 2597 fputs (" NAMED=", dumpfile);
2598 show_expr (i->named);
6de9cd9a
DN		 2599 }
2600 if (i->name)
2601 {
6c1abb5c
FXC		 2602 fputs (" NAME=", dumpfile);
2603 show_expr (i->name);
6de9cd9a
DN		 2604 }
2605 if (i->access)
2606 {
6c1abb5c
FXC		 2607 fputs (" ACCESS=", dumpfile);
2608 show_expr (i->access);
6de9cd9a
DN		 2609 }
2610 if (i->sequential)
2611 {
6c1abb5c
FXC		 2612 fputs (" SEQUENTIAL=", dumpfile);
2613 show_expr (i->sequential);
6de9cd9a
DN		 2614 }
2615
2616 if (i->direct)
2617 {
6c1abb5c
FXC		 2618 fputs (" DIRECT=", dumpfile);
2619 show_expr (i->direct);
6de9cd9a
DN		 2620 }
2621 if (i->form)
2622 {
6c1abb5c
FXC		 2623 fputs (" FORM=", dumpfile);
2624 show_expr (i->form);
6de9cd9a
DN		 2625 }
2626 if (i->formatted)
2627 {
6c1abb5c
FXC		 2628 fputs (" FORMATTED", dumpfile);
2629 show_expr (i->formatted);
6de9cd9a
DN		 2630 }
2631 if (i->unformatted)
2632 {
6c1abb5c
FXC		 2633 fputs (" UNFORMATTED=", dumpfile);
2634 show_expr (i->unformatted);
6de9cd9a
DN		 2635 }
2636 if (i->recl)
2637 {
6c1abb5c
FXC		 2638 fputs (" RECL=", dumpfile);
2639 show_expr (i->recl);
6de9cd9a
DN		 2640 }
2641 if (i->nextrec)
2642 {
6c1abb5c
FXC		 2643 fputs (" NEXTREC=", dumpfile);
2644 show_expr (i->nextrec);
6de9cd9a
DN		 2645 }
2646 if (i->blank)
2647 {
6c1abb5c
FXC		 2648 fputs (" BLANK=", dumpfile);
2649 show_expr (i->blank);
6de9cd9a
DN		 2650 }
2651 if (i->position)
2652 {
6c1abb5c
FXC		 2653 fputs (" POSITION=", dumpfile);
2654 show_expr (i->position);
6de9cd9a
DN		 2655 }
2656 if (i->action)
2657 {
6c1abb5c
FXC		 2658 fputs (" ACTION=", dumpfile);
2659 show_expr (i->action);
6de9cd9a
DN		 2660 }
2661 if (i->read)
2662 {
6c1abb5c
FXC		 2663 fputs (" READ=", dumpfile);
2664 show_expr (i->read);
6de9cd9a
DN		 2665 }
2666 if (i->write)
2667 {
6c1abb5c
FXC		 2668 fputs (" WRITE=", dumpfile);
2669 show_expr (i->write);
6de9cd9a
DN		 2670 }
2671 if (i->readwrite)
2672 {
6c1abb5c
FXC		 2673 fputs (" READWRITE=", dumpfile);
2674 show_expr (i->readwrite);
6de9cd9a
DN		 2675 }
2676 if (i->delim)
2677 {
6c1abb5c
FXC		 2678 fputs (" DELIM=", dumpfile);
2679 show_expr (i->delim);
6de9cd9a
DN		 2680 }
2681 if (i->pad)
2682 {
6c1abb5c
FXC		 2683 fputs (" PAD=", dumpfile);
2684 show_expr (i->pad);
6de9cd9a 2685 }
181c9f4a
TK		 2686 if (i->convert)
2687 {
6c1abb5c
FXC		 2688 fputs (" CONVERT=", dumpfile);
2689 show_expr (i->convert);
181c9f4a 2690 }
6f0f0b2e
JD		 2691 if (i->asynchronous)
2692 {
6c1abb5c
FXC		 2693 fputs (" ASYNCHRONOUS=", dumpfile);
2694 show_expr (i->asynchronous);
6f0f0b2e
JD		 2695 }
2696 if (i->decimal)
2697 {
6c1abb5c
FXC		 2698 fputs (" DECIMAL=", dumpfile);
2699 show_expr (i->decimal);
6f0f0b2e
JD		 2700 }
2701 if (i->encoding)
2702 {
6c1abb5c
FXC		 2703 fputs (" ENCODING=", dumpfile);
2704 show_expr (i->encoding);
6f0f0b2e
JD		 2705 }
2706 if (i->pending)
2707 {
6c1abb5c
FXC		 2708 fputs (" PENDING=", dumpfile);
2709 show_expr (i->pending);
6f0f0b2e
JD		 2710 }
2711 if (i->round)
2712 {
6c1abb5c
FXC		 2713 fputs (" ROUND=", dumpfile);
2714 show_expr (i->round);
6f0f0b2e
JD		 2715 }
2716 if (i->sign)
2717 {
6c1abb5c
FXC		 2718 fputs (" SIGN=", dumpfile);
2719 show_expr (i->sign);
6f0f0b2e
JD		 2720 }
2721 if (i->size)
2722 {
6c1abb5c
FXC		 2723 fputs (" SIZE=", dumpfile);
2724 show_expr (i->size);
6f0f0b2e
JD		 2725 }
2726 if (i->id)
2727 {
6c1abb5c
FXC		 2728 fputs (" ID=", dumpfile);
2729 show_expr (i->id);
6f0f0b2e 2730 }
6de9cd9a
DN		 2731
2732 if (i->err != NULL)
6c1abb5c 2733 fprintf (dumpfile, " ERR=%d", i->err->value);
6de9cd9a
DN		 2734 break;
2735
2736 case EXEC_IOLENGTH:
6c1abb5c 2737 fputs ("IOLENGTH ", dumpfile);
a513927a 2738 show_expr (c->expr1);
5e805e44 2739 goto show_dt_code;
6de9cd9a
DN		 2740 break;
2741
2742 case EXEC_READ:
6c1abb5c 2743 fputs ("READ", dumpfile);
6de9cd9a
DN		 2744 goto show_dt;
2745
2746 case EXEC_WRITE:
6c1abb5c 2747 fputs ("WRITE", dumpfile);
6de9cd9a
DN		 2748
2749 show_dt:
2750 dt = c->ext.dt;
2751 if (dt->io_unit)
2752 {
6c1abb5c
FXC		 2753 fputs (" UNIT=", dumpfile);
2754 show_expr (dt->io_unit);
6de9cd9a
DN		 2755 }
2756
2757 if (dt->format_expr)
2758 {
6c1abb5c
FXC		 2759 fputs (" FMT=", dumpfile);
2760 show_expr (dt->format_expr);
6de9cd9a
DN		 2761 }
2762
2763 if (dt->format_label != NULL)
6c1abb5c 2764 fprintf (dumpfile, " FMT=%d", dt->format_label->value);
6de9cd9a 2765 if (dt->namelist)
6c1abb5c 2766 fprintf (dumpfile, " NML=%s", dt->namelist->name);
7aba8abe
TK		 2767
2768 if (dt->iomsg)
2769 {
6c1abb5c
FXC		 2770 fputs (" IOMSG=", dumpfile);
2771 show_expr (dt->iomsg);
7aba8abe 2772 }
6de9cd9a
DN		 2773 if (dt->iostat)
2774 {
6c1abb5c
FXC		 2775 fputs (" IOSTAT=", dumpfile);
2776 show_expr (dt->iostat);
6de9cd9a
DN		 2777 }
2778 if (dt->size)
2779 {
6c1abb5c
FXC		 2780 fputs (" SIZE=", dumpfile);
2781 show_expr (dt->size);
6de9cd9a
DN		 2782 }
2783 if (dt->rec)
2784 {
6c1abb5c
FXC		 2785 fputs (" REC=", dumpfile);
2786 show_expr (dt->rec);
6de9cd9a
DN		 2787 }
2788 if (dt->advance)
2789 {
6c1abb5c
FXC		 2790 fputs (" ADVANCE=", dumpfile);
2791 show_expr (dt->advance);
6de9cd9a 2792 }
6f0f0b2e
JD		 2793 if (dt->id)
2794 {
6c1abb5c
FXC		 2795 fputs (" ID=", dumpfile);
2796 show_expr (dt->id);
6f0f0b2e
JD		 2797 }
2798 if (dt->pos)
2799 {
6c1abb5c
FXC		 2800 fputs (" POS=", dumpfile);
2801 show_expr (dt->pos);
6f0f0b2e
JD		 2802 }
2803 if (dt->asynchronous)
2804 {
6c1abb5c
FXC		 2805 fputs (" ASYNCHRONOUS=", dumpfile);
2806 show_expr (dt->asynchronous);
6f0f0b2e
JD		 2807 }
2808 if (dt->blank)
2809 {
6c1abb5c
FXC		 2810 fputs (" BLANK=", dumpfile);
2811 show_expr (dt->blank);
6f0f0b2e
JD		 2812 }
2813 if (dt->decimal)
2814 {
6c1abb5c
FXC		 2815 fputs (" DECIMAL=", dumpfile);
2816 show_expr (dt->decimal);
6f0f0b2e
JD		 2817 }
2818 if (dt->delim)
2819 {
6c1abb5c
FXC		 2820 fputs (" DELIM=", dumpfile);
2821 show_expr (dt->delim);
6f0f0b2e
JD		 2822 }
2823 if (dt->pad)
2824 {
6c1abb5c
FXC		 2825 fputs (" PAD=", dumpfile);
2826 show_expr (dt->pad);
6f0f0b2e
JD		 2827 }
2828 if (dt->round)
2829 {
6c1abb5c
FXC		 2830 fputs (" ROUND=", dumpfile);
2831 show_expr (dt->round);
6f0f0b2e
JD		 2832 }
2833 if (dt->sign)
2834 {
6c1abb5c
FXC		 2835 fputs (" SIGN=", dumpfile);
2836 show_expr (dt->sign);
6f0f0b2e 2837 }
6de9cd9a 2838
5e805e44 2839 show_dt_code:
5e805e44 2840 for (c = c->block->next; c; c = c->next)
6c1abb5c 2841 show_code_node (level + (c->next != NULL), c);
5e805e44 2842 return;
6de9cd9a
DN		 2843
2844 case EXEC_TRANSFER:
6c1abb5c 2845 fputs ("TRANSFER ", dumpfile);
a513927a 2846 show_expr (c->expr1);
6de9cd9a
DN		 2847 break;
2848
2849 case EXEC_DT_END:
6c1abb5c 2850 fputs ("DT_END", dumpfile);
6de9cd9a
DN		 2851 dt = c->ext.dt;
2852
2853 if (dt->err != NULL)
6c1abb5c 2854 fprintf (dumpfile, " ERR=%d", dt->err->value);
6de9cd9a 2855 if (dt->end != NULL)
6c1abb5c 2856 fprintf (dumpfile, " END=%d", dt->end->value);
6de9cd9a 2857 if (dt->eor != NULL)
6c1abb5c 2858 fprintf (dumpfile, " EOR=%d", dt->eor->value);
6de9cd9a
DN		 2859 break;
2860
4f8d1d32
TK		 2861 case EXEC_WAIT:
2862 fputs ("WAIT", dumpfile);
2863
2864 if (c->ext.wait != NULL)
2865 {
2866 gfc_wait *wait = c->ext.wait;
2867 if (wait->unit)
2868 {
2869 fputs (" UNIT=", dumpfile);
2870 show_expr (wait->unit);
2871 }
2872 if (wait->iostat)
2873 {
2874 fputs (" IOSTAT=", dumpfile);
2875 show_expr (wait->iostat);
2876 }
2877 if (wait->iomsg)
2878 {
2879 fputs (" IOMSG=", dumpfile);
2880 show_expr (wait->iomsg);
2881 }
2882 if (wait->id)
2883 {
2884 fputs (" ID=", dumpfile);
2885 show_expr (wait->id);
2886 }
2887 if (wait->err)
2888 fprintf (dumpfile, " ERR=%d", wait->err->value);
2889 if (wait->end)
2890 fprintf (dumpfile, " END=%d", wait->end->value);
2891 if (wait->eor)
2892 fprintf (dumpfile, " EOR=%d", wait->eor->value);
2893 }
2894 break;
2895
41dbbb37
TS		 2896 case EXEC_OACC_PARALLEL_LOOP:
2897 case EXEC_OACC_PARALLEL:
2898 case EXEC_OACC_KERNELS_LOOP:
2899 case EXEC_OACC_KERNELS:
2900 case EXEC_OACC_DATA:
2901 case EXEC_OACC_HOST_DATA:
2902 case EXEC_OACC_LOOP:
2903 case EXEC_OACC_UPDATE:
2904 case EXEC_OACC_WAIT:
2905 case EXEC_OACC_CACHE:
2906 case EXEC_OACC_ENTER_DATA:
2907 case EXEC_OACC_EXIT_DATA:
6c7a4dfd 2908 case EXEC_OMP_ATOMIC:
dd2fc525
JJ		 2909 case EXEC_OMP_CANCEL:
2910 case EXEC_OMP_CANCELLATION_POINT:
6c7a4dfd
JJ		 2911 case EXEC_OMP_BARRIER:
2912 case EXEC_OMP_CRITICAL:
b4c3a85b
JJ		 2913 case EXEC_OMP_DISTRIBUTE:
2914 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
2915 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
2916 case EXEC_OMP_DISTRIBUTE_SIMD:
6c7a4dfd 2917 case EXEC_OMP_DO:
dd2fc525 2918 case EXEC_OMP_DO_SIMD:
b4c3a85b 2919 case EXEC_OMP_FLUSH:
6c7a4dfd
JJ		 2920 case EXEC_OMP_MASTER:
2921 case EXEC_OMP_ORDERED:
2922 case EXEC_OMP_PARALLEL:
2923 case EXEC_OMP_PARALLEL_DO:
dd2fc525 2924 case EXEC_OMP_PARALLEL_DO_SIMD:
6c7a4dfd
JJ		 2925 case EXEC_OMP_PARALLEL_SECTIONS:
2926 case EXEC_OMP_PARALLEL_WORKSHARE:
2927 case EXEC_OMP_SECTIONS:
dd2fc525 2928 case EXEC_OMP_SIMD:
6c7a4dfd 2929 case EXEC_OMP_SINGLE:
b4c3a85b
JJ		 2930 case EXEC_OMP_TARGET:
2931 case EXEC_OMP_TARGET_DATA:
2932 case EXEC_OMP_TARGET_ENTER_DATA:
2933 case EXEC_OMP_TARGET_EXIT_DATA:
2934 case EXEC_OMP_TARGET_PARALLEL:
2935 case EXEC_OMP_TARGET_PARALLEL_DO:
2936 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
2937 case EXEC_OMP_TARGET_SIMD:
2938 case EXEC_OMP_TARGET_TEAMS:
2939 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
2940 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
2941 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2942 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
2943 case EXEC_OMP_TARGET_UPDATE:
a68ab351 2944 case EXEC_OMP_TASK:
dd2fc525 2945 case EXEC_OMP_TASKGROUP:
b4c3a85b
JJ		 2946 case EXEC_OMP_TASKLOOP:
2947 case EXEC_OMP_TASKLOOP_SIMD:
a68ab351 2948 case EXEC_OMP_TASKWAIT:
20906c66 2949 case EXEC_OMP_TASKYIELD:
b4c3a85b
JJ		 2950 case EXEC_OMP_TEAMS:
2951 case EXEC_OMP_TEAMS_DISTRIBUTE:
2952 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
2953 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2954 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
6c7a4dfd 2955 case EXEC_OMP_WORKSHARE:
6c1abb5c 2956 show_omp_node (level, c);
6c7a4dfd
JJ		 2957 break;
2958
6de9cd9a 2959 default:
6c1abb5c 2960 gfc_internal_error ("show_code_node(): Bad statement code");
6de9cd9a 2961 }
6de9cd9a
DN		 2962}
2963
2964
30c05595 2965/* Show an equivalence chain. */
1854117e 2966
6c1abb5c
FXC		 2967static void
2968show_equiv (gfc_equiv *eq)
1854117e
PB		 2969{
2970 show_indent ();
6c1abb5c 2971 fputs ("Equivalence: ", dumpfile);
1854117e
PB		 2972 while (eq)
2973 {
6c1abb5c 2974 show_expr (eq->expr);
1854117e
PB		 2975 eq = eq->eq;
2976 if (eq)
6c1abb5c 2977 fputs (", ", dumpfile);
1854117e
PB		 2978 }
2979}
2980
6c1abb5c 2981
6de9cd9a
DN		 2982/* Show a freakin' whole namespace. */
2983
6c1abb5c
FXC		 2984static void
2985show_namespace (gfc_namespace *ns)
6de9cd9a
DN		 2986{
2987 gfc_interface *intr;
2988 gfc_namespace *save;
09639a83 2989 int op;
1854117e 2990 gfc_equiv *eq;
6de9cd9a
DN		 2991 int i;
2992
fc2655fb 2993 gcc_assert (ns);
6de9cd9a 2994 save = gfc_current_ns;
6de9cd9a
DN		 2995
2996 show_indent ();
6c1abb5c 2997 fputs ("Namespace:", dumpfile);
6de9cd9a 2998
fc2655fb
TB		 2999 i = 0;
3000 do
6de9cd9a 3001 {
fc2655fb
TB		 3002 int l = i;
3003 while (i < GFC_LETTERS - 1
3004 && gfc_compare_types (&ns->default_type[i+1],
3005 &ns->default_type[l]))
3006 i++;
3007
3008 if (i > l)
3009 fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
3010 else
3011 fprintf (dumpfile, " %c: ", l+'A');
6de9cd9a 3012
fc2655fb
TB		 3013 show_typespec(&ns->default_type[l]);
3014 i++;
3015 } while (i < GFC_LETTERS);
6de9cd9a 3016
fc2655fb
TB		 3017 if (ns->proc_name != NULL)
3018 {
3019 show_indent ();
3020 fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
3021 }
6de9cd9a 3022
fc2655fb
TB		 3023 ++show_level;
3024 gfc_current_ns = ns;
3025 gfc_traverse_symtree (ns->common_root, show_common);
fbc9b453 3026
fc2655fb 3027 gfc_traverse_symtree (ns->sym_root, show_symtree);
6de9cd9a 3028
fc2655fb
TB		 3029 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
3030 {
3031 /* User operator interfaces */
3032 intr = ns->op[op];
3033 if (intr == NULL)
3034 continue;
6de9cd9a 3035
fc2655fb
TB		 3036 show_indent ();
3037 fprintf (dumpfile, "Operator interfaces for %s:",
3038 gfc_op2string ((gfc_intrinsic_op) op));
6de9cd9a 3039
fc2655fb
TB		 3040 for (; intr; intr = intr->next)
3041 fprintf (dumpfile, " %s", intr->sym->name);
3042 }
6de9cd9a 3043
fc2655fb
TB		 3044 if (ns->uop_root != NULL)
3045 {
3046 show_indent ();
3047 fputs ("User operators:\n", dumpfile);
3048 gfc_traverse_user_op (ns, show_uop);
6de9cd9a 3049 }
dfd6231e 3050
1854117e 3051 for (eq = ns->equiv; eq; eq = eq->next)
6c1abb5c 3052 show_equiv (eq);
6de9cd9a 3053
dc7a8b4b 3054 if (ns->oacc_declare)
41dbbb37 3055 {
dc7a8b4b 3056 struct gfc_oacc_declare *decl;
41dbbb37 3057 /* Dump !$ACC DECLARE clauses. */
dc7a8b4b
JN		 3058 for (decl = ns->oacc_declare; decl; decl = decl->next)
3059 {
3060 show_indent ();
3061 fprintf (dumpfile, "!$ACC DECLARE");
3062 show_omp_clauses (decl->clauses);
3063 }
41dbbb37
TS		 3064 }
3065
6c1abb5c 3066 fputc ('\n', dumpfile);
8cf8ca52
TK		 3067 show_indent ();
3068 fputs ("code:", dumpfile);
7ed979b9 3069 show_code (show_level, ns->code);
8cf8ca52 3070 --show_level;
6de9cd9a
DN		 3071
3072 for (ns = ns->contained; ns; ns = ns->sibling)
3073 {
8cf8ca52
TK		 3074 fputs ("\nCONTAINS\n", dumpfile);
3075 ++show_level;
6c1abb5c 3076 show_namespace (ns);
8cf8ca52 3077 --show_level;
6de9cd9a
DN		 3078 }
3079
6c1abb5c 3080 fputc ('\n', dumpfile);
6de9cd9a
DN		 3081 gfc_current_ns = save;
3082}
6c1abb5c
FXC		 3083
3084
3085/* Main function for dumping a parse tree. */
3086
3087void
3088gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
3089{
3090 dumpfile = file;
3091 show_namespace (ns);
3092}
94fae14b 3093
e655a6cc
TK		 3094/* This part writes BIND(C) definition for use in external C programs. */
3095
3096static void write_interop_decl (gfc_symbol *);
6328ce1f 3097static void write_proc (gfc_symbol *, bool);
e655a6cc
TK		 3098
3099void
3100gfc_dump_c_prototypes (gfc_namespace *ns, FILE *file)
3101{
3102 int error_count;
3103 gfc_get_errors (NULL, &error_count);
3104 if (error_count != 0)
3105 return;
3106 dumpfile = file;
3107 gfc_traverse_ns (ns, write_interop_decl);
3108}
3109
6328ce1f
TK		 3110/* Loop over all global symbols, writing out their declrations. */
3111
3112void
3113gfc_dump_external_c_prototypes (FILE * file)
3114{
3115 dumpfile = file;
3116 fprintf (dumpfile,
3117 _("/* Prototypes for external procedures generated from %s\n"
3118 " by GNU Fortran %s%s.\n\n"
3119 " Use of this interface is discouraged, consider using the\n"
3120 " BIND(C) feature of standard Fortran instead. */\n\n"),
3121 gfc_source_file, pkgversion_string, version_string);
3122
3123 for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
3124 gfc_current_ns = gfc_current_ns->sibling)
3125 {
3126 gfc_symbol *sym = gfc_current_ns->proc_name;
3127
3128 if (sym == NULL || sym->attr.flavor != FL_PROCEDURE
3129 || sym->attr.is_bind_c)
3130 continue;
3131
3132 write_proc (sym, false);
3133 }
3134 return;
3135}
3136
e655a6cc
TK		 3137enum type_return { T_OK=0, T_WARN, T_ERROR };
3138
3139/* Return the name of the type for later output. Both function pointers and
3140 void pointers will be mapped to void *. */
3141
3142static enum type_return
3143get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre,
3144 const char **type_name, bool *asterisk, const char **post,
3145 bool func_ret)
3146{
3147 static char post_buffer[40];
3148 enum type_return ret;
3149 ret = T_ERROR;
3150
3151 *pre = " ";
3152 *asterisk = false;
3153 *post = "";
3154 *type_name = "<error>";
6328ce1f 3155 if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX)
e655a6cc 3156 {
e655a6cc
TK		 3157 if (ts->is_c_interop && ts->interop_kind)
3158 {
3159 *type_name = ts->interop_kind->name + 2;
3160 if (strcmp (*type_name, "signed_char") == 0)
3161 *type_name = "signed char";
3162 else if (strcmp (*type_name, "size_t") == 0)
3163 *type_name = "ssize_t";
6328ce1f 3164 else if (strcmp (*type_name, "float_complex") == 0)
4c016457 3165 *type_name = "__GFORTRAN_FLOAT_COMPLEX";
6328ce1f 3166 else if (strcmp (*type_name, "double_complex") == 0)
4c016457 3167 *type_name = "__GFORTRAN_DOUBLE_COMPLEX";
6328ce1f 3168 else if (strcmp (*type_name, "long_double_complex") == 0)
4c016457 3169 *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
e655a6cc
TK		 3170
3171 ret = T_OK;
3172 }
3173 else
3174 {
3175 /* The user did not specify a C interop type. Let's look through
3176 the available table and use the first one, but warn. */
39f309ac 3177 for (int i = 0; i < ISOCBINDING_NUMBER; i++)
e655a6cc
TK		 3178 {
3179 if (c_interop_kinds_table[i].f90_type == ts->type
3180 && c_interop_kinds_table[i].value == ts->kind)
3181 {
3182 *type_name = c_interop_kinds_table[i].name + 2;
3183 if (strcmp (*type_name, "signed_char") == 0)
3184 *type_name = "signed char";
3185 else if (strcmp (*type_name, "size_t") == 0)
3186 *type_name = "ssize_t";
6328ce1f 3187 else if (strcmp (*type_name, "float_complex") == 0)
4c016457 3188 *type_name = "__GFORTRAN_FLOAT_COMPLEX";
6328ce1f 3189 else if (strcmp (*type_name, "double_complex") == 0)
4c016457 3190 *type_name = "__GFORTRAN_DOUBLE_COMPLEX";
6328ce1f 3191 else if (strcmp (*type_name, "long_double_complex") == 0)
4c016457 3192 *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
e655a6cc
TK		 3193
3194 ret = T_WARN;
3195 break;
3196 }
3197 }
3198 }
3199 }
39f309ac
TK		 3200 else if (ts->type == BT_LOGICAL)
3201 {
3202 if (ts->is_c_interop && ts->interop_kind)
3203 {
3204 *type_name = "_Bool";
3205 ret = T_OK;
3206 }
3207 else
3208 {
3209 /* Let's select an appropriate int, with a warning. */
3210 for (int i = 0; i < ISOCBINDING_NUMBER; i++)
3211 {
3212 if (c_interop_kinds_table[i].f90_type == BT_INTEGER
3213 && c_interop_kinds_table[i].value == ts->kind)
3214 {
3215 *type_name = c_interop_kinds_table[i].name + 2;
3216 ret = T_WARN;
3217 }
3218 }
3219 }
3220 }
3221 else if (ts->type == BT_CHARACTER)
3222 {
3223 if (ts->is_c_interop)
3224 {
3225 *type_name = "char";
3226 ret = T_OK;
3227 }
3228 else
3229 {
6328ce1f
TK		 3230 if (ts->kind == gfc_default_character_kind)
3231 *type_name = "char";
3232 else
3233 /* Let's select an appropriate int. */
3234 for (int i = 0; i < ISOCBINDING_NUMBER; i++)
3235 {
3236 if (c_interop_kinds_table[i].f90_type == BT_INTEGER
3237 && c_interop_kinds_table[i].value == ts->kind)
3238 {
3239 *type_name = c_interop_kinds_table[i].name + 2;
3240 break;
3241 }
39f309ac 3242 }
6328ce1f
TK		 3243 ret = T_WARN;
3244
39f309ac
TK		 3245 }
3246 }
e655a6cc
TK		 3247 else if (ts->type == BT_DERIVED)
3248 {
3249 if (ts->u.derived->from_intmod == INTMOD_ISO_C_BINDING)
3250 {
3251 if (strcmp (ts->u.derived->name, "c_ptr") == 0)
3252 *type_name = "void";
3253 else if (strcmp (ts->u.derived->name, "c_funptr") == 0)
3254 {
3255 *type_name = "int ";
3256 if (func_ret)
3257 {
3258 *pre = "(";
3259 *post = "())";
3260 }
3261 else
3262 {
3263 *pre = "(";
3264 *post = ")()";
3265 }
3266 }
3267 *asterisk = true;
6328ce1f 3268 ret = T_OK;
e655a6cc
TK		 3269 }
3270 else
3271 *type_name = ts->u.derived->name;
3272
3273 ret = T_OK;
3274 }
6328ce1f 3275
e655a6cc
TK		 3276 if (ret != T_ERROR && as)
3277 {
3278 mpz_t sz;
3279 bool size_ok;
3280 size_ok = spec_size (as, &sz);
3281 gcc_assert (size_ok == true);
3282 gmp_snprintf (post_buffer, sizeof(post_buffer), "[%Zd]", sz);
3283 *post = post_buffer;
3284 mpz_clear (sz);
3285 }
3286 return ret;
3287}
3288
3289/* Write out a declaration. */
3290static void
3291write_decl (gfc_typespec *ts, gfc_array_spec *as, const char *sym_name,
6328ce1f 3292 bool func_ret, locus *where, bool bind_c)
e655a6cc 3293{
39f309ac
TK		 3294 const char *pre, *type_name, *post;
3295 bool asterisk;
3296 enum type_return rok;
3297
3298 rok = get_c_type_name (ts, as, &pre, &type_name, &asterisk, &post, func_ret);
3299 if (rok == T_ERROR)
3300 {
3301 gfc_error_now ("Cannot convert %qs to interoperable type at %L",
3302 gfc_typename (ts), where);
3303 fprintf (dumpfile, "/* Cannot convert '%s' to interoperable type */",
3304 gfc_typename (ts));
3305 return;
3306 }
3307 fputs (type_name, dumpfile);
3308 fputs (pre, dumpfile);
3309 if (asterisk)
3310 fputs ("*", dumpfile);
3311
3312 fputs (sym_name, dumpfile);
3313 fputs (post, dumpfile);
a5fbc2f3 3314
6328ce1f 3315 if (rok == T_WARN && bind_c)
39f309ac
TK		 3316 fprintf (dumpfile," /* WARNING: Converting '%s' to interoperable type */",
3317 gfc_typename (ts));
e655a6cc
TK		 3318}
3319
3320/* Write out an interoperable type. It will be written as a typedef
3321 for a struct. */
3322
3323static void
3324write_type (gfc_symbol *sym)
3325{
3326 gfc_component *c;
3327
3328 fprintf (dumpfile, "typedef struct %s {\n", sym->name);
3329 for (c = sym->components; c; c = c->next)
3330 {
3331 fputs (" ", dumpfile);
6328ce1f 3332 write_decl (&(c->ts), c->as, c->name, false, &sym->declared_at, true);
e655a6cc
TK		 3333 fputs (";\n", dumpfile);
3334 }
3335
3336 fprintf (dumpfile, "} %s;\n", sym->name);
3337}
3338
3339/* Write out a variable. */
3340
3341static void
3342write_variable (gfc_symbol *sym)
3343{
3344 const char *sym_name;
3345
3346 gcc_assert (sym->attr.flavor == FL_VARIABLE);
3347
3348 if (sym->binding_label)
3349 sym_name = sym->binding_label;
3350 else
3351 sym_name = sym->name;
3352
3353 fputs ("extern ", dumpfile);
6328ce1f 3354 write_decl (&(sym->ts), sym->as, sym_name, false, &sym->declared_at, true);
e655a6cc
TK		 3355 fputs (";\n", dumpfile);
3356}
3357
3358
3359/* Write out a procedure, including its arguments. */
3360static void
6328ce1f 3361write_proc (gfc_symbol *sym, bool bind_c)
e655a6cc
TK		 3362{
3363 const char *pre, *type_name, *post;
3364 bool asterisk;
3365 enum type_return rok;
3366 gfc_formal_arglist *f;
3367 const char *sym_name;
3368 const char *intent_in;
6328ce1f
TK		 3369 bool external_character;
3370
3371 external_character = sym->ts.type == BT_CHARACTER && !bind_c;
e655a6cc
TK		 3372
3373 if (sym->binding_label)
3374 sym_name = sym->binding_label;
3375 else
3376 sym_name = sym->name;
3377
6328ce1f 3378 if (sym->ts.type == BT_UNKNOWN || external_character)
e655a6cc
TK		 3379 {
3380 fprintf (dumpfile, "void ");
3381 fputs (sym_name, dumpfile);
3382 }
3383 else
6328ce1f 3384 write_decl (&(sym->ts), sym->as, sym_name, true, &sym->declared_at, bind_c);
e655a6cc 3385
6328ce1f
TK		 3386 if (!bind_c)
3387 fputs ("_", dumpfile);
e655a6cc 3388
6328ce1f
TK		 3389 fputs (" (", dumpfile);
3390 if (external_character)
3391 {
3392 fprintf (dumpfile, "char *result_%s, size_t result_%s_len",
3393 sym_name, sym_name);
3394 if (sym->formal)
3395 fputs (", ", dumpfile);
3396 }
3397
e655a6cc
TK		 3398 for (f = sym->formal; f; f = f->next)
3399 {
3400 gfc_symbol *s;
3401 s = f->sym;
3402 rok = get_c_type_name (&(s->ts), NULL, &pre, &type_name, &asterisk,
3403 &post, false);
39f309ac
TK		 3404 if (rok == T_ERROR)
3405 {
3406 gfc_error_now ("Cannot convert %qs to interoperable type at %L",
3407 gfc_typename (&s->ts), &s->declared_at);
6328ce1f 3408 fprintf (dumpfile, "/* Cannot convert '%s' to interoperable type */",
39f309ac
TK		 3409 gfc_typename (&s->ts));
3410 return;
3411 }
e655a6cc
TK		 3412
3413 if (!s->attr.value)
3414 asterisk = true;
3415
3416 if (s->attr.intent == INTENT_IN && !s->attr.value)
3417 intent_in = "const ";
3418 else
3419 intent_in = "";
3420
3421 fputs (intent_in, dumpfile);
3422 fputs (type_name, dumpfile);
3423 fputs (pre, dumpfile);
3424 if (asterisk)
3425 fputs ("*", dumpfile);
3426
3427 fputs (s->name, dumpfile);
3428 fputs (post, dumpfile);
6328ce1f 3429 if (bind_c && rok == T_WARN)
e655a6cc
TK		 3430 fputs(" /* WARNING: non-interoperable KIND */ ", dumpfile);
3431
700b62cc
TK		 3432 if (f->next)
3433 fputs(", ", dumpfile);
e655a6cc 3434 }
6328ce1f
TK		 3435 if (!bind_c)
3436 for (f = sym->formal; f; f = f->next)
3437 if (f->sym->ts.type == BT_CHARACTER)
3438 fprintf (dumpfile, ", size_t %s_len", f->sym->name);
3439
700b62cc 3440 fputs (");\n", dumpfile);
e655a6cc
TK		 3441}
3442
3443
3444/* Write a C-interoperable declaration as a C prototype or extern
3445 declaration. */
3446
3447static void
3448write_interop_decl (gfc_symbol *sym)
3449{
3450 /* Only dump bind(c) entities. */
3451 if (!sym->attr.is_bind_c)
3452 return;
3453
3454 /* Don't dump our iso c module. */
3455 if (sym->from_intmod == INTMOD_ISO_C_BINDING)
3456 return;
3457
3458 if (sym->attr.flavor == FL_VARIABLE)
3459 write_variable (sym);
3460 else if (sym->attr.flavor == FL_DERIVED)
3461 write_type (sym);
3462 else if (sym->attr.flavor == FL_PROCEDURE)
6328ce1f 3463 write_proc (sym, true);
e655a6cc 3464}
Mirror of https://gcc.gnu.org/git/gcc.git