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