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