]>
Commit | Line | Data |
---|---|---|
6de9cd9a | 1 | /* Parse tree dumper |
23a5b65a | 2 | Copyright (C) 2003-2014 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 FXC |
1018 | static void |
1019 | show_namelist (gfc_namelist *n) | |
6c7a4dfd JJ |
1020 | { |
1021 | for (; n->next; n = n->next) | |
6c1abb5c FXC |
1022 | fprintf (dumpfile, "%s,", n->sym->name); |
1023 | fprintf (dumpfile, "%s", n->sym->name); | |
6c7a4dfd JJ |
1024 | } |
1025 | ||
1026 | /* Show a single OpenMP directive node and everything underneath it | |
1027 | if necessary. */ | |
1028 | ||
1029 | static void | |
6c1abb5c | 1030 | show_omp_node (int level, gfc_code *c) |
6c7a4dfd JJ |
1031 | { |
1032 | gfc_omp_clauses *omp_clauses = NULL; | |
1033 | const char *name = NULL; | |
1034 | ||
1035 | switch (c->op) | |
1036 | { | |
1037 | case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; | |
1038 | case EXEC_OMP_BARRIER: name = "BARRIER"; break; | |
1039 | case EXEC_OMP_CRITICAL: name = "CRITICAL"; break; | |
1040 | case EXEC_OMP_FLUSH: name = "FLUSH"; break; | |
1041 | case EXEC_OMP_DO: name = "DO"; break; | |
1042 | case EXEC_OMP_MASTER: name = "MASTER"; break; | |
1043 | case EXEC_OMP_ORDERED: name = "ORDERED"; break; | |
1044 | case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; | |
1045 | case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break; | |
1046 | case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break; | |
1047 | case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; | |
1048 | case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; | |
1049 | case EXEC_OMP_SINGLE: name = "SINGLE"; break; | |
a68ab351 JJ |
1050 | case EXEC_OMP_TASK: name = "TASK"; break; |
1051 | case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; | |
20906c66 | 1052 | case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; |
6c7a4dfd JJ |
1053 | case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; |
1054 | default: | |
1055 | gcc_unreachable (); | |
1056 | } | |
6c1abb5c | 1057 | fprintf (dumpfile, "!$OMP %s", name); |
6c7a4dfd JJ |
1058 | switch (c->op) |
1059 | { | |
1060 | case EXEC_OMP_DO: | |
1061 | case EXEC_OMP_PARALLEL: | |
1062 | case EXEC_OMP_PARALLEL_DO: | |
1063 | case EXEC_OMP_PARALLEL_SECTIONS: | |
1064 | case EXEC_OMP_SECTIONS: | |
1065 | case EXEC_OMP_SINGLE: | |
1066 | case EXEC_OMP_WORKSHARE: | |
1067 | case EXEC_OMP_PARALLEL_WORKSHARE: | |
a68ab351 | 1068 | case EXEC_OMP_TASK: |
6c7a4dfd JJ |
1069 | omp_clauses = c->ext.omp_clauses; |
1070 | break; | |
1071 | case EXEC_OMP_CRITICAL: | |
1072 | if (c->ext.omp_name) | |
6c1abb5c | 1073 | fprintf (dumpfile, " (%s)", c->ext.omp_name); |
6c7a4dfd JJ |
1074 | break; |
1075 | case EXEC_OMP_FLUSH: | |
1076 | if (c->ext.omp_namelist) | |
1077 | { | |
6c1abb5c FXC |
1078 | fputs (" (", dumpfile); |
1079 | show_namelist (c->ext.omp_namelist); | |
1080 | fputc (')', dumpfile); | |
6c7a4dfd JJ |
1081 | } |
1082 | return; | |
1083 | case EXEC_OMP_BARRIER: | |
a68ab351 | 1084 | case EXEC_OMP_TASKWAIT: |
20906c66 | 1085 | case EXEC_OMP_TASKYIELD: |
6c7a4dfd JJ |
1086 | return; |
1087 | default: | |
1088 | break; | |
1089 | } | |
1090 | if (omp_clauses) | |
1091 | { | |
1092 | int list_type; | |
1093 | ||
1094 | if (omp_clauses->if_expr) | |
1095 | { | |
6c1abb5c FXC |
1096 | fputs (" IF(", dumpfile); |
1097 | show_expr (omp_clauses->if_expr); | |
1098 | fputc (')', dumpfile); | |
6c7a4dfd | 1099 | } |
20906c66 JJ |
1100 | if (omp_clauses->final_expr) |
1101 | { | |
1102 | fputs (" FINAL(", dumpfile); | |
1103 | show_expr (omp_clauses->final_expr); | |
1104 | fputc (')', dumpfile); | |
1105 | } | |
6c7a4dfd JJ |
1106 | if (omp_clauses->num_threads) |
1107 | { | |
6c1abb5c FXC |
1108 | fputs (" NUM_THREADS(", dumpfile); |
1109 | show_expr (omp_clauses->num_threads); | |
1110 | fputc (')', dumpfile); | |
6c7a4dfd JJ |
1111 | } |
1112 | if (omp_clauses->sched_kind != OMP_SCHED_NONE) | |
1113 | { | |
1114 | const char *type; | |
1115 | switch (omp_clauses->sched_kind) | |
1116 | { | |
1117 | case OMP_SCHED_STATIC: type = "STATIC"; break; | |
1118 | case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break; | |
1119 | case OMP_SCHED_GUIDED: type = "GUIDED"; break; | |
1120 | case OMP_SCHED_RUNTIME: type = "RUNTIME"; break; | |
a68ab351 | 1121 | case OMP_SCHED_AUTO: type = "AUTO"; break; |
6c7a4dfd JJ |
1122 | default: |
1123 | gcc_unreachable (); | |
1124 | } | |
6c1abb5c | 1125 | fprintf (dumpfile, " SCHEDULE (%s", type); |
6c7a4dfd JJ |
1126 | if (omp_clauses->chunk_size) |
1127 | { | |
6c1abb5c FXC |
1128 | fputc (',', dumpfile); |
1129 | show_expr (omp_clauses->chunk_size); | |
6c7a4dfd | 1130 | } |
6c1abb5c | 1131 | fputc (')', dumpfile); |
6c7a4dfd JJ |
1132 | } |
1133 | if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN) | |
1134 | { | |
1135 | const char *type; | |
1136 | switch (omp_clauses->default_sharing) | |
1137 | { | |
1138 | case OMP_DEFAULT_NONE: type = "NONE"; break; | |
1139 | case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break; | |
1140 | case OMP_DEFAULT_SHARED: type = "SHARED"; break; | |
a68ab351 | 1141 | case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; |
6c7a4dfd JJ |
1142 | default: |
1143 | gcc_unreachable (); | |
1144 | } | |
6c1abb5c | 1145 | fprintf (dumpfile, " DEFAULT(%s)", type); |
6c7a4dfd JJ |
1146 | } |
1147 | if (omp_clauses->ordered) | |
6c1abb5c | 1148 | fputs (" ORDERED", dumpfile); |
a68ab351 JJ |
1149 | if (omp_clauses->untied) |
1150 | fputs (" UNTIED", dumpfile); | |
20906c66 JJ |
1151 | if (omp_clauses->mergeable) |
1152 | fputs (" MERGEABLE", dumpfile); | |
a68ab351 JJ |
1153 | if (omp_clauses->collapse) |
1154 | fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse); | |
6c7a4dfd JJ |
1155 | for (list_type = 0; list_type < OMP_LIST_NUM; list_type++) |
1156 | if (omp_clauses->lists[list_type] != NULL | |
1157 | && list_type != OMP_LIST_COPYPRIVATE) | |
1158 | { | |
1159 | const char *type; | |
1160 | if (list_type >= OMP_LIST_REDUCTION_FIRST) | |
1161 | { | |
1162 | switch (list_type) | |
1163 | { | |
1164 | case OMP_LIST_PLUS: type = "+"; break; | |
1165 | case OMP_LIST_MULT: type = "*"; break; | |
1166 | case OMP_LIST_SUB: type = "-"; break; | |
1167 | case OMP_LIST_AND: type = ".AND."; break; | |
1168 | case OMP_LIST_OR: type = ".OR."; break; | |
1169 | case OMP_LIST_EQV: type = ".EQV."; break; | |
1170 | case OMP_LIST_NEQV: type = ".NEQV."; break; | |
1171 | case OMP_LIST_MAX: type = "MAX"; break; | |
1172 | case OMP_LIST_MIN: type = "MIN"; break; | |
1173 | case OMP_LIST_IAND: type = "IAND"; break; | |
1174 | case OMP_LIST_IOR: type = "IOR"; break; | |
1175 | case OMP_LIST_IEOR: type = "IEOR"; break; | |
1176 | default: | |
1177 | gcc_unreachable (); | |
1178 | } | |
6c1abb5c | 1179 | fprintf (dumpfile, " REDUCTION(%s:", type); |
6c7a4dfd JJ |
1180 | } |
1181 | else | |
1182 | { | |
1183 | switch (list_type) | |
1184 | { | |
1185 | case OMP_LIST_PRIVATE: type = "PRIVATE"; break; | |
1186 | case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; | |
1187 | case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break; | |
1188 | case OMP_LIST_SHARED: type = "SHARED"; break; | |
1189 | case OMP_LIST_COPYIN: type = "COPYIN"; break; | |
1190 | default: | |
1191 | gcc_unreachable (); | |
1192 | } | |
6c1abb5c | 1193 | fprintf (dumpfile, " %s(", type); |
6c7a4dfd | 1194 | } |
6c1abb5c FXC |
1195 | show_namelist (omp_clauses->lists[list_type]); |
1196 | fputc (')', dumpfile); | |
6c7a4dfd JJ |
1197 | } |
1198 | } | |
6c1abb5c | 1199 | fputc ('\n', dumpfile); |
6c7a4dfd JJ |
1200 | if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) |
1201 | { | |
1202 | gfc_code *d = c->block; | |
1203 | while (d != NULL) | |
1204 | { | |
6c1abb5c | 1205 | show_code (level + 1, d->next); |
6c7a4dfd JJ |
1206 | if (d->block == NULL) |
1207 | break; | |
1208 | code_indent (level, 0); | |
6c1abb5c | 1209 | fputs ("!$OMP SECTION\n", dumpfile); |
6c7a4dfd JJ |
1210 | d = d->block; |
1211 | } | |
1212 | } | |
1213 | else | |
6c1abb5c | 1214 | show_code (level + 1, c->block->next); |
6c7a4dfd JJ |
1215 | if (c->op == EXEC_OMP_ATOMIC) |
1216 | return; | |
1217 | code_indent (level, 0); | |
6c1abb5c | 1218 | fprintf (dumpfile, "!$OMP END %s", name); |
6c7a4dfd JJ |
1219 | if (omp_clauses != NULL) |
1220 | { | |
1221 | if (omp_clauses->lists[OMP_LIST_COPYPRIVATE]) | |
1222 | { | |
6c1abb5c FXC |
1223 | fputs (" COPYPRIVATE(", dumpfile); |
1224 | show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); | |
1225 | fputc (')', dumpfile); | |
6c7a4dfd JJ |
1226 | } |
1227 | else if (omp_clauses->nowait) | |
6c1abb5c | 1228 | fputs (" NOWAIT", dumpfile); |
6c7a4dfd JJ |
1229 | } |
1230 | else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name) | |
6c1abb5c | 1231 | fprintf (dumpfile, " (%s)", c->ext.omp_name); |
6c7a4dfd | 1232 | } |
6de9cd9a | 1233 | |
636dff67 | 1234 | |
6de9cd9a DN |
1235 | /* Show a single code node and everything underneath it if necessary. */ |
1236 | ||
1237 | static void | |
6c1abb5c | 1238 | show_code_node (int level, gfc_code *c) |
6de9cd9a DN |
1239 | { |
1240 | gfc_forall_iterator *fa; | |
1241 | gfc_open *open; | |
1242 | gfc_case *cp; | |
1243 | gfc_alloc *a; | |
1244 | gfc_code *d; | |
1245 | gfc_close *close; | |
1246 | gfc_filepos *fp; | |
1247 | gfc_inquire *i; | |
1248 | gfc_dt *dt; | |
c6c15a14 | 1249 | gfc_namespace *ns; |
6de9cd9a | 1250 | |
8cf8ca52 TK |
1251 | if (c->here) |
1252 | { | |
1253 | fputc ('\n', dumpfile); | |
1254 | code_indent (level, c->here); | |
1255 | } | |
1256 | else | |
1257 | show_indent (); | |
6de9cd9a DN |
1258 | |
1259 | switch (c->op) | |
1260 | { | |
5c71a5e0 TB |
1261 | case EXEC_END_PROCEDURE: |
1262 | break; | |
1263 | ||
6de9cd9a | 1264 | case EXEC_NOP: |
6c1abb5c | 1265 | fputs ("NOP", dumpfile); |
6de9cd9a DN |
1266 | break; |
1267 | ||
1268 | case EXEC_CONTINUE: | |
6c1abb5c | 1269 | fputs ("CONTINUE", dumpfile); |
6de9cd9a DN |
1270 | break; |
1271 | ||
3d79abbd | 1272 | case EXEC_ENTRY: |
6c1abb5c | 1273 | fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name); |
3d79abbd PB |
1274 | break; |
1275 | ||
6b591ec0 | 1276 | case EXEC_INIT_ASSIGN: |
6de9cd9a | 1277 | case EXEC_ASSIGN: |
6c1abb5c | 1278 | fputs ("ASSIGN ", dumpfile); |
a513927a | 1279 | show_expr (c->expr1); |
6c1abb5c FXC |
1280 | fputc (' ', dumpfile); |
1281 | show_expr (c->expr2); | |
6de9cd9a | 1282 | break; |
3d79abbd | 1283 | |
6de9cd9a | 1284 | case EXEC_LABEL_ASSIGN: |
6c1abb5c | 1285 | fputs ("LABEL ASSIGN ", dumpfile); |
a513927a | 1286 | show_expr (c->expr1); |
79bd1948 | 1287 | fprintf (dumpfile, " %d", c->label1->value); |
6de9cd9a DN |
1288 | break; |
1289 | ||
1290 | case EXEC_POINTER_ASSIGN: | |
6c1abb5c | 1291 | fputs ("POINTER ASSIGN ", dumpfile); |
a513927a | 1292 | show_expr (c->expr1); |
6c1abb5c FXC |
1293 | fputc (' ', dumpfile); |
1294 | show_expr (c->expr2); | |
6de9cd9a DN |
1295 | break; |
1296 | ||
1297 | case EXEC_GOTO: | |
6c1abb5c | 1298 | fputs ("GOTO ", dumpfile); |
79bd1948 SK |
1299 | if (c->label1) |
1300 | fprintf (dumpfile, "%d", c->label1->value); | |
6de9cd9a | 1301 | else |
636dff67 | 1302 | { |
a513927a | 1303 | show_expr (c->expr1); |
636dff67 SK |
1304 | d = c->block; |
1305 | if (d != NULL) | |
1306 | { | |
6c1abb5c | 1307 | fputs (", (", dumpfile); |
636dff67 SK |
1308 | for (; d; d = d ->block) |
1309 | { | |
79bd1948 | 1310 | code_indent (level, d->label1); |
636dff67 | 1311 | if (d->block != NULL) |
6c1abb5c | 1312 | fputc (',', dumpfile); |
636dff67 | 1313 | else |
6c1abb5c | 1314 | fputc (')', dumpfile); |
636dff67 SK |
1315 | } |
1316 | } | |
1317 | } | |
6de9cd9a DN |
1318 | break; |
1319 | ||
1320 | case EXEC_CALL: | |
aa84a9a5 | 1321 | case EXEC_ASSIGN_CALL: |
bfaacea7 | 1322 | if (c->resolved_sym) |
6c1abb5c | 1323 | fprintf (dumpfile, "CALL %s ", c->resolved_sym->name); |
bfaacea7 | 1324 | else if (c->symtree) |
6c1abb5c | 1325 | fprintf (dumpfile, "CALL %s ", c->symtree->name); |
bfaacea7 | 1326 | else |
6c1abb5c | 1327 | fputs ("CALL ?? ", dumpfile); |
bfaacea7 | 1328 | |
6c1abb5c | 1329 | show_actual_arglist (c->ext.actual); |
6de9cd9a DN |
1330 | break; |
1331 | ||
a64a8f2f DK |
1332 | case EXEC_COMPCALL: |
1333 | fputs ("CALL ", dumpfile); | |
a513927a | 1334 | show_compcall (c->expr1); |
a64a8f2f DK |
1335 | break; |
1336 | ||
713485cc JW |
1337 | case EXEC_CALL_PPC: |
1338 | fputs ("CALL ", dumpfile); | |
a513927a | 1339 | show_expr (c->expr1); |
713485cc JW |
1340 | show_actual_arglist (c->ext.actual); |
1341 | break; | |
1342 | ||
6de9cd9a | 1343 | case EXEC_RETURN: |
6c1abb5c | 1344 | fputs ("RETURN ", dumpfile); |
a513927a SK |
1345 | if (c->expr1) |
1346 | show_expr (c->expr1); | |
6de9cd9a DN |
1347 | break; |
1348 | ||
1349 | case EXEC_PAUSE: | |
6c1abb5c | 1350 | fputs ("PAUSE ", dumpfile); |
6de9cd9a | 1351 | |
a513927a SK |
1352 | if (c->expr1 != NULL) |
1353 | show_expr (c->expr1); | |
6de9cd9a | 1354 | else |
6c1abb5c | 1355 | fprintf (dumpfile, "%d", c->ext.stop_code); |
6de9cd9a DN |
1356 | |
1357 | break; | |
1358 | ||
d0a4a61c TB |
1359 | case EXEC_ERROR_STOP: |
1360 | fputs ("ERROR ", dumpfile); | |
1361 | /* Fall through. */ | |
1362 | ||
6de9cd9a | 1363 | case EXEC_STOP: |
6c1abb5c | 1364 | fputs ("STOP ", dumpfile); |
6de9cd9a | 1365 | |
a513927a SK |
1366 | if (c->expr1 != NULL) |
1367 | show_expr (c->expr1); | |
6de9cd9a | 1368 | else |
6c1abb5c | 1369 | fprintf (dumpfile, "%d", c->ext.stop_code); |
6de9cd9a DN |
1370 | |
1371 | break; | |
1372 | ||
d0a4a61c TB |
1373 | case EXEC_SYNC_ALL: |
1374 | fputs ("SYNC ALL ", dumpfile); | |
1375 | if (c->expr2 != NULL) | |
1376 | { | |
1377 | fputs (" stat=", dumpfile); | |
1378 | show_expr (c->expr2); | |
1379 | } | |
1380 | if (c->expr3 != NULL) | |
1381 | { | |
1382 | fputs (" errmsg=", dumpfile); | |
1383 | show_expr (c->expr3); | |
1384 | } | |
1385 | break; | |
1386 | ||
1387 | case EXEC_SYNC_MEMORY: | |
1388 | fputs ("SYNC MEMORY ", dumpfile); | |
1389 | if (c->expr2 != NULL) | |
1390 | { | |
1391 | fputs (" stat=", dumpfile); | |
1392 | show_expr (c->expr2); | |
1393 | } | |
1394 | if (c->expr3 != NULL) | |
1395 | { | |
1396 | fputs (" errmsg=", dumpfile); | |
1397 | show_expr (c->expr3); | |
1398 | } | |
1399 | break; | |
1400 | ||
1401 | case EXEC_SYNC_IMAGES: | |
1402 | fputs ("SYNC IMAGES image-set=", dumpfile); | |
1403 | if (c->expr1 != NULL) | |
1404 | show_expr (c->expr1); | |
1405 | else | |
1406 | fputs ("* ", dumpfile); | |
1407 | if (c->expr2 != NULL) | |
1408 | { | |
1409 | fputs (" stat=", dumpfile); | |
1410 | show_expr (c->expr2); | |
1411 | } | |
1412 | if (c->expr3 != NULL) | |
1413 | { | |
1414 | fputs (" errmsg=", dumpfile); | |
1415 | show_expr (c->expr3); | |
1416 | } | |
1417 | break; | |
1418 | ||
5493aa17 TB |
1419 | case EXEC_LOCK: |
1420 | case EXEC_UNLOCK: | |
1421 | if (c->op == EXEC_LOCK) | |
1422 | fputs ("LOCK ", dumpfile); | |
1423 | else | |
1424 | fputs ("UNLOCK ", dumpfile); | |
1425 | ||
1426 | fputs ("lock-variable=", dumpfile); | |
1427 | if (c->expr1 != NULL) | |
1428 | show_expr (c->expr1); | |
1429 | if (c->expr4 != NULL) | |
1430 | { | |
1431 | fputs (" acquired_lock=", dumpfile); | |
1432 | show_expr (c->expr4); | |
1433 | } | |
1434 | if (c->expr2 != NULL) | |
1435 | { | |
1436 | fputs (" stat=", dumpfile); | |
1437 | show_expr (c->expr2); | |
1438 | } | |
1439 | if (c->expr3 != NULL) | |
1440 | { | |
1441 | fputs (" errmsg=", dumpfile); | |
1442 | show_expr (c->expr3); | |
1443 | } | |
1444 | break; | |
1445 | ||
6de9cd9a | 1446 | case EXEC_ARITHMETIC_IF: |
6c1abb5c | 1447 | fputs ("IF ", dumpfile); |
a513927a | 1448 | show_expr (c->expr1); |
6c1abb5c | 1449 | fprintf (dumpfile, " %d, %d, %d", |
79bd1948 | 1450 | c->label1->value, c->label2->value, c->label3->value); |
6de9cd9a DN |
1451 | break; |
1452 | ||
1453 | case EXEC_IF: | |
1454 | d = c->block; | |
6c1abb5c | 1455 | fputs ("IF ", dumpfile); |
a513927a | 1456 | show_expr (d->expr1); |
8cf8ca52 TK |
1457 | |
1458 | ++show_level; | |
6c1abb5c | 1459 | show_code (level + 1, d->next); |
8cf8ca52 | 1460 | --show_level; |
6de9cd9a DN |
1461 | |
1462 | d = d->block; | |
1463 | for (; d; d = d->block) | |
1464 | { | |
1465 | code_indent (level, 0); | |
1466 | ||
a513927a | 1467 | if (d->expr1 == NULL) |
8cf8ca52 | 1468 | fputs ("ELSE", dumpfile); |
6de9cd9a DN |
1469 | else |
1470 | { | |
6c1abb5c | 1471 | fputs ("ELSE IF ", dumpfile); |
a513927a | 1472 | show_expr (d->expr1); |
6de9cd9a DN |
1473 | } |
1474 | ||
8cf8ca52 | 1475 | ++show_level; |
6c1abb5c | 1476 | show_code (level + 1, d->next); |
8cf8ca52 | 1477 | --show_level; |
6de9cd9a DN |
1478 | } |
1479 | ||
8cf8ca52 TK |
1480 | if (c->label1) |
1481 | code_indent (level, c->label1); | |
1482 | else | |
1483 | show_indent (); | |
6de9cd9a | 1484 | |
6c1abb5c | 1485 | fputs ("ENDIF", dumpfile); |
6de9cd9a DN |
1486 | break; |
1487 | ||
c6c15a14 | 1488 | case EXEC_BLOCK: |
7ed979b9 DK |
1489 | { |
1490 | const char* blocktype; | |
03cf9837 TK |
1491 | gfc_namespace *saved_ns; |
1492 | ||
7ed979b9 DK |
1493 | if (c->ext.block.assoc) |
1494 | blocktype = "ASSOCIATE"; | |
1495 | else | |
1496 | blocktype = "BLOCK"; | |
1497 | show_indent (); | |
1498 | fprintf (dumpfile, "%s ", blocktype); | |
8cf8ca52 | 1499 | ++show_level; |
7ed979b9 | 1500 | ns = c->ext.block.ns; |
03cf9837 TK |
1501 | saved_ns = gfc_current_ns; |
1502 | gfc_current_ns = ns; | |
8cf8ca52 | 1503 | gfc_traverse_symtree (ns->sym_root, show_symtree); |
03cf9837 | 1504 | gfc_current_ns = saved_ns; |
8cf8ca52 TK |
1505 | show_code (show_level, ns->code); |
1506 | --show_level; | |
7ed979b9 DK |
1507 | show_indent (); |
1508 | fprintf (dumpfile, "END %s ", blocktype); | |
1509 | break; | |
1510 | } | |
c6c15a14 | 1511 | |
6de9cd9a DN |
1512 | case EXEC_SELECT: |
1513 | d = c->block; | |
6c1abb5c | 1514 | fputs ("SELECT CASE ", dumpfile); |
a513927a | 1515 | show_expr (c->expr1); |
6c1abb5c | 1516 | fputc ('\n', dumpfile); |
6de9cd9a DN |
1517 | |
1518 | for (; d; d = d->block) | |
1519 | { | |
1520 | code_indent (level, 0); | |
1521 | ||
6c1abb5c | 1522 | fputs ("CASE ", dumpfile); |
29a63d67 | 1523 | for (cp = d->ext.block.case_list; cp; cp = cp->next) |
6de9cd9a | 1524 | { |
6c1abb5c FXC |
1525 | fputc ('(', dumpfile); |
1526 | show_expr (cp->low); | |
1527 | fputc (' ', dumpfile); | |
1528 | show_expr (cp->high); | |
1529 | fputc (')', dumpfile); | |
1530 | fputc (' ', dumpfile); | |
6de9cd9a | 1531 | } |
6c1abb5c | 1532 | fputc ('\n', dumpfile); |
6de9cd9a | 1533 | |
6c1abb5c | 1534 | show_code (level + 1, d->next); |
6de9cd9a DN |
1535 | } |
1536 | ||
79bd1948 | 1537 | code_indent (level, c->label1); |
6c1abb5c | 1538 | fputs ("END SELECT", dumpfile); |
6de9cd9a DN |
1539 | break; |
1540 | ||
1541 | case EXEC_WHERE: | |
6c1abb5c | 1542 | fputs ("WHERE ", dumpfile); |
6de9cd9a DN |
1543 | |
1544 | d = c->block; | |
a513927a | 1545 | show_expr (d->expr1); |
6c1abb5c | 1546 | fputc ('\n', dumpfile); |
6de9cd9a | 1547 | |
6c1abb5c | 1548 | show_code (level + 1, d->next); |
6de9cd9a DN |
1549 | |
1550 | for (d = d->block; d; d = d->block) | |
1551 | { | |
1552 | code_indent (level, 0); | |
6c1abb5c | 1553 | fputs ("ELSE WHERE ", dumpfile); |
a513927a | 1554 | show_expr (d->expr1); |
6c1abb5c FXC |
1555 | fputc ('\n', dumpfile); |
1556 | show_code (level + 1, d->next); | |
6de9cd9a DN |
1557 | } |
1558 | ||
1559 | code_indent (level, 0); | |
6c1abb5c | 1560 | fputs ("END WHERE", dumpfile); |
6de9cd9a DN |
1561 | break; |
1562 | ||
1563 | ||
1564 | case EXEC_FORALL: | |
6c1abb5c | 1565 | fputs ("FORALL ", dumpfile); |
6de9cd9a DN |
1566 | for (fa = c->ext.forall_iterator; fa; fa = fa->next) |
1567 | { | |
6c1abb5c FXC |
1568 | show_expr (fa->var); |
1569 | fputc (' ', dumpfile); | |
1570 | show_expr (fa->start); | |
1571 | fputc (':', dumpfile); | |
1572 | show_expr (fa->end); | |
1573 | fputc (':', dumpfile); | |
1574 | show_expr (fa->stride); | |
6de9cd9a DN |
1575 | |
1576 | if (fa->next != NULL) | |
6c1abb5c | 1577 | fputc (',', dumpfile); |
6de9cd9a DN |
1578 | } |
1579 | ||
a513927a | 1580 | if (c->expr1 != NULL) |
6de9cd9a | 1581 | { |
6c1abb5c | 1582 | fputc (',', dumpfile); |
a513927a | 1583 | show_expr (c->expr1); |
6de9cd9a | 1584 | } |
6c1abb5c | 1585 | fputc ('\n', dumpfile); |
6de9cd9a | 1586 | |
6c1abb5c | 1587 | show_code (level + 1, c->block->next); |
6de9cd9a DN |
1588 | |
1589 | code_indent (level, 0); | |
6c1abb5c | 1590 | fputs ("END FORALL", dumpfile); |
6de9cd9a DN |
1591 | break; |
1592 | ||
d0a4a61c TB |
1593 | case EXEC_CRITICAL: |
1594 | fputs ("CRITICAL\n", dumpfile); | |
1595 | show_code (level + 1, c->block->next); | |
1596 | code_indent (level, 0); | |
1597 | fputs ("END CRITICAL", dumpfile); | |
1598 | break; | |
1599 | ||
6de9cd9a | 1600 | case EXEC_DO: |
6c1abb5c | 1601 | fputs ("DO ", dumpfile); |
8cf8ca52 TK |
1602 | if (c->label1) |
1603 | fprintf (dumpfile, " %-5d ", c->label1->value); | |
6de9cd9a | 1604 | |
6c1abb5c FXC |
1605 | show_expr (c->ext.iterator->var); |
1606 | fputc ('=', dumpfile); | |
1607 | show_expr (c->ext.iterator->start); | |
1608 | fputc (' ', dumpfile); | |
1609 | show_expr (c->ext.iterator->end); | |
1610 | fputc (' ', dumpfile); | |
1611 | show_expr (c->ext.iterator->step); | |
6de9cd9a | 1612 | |
8cf8ca52 | 1613 | ++show_level; |
6c1abb5c | 1614 | show_code (level + 1, c->block->next); |
8cf8ca52 | 1615 | --show_level; |
6de9cd9a | 1616 | |
8cf8ca52 TK |
1617 | if (c->label1) |
1618 | break; | |
1619 | ||
1620 | show_indent (); | |
6c1abb5c | 1621 | fputs ("END DO", dumpfile); |
6de9cd9a DN |
1622 | break; |
1623 | ||
8c6a85e3 TB |
1624 | case EXEC_DO_CONCURRENT: |
1625 | fputs ("DO CONCURRENT ", dumpfile); | |
1626 | for (fa = c->ext.forall_iterator; fa; fa = fa->next) | |
1627 | { | |
1628 | show_expr (fa->var); | |
1629 | fputc (' ', dumpfile); | |
1630 | show_expr (fa->start); | |
1631 | fputc (':', dumpfile); | |
1632 | show_expr (fa->end); | |
1633 | fputc (':', dumpfile); | |
1634 | show_expr (fa->stride); | |
1635 | ||
1636 | if (fa->next != NULL) | |
1637 | fputc (',', dumpfile); | |
1638 | } | |
1639 | show_expr (c->expr1); | |
1640 | ||
1641 | show_code (level + 1, c->block->next); | |
1642 | code_indent (level, c->label1); | |
1643 | fputs ("END DO", dumpfile); | |
1644 | break; | |
1645 | ||
6de9cd9a | 1646 | case EXEC_DO_WHILE: |
6c1abb5c | 1647 | fputs ("DO WHILE ", dumpfile); |
a513927a | 1648 | show_expr (c->expr1); |
6c1abb5c | 1649 | fputc ('\n', dumpfile); |
6de9cd9a | 1650 | |
6c1abb5c | 1651 | show_code (level + 1, c->block->next); |
6de9cd9a | 1652 | |
79bd1948 | 1653 | code_indent (level, c->label1); |
6c1abb5c | 1654 | fputs ("END DO", dumpfile); |
6de9cd9a DN |
1655 | break; |
1656 | ||
1657 | case EXEC_CYCLE: | |
6c1abb5c | 1658 | fputs ("CYCLE", dumpfile); |
6de9cd9a | 1659 | if (c->symtree) |
6c1abb5c | 1660 | fprintf (dumpfile, " %s", c->symtree->n.sym->name); |
6de9cd9a DN |
1661 | break; |
1662 | ||
1663 | case EXEC_EXIT: | |
6c1abb5c | 1664 | fputs ("EXIT", dumpfile); |
6de9cd9a | 1665 | if (c->symtree) |
6c1abb5c | 1666 | fprintf (dumpfile, " %s", c->symtree->n.sym->name); |
6de9cd9a DN |
1667 | break; |
1668 | ||
1669 | case EXEC_ALLOCATE: | |
6c1abb5c | 1670 | fputs ("ALLOCATE ", dumpfile); |
a513927a | 1671 | if (c->expr1) |
6de9cd9a | 1672 | { |
6c1abb5c | 1673 | fputs (" STAT=", dumpfile); |
a513927a | 1674 | show_expr (c->expr1); |
6de9cd9a DN |
1675 | } |
1676 | ||
0511ddbb SK |
1677 | if (c->expr2) |
1678 | { | |
1679 | fputs (" ERRMSG=", dumpfile); | |
1680 | show_expr (c->expr2); | |
1681 | } | |
1682 | ||
fabb6f8e PT |
1683 | if (c->expr3) |
1684 | { | |
1685 | if (c->expr3->mold) | |
1686 | fputs (" MOLD=", dumpfile); | |
1687 | else | |
1688 | fputs (" SOURCE=", dumpfile); | |
1689 | show_expr (c->expr3); | |
1690 | } | |
1691 | ||
cf2b3c22 | 1692 | for (a = c->ext.alloc.list; a; a = a->next) |
6de9cd9a | 1693 | { |
6c1abb5c FXC |
1694 | fputc (' ', dumpfile); |
1695 | show_expr (a->expr); | |
6de9cd9a DN |
1696 | } |
1697 | ||
1698 | break; | |
1699 | ||
1700 | case EXEC_DEALLOCATE: | |
6c1abb5c | 1701 | fputs ("DEALLOCATE ", dumpfile); |
a513927a | 1702 | if (c->expr1) |
6de9cd9a | 1703 | { |
6c1abb5c | 1704 | fputs (" STAT=", dumpfile); |
a513927a | 1705 | show_expr (c->expr1); |
6de9cd9a DN |
1706 | } |
1707 | ||
0511ddbb SK |
1708 | if (c->expr2) |
1709 | { | |
1710 | fputs (" ERRMSG=", dumpfile); | |
1711 | show_expr (c->expr2); | |
1712 | } | |
1713 | ||
cf2b3c22 | 1714 | for (a = c->ext.alloc.list; a; a = a->next) |
6de9cd9a | 1715 | { |
6c1abb5c FXC |
1716 | fputc (' ', dumpfile); |
1717 | show_expr (a->expr); | |
6de9cd9a DN |
1718 | } |
1719 | ||
1720 | break; | |
1721 | ||
1722 | case EXEC_OPEN: | |
6c1abb5c | 1723 | fputs ("OPEN", dumpfile); |
6de9cd9a DN |
1724 | open = c->ext.open; |
1725 | ||
1726 | if (open->unit) | |
1727 | { | |
6c1abb5c FXC |
1728 | fputs (" UNIT=", dumpfile); |
1729 | show_expr (open->unit); | |
6de9cd9a | 1730 | } |
7aba8abe TK |
1731 | if (open->iomsg) |
1732 | { | |
6c1abb5c FXC |
1733 | fputs (" IOMSG=", dumpfile); |
1734 | show_expr (open->iomsg); | |
7aba8abe | 1735 | } |
6de9cd9a DN |
1736 | if (open->iostat) |
1737 | { | |
6c1abb5c FXC |
1738 | fputs (" IOSTAT=", dumpfile); |
1739 | show_expr (open->iostat); | |
6de9cd9a DN |
1740 | } |
1741 | if (open->file) | |
1742 | { | |
6c1abb5c FXC |
1743 | fputs (" FILE=", dumpfile); |
1744 | show_expr (open->file); | |
6de9cd9a DN |
1745 | } |
1746 | if (open->status) | |
1747 | { | |
6c1abb5c FXC |
1748 | fputs (" STATUS=", dumpfile); |
1749 | show_expr (open->status); | |
6de9cd9a DN |
1750 | } |
1751 | if (open->access) | |
1752 | { | |
6c1abb5c FXC |
1753 | fputs (" ACCESS=", dumpfile); |
1754 | show_expr (open->access); | |
6de9cd9a DN |
1755 | } |
1756 | if (open->form) | |
1757 | { | |
6c1abb5c FXC |
1758 | fputs (" FORM=", dumpfile); |
1759 | show_expr (open->form); | |
6de9cd9a DN |
1760 | } |
1761 | if (open->recl) | |
1762 | { | |
6c1abb5c FXC |
1763 | fputs (" RECL=", dumpfile); |
1764 | show_expr (open->recl); | |
6de9cd9a DN |
1765 | } |
1766 | if (open->blank) | |
1767 | { | |
6c1abb5c FXC |
1768 | fputs (" BLANK=", dumpfile); |
1769 | show_expr (open->blank); | |
6de9cd9a DN |
1770 | } |
1771 | if (open->position) | |
1772 | { | |
6c1abb5c FXC |
1773 | fputs (" POSITION=", dumpfile); |
1774 | show_expr (open->position); | |
6de9cd9a DN |
1775 | } |
1776 | if (open->action) | |
1777 | { | |
6c1abb5c FXC |
1778 | fputs (" ACTION=", dumpfile); |
1779 | show_expr (open->action); | |
6de9cd9a DN |
1780 | } |
1781 | if (open->delim) | |
1782 | { | |
6c1abb5c FXC |
1783 | fputs (" DELIM=", dumpfile); |
1784 | show_expr (open->delim); | |
6de9cd9a DN |
1785 | } |
1786 | if (open->pad) | |
1787 | { | |
6c1abb5c FXC |
1788 | fputs (" PAD=", dumpfile); |
1789 | show_expr (open->pad); | |
6de9cd9a | 1790 | } |
6f0f0b2e JD |
1791 | if (open->decimal) |
1792 | { | |
6c1abb5c FXC |
1793 | fputs (" DECIMAL=", dumpfile); |
1794 | show_expr (open->decimal); | |
6f0f0b2e JD |
1795 | } |
1796 | if (open->encoding) | |
1797 | { | |
6c1abb5c FXC |
1798 | fputs (" ENCODING=", dumpfile); |
1799 | show_expr (open->encoding); | |
6f0f0b2e JD |
1800 | } |
1801 | if (open->round) | |
1802 | { | |
6c1abb5c FXC |
1803 | fputs (" ROUND=", dumpfile); |
1804 | show_expr (open->round); | |
6f0f0b2e JD |
1805 | } |
1806 | if (open->sign) | |
1807 | { | |
6c1abb5c FXC |
1808 | fputs (" SIGN=", dumpfile); |
1809 | show_expr (open->sign); | |
6f0f0b2e | 1810 | } |
181c9f4a TK |
1811 | if (open->convert) |
1812 | { | |
6c1abb5c FXC |
1813 | fputs (" CONVERT=", dumpfile); |
1814 | show_expr (open->convert); | |
181c9f4a | 1815 | } |
6f0f0b2e JD |
1816 | if (open->asynchronous) |
1817 | { | |
6c1abb5c FXC |
1818 | fputs (" ASYNCHRONOUS=", dumpfile); |
1819 | show_expr (open->asynchronous); | |
6f0f0b2e | 1820 | } |
6de9cd9a | 1821 | if (open->err != NULL) |
6c1abb5c | 1822 | fprintf (dumpfile, " ERR=%d", open->err->value); |
6de9cd9a DN |
1823 | |
1824 | break; | |
1825 | ||
1826 | case EXEC_CLOSE: | |
6c1abb5c | 1827 | fputs ("CLOSE", dumpfile); |
6de9cd9a DN |
1828 | close = c->ext.close; |
1829 | ||
1830 | if (close->unit) | |
1831 | { | |
6c1abb5c FXC |
1832 | fputs (" UNIT=", dumpfile); |
1833 | show_expr (close->unit); | |
6de9cd9a | 1834 | } |
7aba8abe TK |
1835 | if (close->iomsg) |
1836 | { | |
6c1abb5c FXC |
1837 | fputs (" IOMSG=", dumpfile); |
1838 | show_expr (close->iomsg); | |
7aba8abe | 1839 | } |
6de9cd9a DN |
1840 | if (close->iostat) |
1841 | { | |
6c1abb5c FXC |
1842 | fputs (" IOSTAT=", dumpfile); |
1843 | show_expr (close->iostat); | |
6de9cd9a DN |
1844 | } |
1845 | if (close->status) | |
1846 | { | |
6c1abb5c FXC |
1847 | fputs (" STATUS=", dumpfile); |
1848 | show_expr (close->status); | |
6de9cd9a DN |
1849 | } |
1850 | if (close->err != NULL) | |
6c1abb5c | 1851 | fprintf (dumpfile, " ERR=%d", close->err->value); |
6de9cd9a DN |
1852 | break; |
1853 | ||
1854 | case EXEC_BACKSPACE: | |
6c1abb5c | 1855 | fputs ("BACKSPACE", dumpfile); |
6de9cd9a DN |
1856 | goto show_filepos; |
1857 | ||
1858 | case EXEC_ENDFILE: | |
6c1abb5c | 1859 | fputs ("ENDFILE", dumpfile); |
6de9cd9a DN |
1860 | goto show_filepos; |
1861 | ||
1862 | case EXEC_REWIND: | |
6c1abb5c | 1863 | fputs ("REWIND", dumpfile); |
6403ec5f JB |
1864 | goto show_filepos; |
1865 | ||
1866 | case EXEC_FLUSH: | |
6c1abb5c | 1867 | fputs ("FLUSH", dumpfile); |
6de9cd9a DN |
1868 | |
1869 | show_filepos: | |
1870 | fp = c->ext.filepos; | |
1871 | ||
1872 | if (fp->unit) | |
1873 | { | |
6c1abb5c FXC |
1874 | fputs (" UNIT=", dumpfile); |
1875 | show_expr (fp->unit); | |
6de9cd9a | 1876 | } |
7aba8abe TK |
1877 | if (fp->iomsg) |
1878 | { | |
6c1abb5c FXC |
1879 | fputs (" IOMSG=", dumpfile); |
1880 | show_expr (fp->iomsg); | |
7aba8abe | 1881 | } |
6de9cd9a DN |
1882 | if (fp->iostat) |
1883 | { | |
6c1abb5c FXC |
1884 | fputs (" IOSTAT=", dumpfile); |
1885 | show_expr (fp->iostat); | |
6de9cd9a DN |
1886 | } |
1887 | if (fp->err != NULL) | |
6c1abb5c | 1888 | fprintf (dumpfile, " ERR=%d", fp->err->value); |
6de9cd9a DN |
1889 | break; |
1890 | ||
1891 | case EXEC_INQUIRE: | |
6c1abb5c | 1892 | fputs ("INQUIRE", dumpfile); |
6de9cd9a DN |
1893 | i = c->ext.inquire; |
1894 | ||
1895 | if (i->unit) | |
1896 | { | |
6c1abb5c FXC |
1897 | fputs (" UNIT=", dumpfile); |
1898 | show_expr (i->unit); | |
6de9cd9a DN |
1899 | } |
1900 | if (i->file) | |
1901 | { | |
6c1abb5c FXC |
1902 | fputs (" FILE=", dumpfile); |
1903 | show_expr (i->file); | |
6de9cd9a DN |
1904 | } |
1905 | ||
7aba8abe TK |
1906 | if (i->iomsg) |
1907 | { | |
6c1abb5c FXC |
1908 | fputs (" IOMSG=", dumpfile); |
1909 | show_expr (i->iomsg); | |
7aba8abe | 1910 | } |
6de9cd9a DN |
1911 | if (i->iostat) |
1912 | { | |
6c1abb5c FXC |
1913 | fputs (" IOSTAT=", dumpfile); |
1914 | show_expr (i->iostat); | |
6de9cd9a DN |
1915 | } |
1916 | if (i->exist) | |
1917 | { | |
6c1abb5c FXC |
1918 | fputs (" EXIST=", dumpfile); |
1919 | show_expr (i->exist); | |
6de9cd9a DN |
1920 | } |
1921 | if (i->opened) | |
1922 | { | |
6c1abb5c FXC |
1923 | fputs (" OPENED=", dumpfile); |
1924 | show_expr (i->opened); | |
6de9cd9a DN |
1925 | } |
1926 | if (i->number) | |
1927 | { | |
6c1abb5c FXC |
1928 | fputs (" NUMBER=", dumpfile); |
1929 | show_expr (i->number); | |
6de9cd9a DN |
1930 | } |
1931 | if (i->named) | |
1932 | { | |
6c1abb5c FXC |
1933 | fputs (" NAMED=", dumpfile); |
1934 | show_expr (i->named); | |
6de9cd9a DN |
1935 | } |
1936 | if (i->name) | |
1937 | { | |
6c1abb5c FXC |
1938 | fputs (" NAME=", dumpfile); |
1939 | show_expr (i->name); | |
6de9cd9a DN |
1940 | } |
1941 | if (i->access) | |
1942 | { | |
6c1abb5c FXC |
1943 | fputs (" ACCESS=", dumpfile); |
1944 | show_expr (i->access); | |
6de9cd9a DN |
1945 | } |
1946 | if (i->sequential) | |
1947 | { | |
6c1abb5c FXC |
1948 | fputs (" SEQUENTIAL=", dumpfile); |
1949 | show_expr (i->sequential); | |
6de9cd9a DN |
1950 | } |
1951 | ||
1952 | if (i->direct) | |
1953 | { | |
6c1abb5c FXC |
1954 | fputs (" DIRECT=", dumpfile); |
1955 | show_expr (i->direct); | |
6de9cd9a DN |
1956 | } |
1957 | if (i->form) | |
1958 | { | |
6c1abb5c FXC |
1959 | fputs (" FORM=", dumpfile); |
1960 | show_expr (i->form); | |
6de9cd9a DN |
1961 | } |
1962 | if (i->formatted) | |
1963 | { | |
6c1abb5c FXC |
1964 | fputs (" FORMATTED", dumpfile); |
1965 | show_expr (i->formatted); | |
6de9cd9a DN |
1966 | } |
1967 | if (i->unformatted) | |
1968 | { | |
6c1abb5c FXC |
1969 | fputs (" UNFORMATTED=", dumpfile); |
1970 | show_expr (i->unformatted); | |
6de9cd9a DN |
1971 | } |
1972 | if (i->recl) | |
1973 | { | |
6c1abb5c FXC |
1974 | fputs (" RECL=", dumpfile); |
1975 | show_expr (i->recl); | |
6de9cd9a DN |
1976 | } |
1977 | if (i->nextrec) | |
1978 | { | |
6c1abb5c FXC |
1979 | fputs (" NEXTREC=", dumpfile); |
1980 | show_expr (i->nextrec); | |
6de9cd9a DN |
1981 | } |
1982 | if (i->blank) | |
1983 | { | |
6c1abb5c FXC |
1984 | fputs (" BLANK=", dumpfile); |
1985 | show_expr (i->blank); | |
6de9cd9a DN |
1986 | } |
1987 | if (i->position) | |
1988 | { | |
6c1abb5c FXC |
1989 | fputs (" POSITION=", dumpfile); |
1990 | show_expr (i->position); | |
6de9cd9a DN |
1991 | } |
1992 | if (i->action) | |
1993 | { | |
6c1abb5c FXC |
1994 | fputs (" ACTION=", dumpfile); |
1995 | show_expr (i->action); | |
6de9cd9a DN |
1996 | } |
1997 | if (i->read) | |
1998 | { | |
6c1abb5c FXC |
1999 | fputs (" READ=", dumpfile); |
2000 | show_expr (i->read); | |
6de9cd9a DN |
2001 | } |
2002 | if (i->write) | |
2003 | { | |
6c1abb5c FXC |
2004 | fputs (" WRITE=", dumpfile); |
2005 | show_expr (i->write); | |
6de9cd9a DN |
2006 | } |
2007 | if (i->readwrite) | |
2008 | { | |
6c1abb5c FXC |
2009 | fputs (" READWRITE=", dumpfile); |
2010 | show_expr (i->readwrite); | |
6de9cd9a DN |
2011 | } |
2012 | if (i->delim) | |
2013 | { | |
6c1abb5c FXC |
2014 | fputs (" DELIM=", dumpfile); |
2015 | show_expr (i->delim); | |
6de9cd9a DN |
2016 | } |
2017 | if (i->pad) | |
2018 | { | |
6c1abb5c FXC |
2019 | fputs (" PAD=", dumpfile); |
2020 | show_expr (i->pad); | |
6de9cd9a | 2021 | } |
181c9f4a TK |
2022 | if (i->convert) |
2023 | { | |
6c1abb5c FXC |
2024 | fputs (" CONVERT=", dumpfile); |
2025 | show_expr (i->convert); | |
181c9f4a | 2026 | } |
6f0f0b2e JD |
2027 | if (i->asynchronous) |
2028 | { | |
6c1abb5c FXC |
2029 | fputs (" ASYNCHRONOUS=", dumpfile); |
2030 | show_expr (i->asynchronous); | |
6f0f0b2e JD |
2031 | } |
2032 | if (i->decimal) | |
2033 | { | |
6c1abb5c FXC |
2034 | fputs (" DECIMAL=", dumpfile); |
2035 | show_expr (i->decimal); | |
6f0f0b2e JD |
2036 | } |
2037 | if (i->encoding) | |
2038 | { | |
6c1abb5c FXC |
2039 | fputs (" ENCODING=", dumpfile); |
2040 | show_expr (i->encoding); | |
6f0f0b2e JD |
2041 | } |
2042 | if (i->pending) | |
2043 | { | |
6c1abb5c FXC |
2044 | fputs (" PENDING=", dumpfile); |
2045 | show_expr (i->pending); | |
6f0f0b2e JD |
2046 | } |
2047 | if (i->round) | |
2048 | { | |
6c1abb5c FXC |
2049 | fputs (" ROUND=", dumpfile); |
2050 | show_expr (i->round); | |
6f0f0b2e JD |
2051 | } |
2052 | if (i->sign) | |
2053 | { | |
6c1abb5c FXC |
2054 | fputs (" SIGN=", dumpfile); |
2055 | show_expr (i->sign); | |
6f0f0b2e JD |
2056 | } |
2057 | if (i->size) | |
2058 | { | |
6c1abb5c FXC |
2059 | fputs (" SIZE=", dumpfile); |
2060 | show_expr (i->size); | |
6f0f0b2e JD |
2061 | } |
2062 | if (i->id) | |
2063 | { | |
6c1abb5c FXC |
2064 | fputs (" ID=", dumpfile); |
2065 | show_expr (i->id); | |
6f0f0b2e | 2066 | } |
6de9cd9a DN |
2067 | |
2068 | if (i->err != NULL) | |
6c1abb5c | 2069 | fprintf (dumpfile, " ERR=%d", i->err->value); |
6de9cd9a DN |
2070 | break; |
2071 | ||
2072 | case EXEC_IOLENGTH: | |
6c1abb5c | 2073 | fputs ("IOLENGTH ", dumpfile); |
a513927a | 2074 | show_expr (c->expr1); |
5e805e44 | 2075 | goto show_dt_code; |
6de9cd9a DN |
2076 | break; |
2077 | ||
2078 | case EXEC_READ: | |
6c1abb5c | 2079 | fputs ("READ", dumpfile); |
6de9cd9a DN |
2080 | goto show_dt; |
2081 | ||
2082 | case EXEC_WRITE: | |
6c1abb5c | 2083 | fputs ("WRITE", dumpfile); |
6de9cd9a DN |
2084 | |
2085 | show_dt: | |
2086 | dt = c->ext.dt; | |
2087 | if (dt->io_unit) | |
2088 | { | |
6c1abb5c FXC |
2089 | fputs (" UNIT=", dumpfile); |
2090 | show_expr (dt->io_unit); | |
6de9cd9a DN |
2091 | } |
2092 | ||
2093 | if (dt->format_expr) | |
2094 | { | |
6c1abb5c FXC |
2095 | fputs (" FMT=", dumpfile); |
2096 | show_expr (dt->format_expr); | |
6de9cd9a DN |
2097 | } |
2098 | ||
2099 | if (dt->format_label != NULL) | |
6c1abb5c | 2100 | fprintf (dumpfile, " FMT=%d", dt->format_label->value); |
6de9cd9a | 2101 | if (dt->namelist) |
6c1abb5c | 2102 | fprintf (dumpfile, " NML=%s", dt->namelist->name); |
7aba8abe TK |
2103 | |
2104 | if (dt->iomsg) | |
2105 | { | |
6c1abb5c FXC |
2106 | fputs (" IOMSG=", dumpfile); |
2107 | show_expr (dt->iomsg); | |
7aba8abe | 2108 | } |
6de9cd9a DN |
2109 | if (dt->iostat) |
2110 | { | |
6c1abb5c FXC |
2111 | fputs (" IOSTAT=", dumpfile); |
2112 | show_expr (dt->iostat); | |
6de9cd9a DN |
2113 | } |
2114 | if (dt->size) | |
2115 | { | |
6c1abb5c FXC |
2116 | fputs (" SIZE=", dumpfile); |
2117 | show_expr (dt->size); | |
6de9cd9a DN |
2118 | } |
2119 | if (dt->rec) | |
2120 | { | |
6c1abb5c FXC |
2121 | fputs (" REC=", dumpfile); |
2122 | show_expr (dt->rec); | |
6de9cd9a DN |
2123 | } |
2124 | if (dt->advance) | |
2125 | { | |
6c1abb5c FXC |
2126 | fputs (" ADVANCE=", dumpfile); |
2127 | show_expr (dt->advance); | |
6de9cd9a | 2128 | } |
6f0f0b2e JD |
2129 | if (dt->id) |
2130 | { | |
6c1abb5c FXC |
2131 | fputs (" ID=", dumpfile); |
2132 | show_expr (dt->id); | |
6f0f0b2e JD |
2133 | } |
2134 | if (dt->pos) | |
2135 | { | |
6c1abb5c FXC |
2136 | fputs (" POS=", dumpfile); |
2137 | show_expr (dt->pos); | |
6f0f0b2e JD |
2138 | } |
2139 | if (dt->asynchronous) | |
2140 | { | |
6c1abb5c FXC |
2141 | fputs (" ASYNCHRONOUS=", dumpfile); |
2142 | show_expr (dt->asynchronous); | |
6f0f0b2e JD |
2143 | } |
2144 | if (dt->blank) | |
2145 | { | |
6c1abb5c FXC |
2146 | fputs (" BLANK=", dumpfile); |
2147 | show_expr (dt->blank); | |
6f0f0b2e JD |
2148 | } |
2149 | if (dt->decimal) | |
2150 | { | |
6c1abb5c FXC |
2151 | fputs (" DECIMAL=", dumpfile); |
2152 | show_expr (dt->decimal); | |
6f0f0b2e JD |
2153 | } |
2154 | if (dt->delim) | |
2155 | { | |
6c1abb5c FXC |
2156 | fputs (" DELIM=", dumpfile); |
2157 | show_expr (dt->delim); | |
6f0f0b2e JD |
2158 | } |
2159 | if (dt->pad) | |
2160 | { | |
6c1abb5c FXC |
2161 | fputs (" PAD=", dumpfile); |
2162 | show_expr (dt->pad); | |
6f0f0b2e JD |
2163 | } |
2164 | if (dt->round) | |
2165 | { | |
6c1abb5c FXC |
2166 | fputs (" ROUND=", dumpfile); |
2167 | show_expr (dt->round); | |
6f0f0b2e JD |
2168 | } |
2169 | if (dt->sign) | |
2170 | { | |
6c1abb5c FXC |
2171 | fputs (" SIGN=", dumpfile); |
2172 | show_expr (dt->sign); | |
6f0f0b2e | 2173 | } |
6de9cd9a | 2174 | |
5e805e44 | 2175 | show_dt_code: |
5e805e44 | 2176 | for (c = c->block->next; c; c = c->next) |
6c1abb5c | 2177 | show_code_node (level + (c->next != NULL), c); |
5e805e44 | 2178 | return; |
6de9cd9a DN |
2179 | |
2180 | case EXEC_TRANSFER: | |
6c1abb5c | 2181 | fputs ("TRANSFER ", dumpfile); |
a513927a | 2182 | show_expr (c->expr1); |
6de9cd9a DN |
2183 | break; |
2184 | ||
2185 | case EXEC_DT_END: | |
6c1abb5c | 2186 | fputs ("DT_END", dumpfile); |
6de9cd9a DN |
2187 | dt = c->ext.dt; |
2188 | ||
2189 | if (dt->err != NULL) | |
6c1abb5c | 2190 | fprintf (dumpfile, " ERR=%d", dt->err->value); |
6de9cd9a | 2191 | if (dt->end != NULL) |
6c1abb5c | 2192 | fprintf (dumpfile, " END=%d", dt->end->value); |
6de9cd9a | 2193 | if (dt->eor != NULL) |
6c1abb5c | 2194 | fprintf (dumpfile, " EOR=%d", dt->eor->value); |
6de9cd9a DN |
2195 | break; |
2196 | ||
6c7a4dfd JJ |
2197 | case EXEC_OMP_ATOMIC: |
2198 | case EXEC_OMP_BARRIER: | |
2199 | case EXEC_OMP_CRITICAL: | |
2200 | case EXEC_OMP_FLUSH: | |
2201 | case EXEC_OMP_DO: | |
2202 | case EXEC_OMP_MASTER: | |
2203 | case EXEC_OMP_ORDERED: | |
2204 | case EXEC_OMP_PARALLEL: | |
2205 | case EXEC_OMP_PARALLEL_DO: | |
2206 | case EXEC_OMP_PARALLEL_SECTIONS: | |
2207 | case EXEC_OMP_PARALLEL_WORKSHARE: | |
2208 | case EXEC_OMP_SECTIONS: | |
2209 | case EXEC_OMP_SINGLE: | |
a68ab351 JJ |
2210 | case EXEC_OMP_TASK: |
2211 | case EXEC_OMP_TASKWAIT: | |
20906c66 | 2212 | case EXEC_OMP_TASKYIELD: |
6c7a4dfd | 2213 | case EXEC_OMP_WORKSHARE: |
6c1abb5c | 2214 | show_omp_node (level, c); |
6c7a4dfd JJ |
2215 | break; |
2216 | ||
6de9cd9a | 2217 | default: |
6c1abb5c | 2218 | gfc_internal_error ("show_code_node(): Bad statement code"); |
6de9cd9a | 2219 | } |
6de9cd9a DN |
2220 | } |
2221 | ||
2222 | ||
30c05595 | 2223 | /* Show an equivalence chain. */ |
1854117e | 2224 | |
6c1abb5c FXC |
2225 | static void |
2226 | show_equiv (gfc_equiv *eq) | |
1854117e PB |
2227 | { |
2228 | show_indent (); | |
6c1abb5c | 2229 | fputs ("Equivalence: ", dumpfile); |
1854117e PB |
2230 | while (eq) |
2231 | { | |
6c1abb5c | 2232 | show_expr (eq->expr); |
1854117e PB |
2233 | eq = eq->eq; |
2234 | if (eq) | |
6c1abb5c | 2235 | fputs (", ", dumpfile); |
1854117e PB |
2236 | } |
2237 | } | |
2238 | ||
6c1abb5c | 2239 | |
6de9cd9a DN |
2240 | /* Show a freakin' whole namespace. */ |
2241 | ||
6c1abb5c FXC |
2242 | static void |
2243 | show_namespace (gfc_namespace *ns) | |
6de9cd9a DN |
2244 | { |
2245 | gfc_interface *intr; | |
2246 | gfc_namespace *save; | |
09639a83 | 2247 | int op; |
1854117e | 2248 | gfc_equiv *eq; |
6de9cd9a DN |
2249 | int i; |
2250 | ||
fc2655fb | 2251 | gcc_assert (ns); |
6de9cd9a | 2252 | save = gfc_current_ns; |
6de9cd9a DN |
2253 | |
2254 | show_indent (); | |
6c1abb5c | 2255 | fputs ("Namespace:", dumpfile); |
6de9cd9a | 2256 | |
fc2655fb TB |
2257 | i = 0; |
2258 | do | |
6de9cd9a | 2259 | { |
fc2655fb TB |
2260 | int l = i; |
2261 | while (i < GFC_LETTERS - 1 | |
2262 | && gfc_compare_types (&ns->default_type[i+1], | |
2263 | &ns->default_type[l])) | |
2264 | i++; | |
2265 | ||
2266 | if (i > l) | |
2267 | fprintf (dumpfile, " %c-%c: ", l+'A', i+'A'); | |
2268 | else | |
2269 | fprintf (dumpfile, " %c: ", l+'A'); | |
6de9cd9a | 2270 | |
fc2655fb TB |
2271 | show_typespec(&ns->default_type[l]); |
2272 | i++; | |
2273 | } while (i < GFC_LETTERS); | |
6de9cd9a | 2274 | |
fc2655fb TB |
2275 | if (ns->proc_name != NULL) |
2276 | { | |
2277 | show_indent (); | |
2278 | fprintf (dumpfile, "procedure name = %s", ns->proc_name->name); | |
2279 | } | |
6de9cd9a | 2280 | |
fc2655fb TB |
2281 | ++show_level; |
2282 | gfc_current_ns = ns; | |
2283 | gfc_traverse_symtree (ns->common_root, show_common); | |
fbc9b453 | 2284 | |
fc2655fb | 2285 | gfc_traverse_symtree (ns->sym_root, show_symtree); |
6de9cd9a | 2286 | |
fc2655fb TB |
2287 | for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++) |
2288 | { | |
2289 | /* User operator interfaces */ | |
2290 | intr = ns->op[op]; | |
2291 | if (intr == NULL) | |
2292 | continue; | |
6de9cd9a | 2293 | |
fc2655fb TB |
2294 | show_indent (); |
2295 | fprintf (dumpfile, "Operator interfaces for %s:", | |
2296 | gfc_op2string ((gfc_intrinsic_op) op)); | |
6de9cd9a | 2297 | |
fc2655fb TB |
2298 | for (; intr; intr = intr->next) |
2299 | fprintf (dumpfile, " %s", intr->sym->name); | |
2300 | } | |
6de9cd9a | 2301 | |
fc2655fb TB |
2302 | if (ns->uop_root != NULL) |
2303 | { | |
2304 | show_indent (); | |
2305 | fputs ("User operators:\n", dumpfile); | |
2306 | gfc_traverse_user_op (ns, show_uop); | |
6de9cd9a | 2307 | } |
1854117e PB |
2308 | |
2309 | for (eq = ns->equiv; eq; eq = eq->next) | |
6c1abb5c | 2310 | show_equiv (eq); |
6de9cd9a | 2311 | |
6c1abb5c | 2312 | fputc ('\n', dumpfile); |
8cf8ca52 TK |
2313 | show_indent (); |
2314 | fputs ("code:", dumpfile); | |
7ed979b9 | 2315 | show_code (show_level, ns->code); |
8cf8ca52 | 2316 | --show_level; |
6de9cd9a DN |
2317 | |
2318 | for (ns = ns->contained; ns; ns = ns->sibling) | |
2319 | { | |
8cf8ca52 TK |
2320 | fputs ("\nCONTAINS\n", dumpfile); |
2321 | ++show_level; | |
6c1abb5c | 2322 | show_namespace (ns); |
8cf8ca52 | 2323 | --show_level; |
6de9cd9a DN |
2324 | } |
2325 | ||
6c1abb5c | 2326 | fputc ('\n', dumpfile); |
6de9cd9a DN |
2327 | gfc_current_ns = save; |
2328 | } | |
6c1abb5c FXC |
2329 | |
2330 | ||
2331 | /* Main function for dumping a parse tree. */ | |
2332 | ||
2333 | void | |
2334 | gfc_dump_parse_tree (gfc_namespace *ns, FILE *file) | |
2335 | { | |
2336 | dumpfile = file; | |
2337 | show_namespace (ns); | |
2338 | } | |
94fae14b | 2339 |