diff options
Diffstat (limited to 'gcc/fortran/dump-parse-tree.c')
| -rw-r--r-- | gcc/fortran/dump-parse-tree.c | 261 |
1 files changed, 238 insertions, 23 deletions
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 8c24074215..87a530458f 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1,5 +1,5 @@ /* Parse tree dumper - Copyright (C) 2003-2016 Free Software Foundation, Inc. + Copyright (C) 2003-2017 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. @@ -47,6 +47,7 @@ static FILE *dumpfile; static void show_expr (gfc_expr *p); static void show_code_node (int, gfc_code *); static void show_namespace (gfc_namespace *ns); +static void show_code (int, gfc_code *); /* Allow dumping of an expression in the debugger. */ @@ -62,6 +63,18 @@ gfc_debug_expr (gfc_expr *e) dumpfile = tmp; } +/* Allow for dumping of a piece of code in the debugger. */ +void gfc_debug_code (gfc_code *c); + +void +gfc_debug_code (gfc_code *c) +{ + FILE *tmp = dumpfile; + dumpfile = stderr; + show_code (1, c); + fputc ('\n', dumpfile); + dumpfile = tmp; +} /* Do indentation for a specific level. */ @@ -227,7 +240,7 @@ show_array_ref (gfc_array_ref * ar) print the start expression which contains the vector, in the latter case we have to print any of lower and upper bound and the stride, if they're present. */ - + if (ar->start[i] != NULL) show_expr (ar->start[i]); @@ -429,7 +442,7 @@ show_expr (gfc_expr *p) break; case BT_CHARACTER: - show_char_const (p->value.character.string, + show_char_const (p->value.character.string, p->value.character.length); break; @@ -982,7 +995,7 @@ show_common (gfc_symtree *st) fputs (", ", dumpfile); } fputc ('\n', dumpfile); -} +} /* Worker function to display the symbol tree. */ @@ -1059,6 +1072,27 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + case OMP_DEPEND_SINK_FIRST: + fputs ("sink:", dumpfile); + while (1) + { + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc ('+', dumpfile); + show_expr (n->expr); + } + if (n->next == NULL) + break; + else if (n->next->u.depend_op != OMP_DEPEND_SINK) + { + fputs (") DEPEND(", dumpfile); + break; + } + fputc (',', dumpfile); + n = n->next; + } + continue; default: break; } else if (list_type == OMP_LIST_MAP) @@ -1070,7 +1104,17 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break; default: break; } + else if (list_type == OMP_LIST_LINEAR) + switch (n->u.linear_op) + { + case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break; + case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break; + case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break; + default: break; + } fprintf (dumpfile, "%s", n->sym->name); + if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT) + fputc (')', dumpfile); if (n->expr) { fputc (':', dumpfile); @@ -1087,7 +1131,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) static void show_omp_clauses (gfc_omp_clauses *omp_clauses) { - int list_type; + int list_type, i; switch (omp_clauses->cancel) { @@ -1209,7 +1253,20 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) default: gcc_unreachable (); } - fprintf (dumpfile, " SCHEDULE (%s", type); + fputs (" SCHEDULE (", dumpfile); + if (omp_clauses->sched_simd) + { + if (omp_clauses->sched_monotonic + || omp_clauses->sched_nonmonotonic) + fputs ("SIMD, ", dumpfile); + else + fputs ("SIMD: ", dumpfile); + } + if (omp_clauses->sched_monotonic) + fputs ("MONOTONIC: ", dumpfile); + else if (omp_clauses->sched_nonmonotonic) + fputs ("NONMONOTONIC: ", dumpfile); + fputs (type, dumpfile); if (omp_clauses->chunk_size) { fputc (',', dumpfile); @@ -1238,7 +1295,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) for (list = omp_clauses->tile_list; list; list = list->next) { show_expr (list->expr); - if (list->next) + if (list->next) fputs (", ", dumpfile); } fputc (')', dumpfile); @@ -1250,7 +1307,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) for (list = omp_clauses->wait_list; list; list = list->next) { show_expr (list->expr); - if (list->next) + if (list->next) fputs (", ", dumpfile); } fputc (')', dumpfile); @@ -1260,7 +1317,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) if (omp_clauses->independent) fputs (" INDEPENDENT", dumpfile); if (omp_clauses->ordered) - fputs (" ORDERED", dumpfile); + { + if (omp_clauses->orderedc) + fprintf (dumpfile, " ORDERED(%d)", omp_clauses->orderedc); + else + fputs (" ORDERED", dumpfile); + } if (omp_clauses->untied) fputs (" UNTIED", dumpfile); if (omp_clauses->mergeable) @@ -1286,6 +1348,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_ALIGNED: type = "ALIGNED"; break; case OMP_LIST_LINEAR: type = "LINEAR"; break; case OMP_LIST_REDUCTION: type = "REDUCTION"; break; + case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break; + case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_DEPEND: type = "DEPEND"; break; default: gcc_unreachable (); @@ -1343,7 +1407,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE) { - fprintf (dumpfile, " DIST_SCHEDULE (static"); + fprintf (dumpfile, " DIST_SCHEDULE (STATIC"); if (omp_clauses->dist_chunk_size) { fputc (',', dumpfile); @@ -1351,6 +1415,59 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fputc (')', dumpfile); } + if (omp_clauses->defaultmap) + fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile); + if (omp_clauses->nogroup) + fputs (" NOGROUP", dumpfile); + if (omp_clauses->simd) + fputs (" SIMD", dumpfile); + if (omp_clauses->threads) + fputs (" THREADS", dumpfile); + if (omp_clauses->grainsize) + { + fputs (" GRAINSIZE(", dumpfile); + show_expr (omp_clauses->grainsize); + fputc (')', dumpfile); + } + if (omp_clauses->hint) + { + fputs (" HINT(", dumpfile); + show_expr (omp_clauses->hint); + fputc (')', dumpfile); + } + if (omp_clauses->num_tasks) + { + fputs (" NUM_TASKS(", dumpfile); + show_expr (omp_clauses->num_tasks); + fputc (')', dumpfile); + } + if (omp_clauses->priority) + { + fputs (" PRIORITY(", dumpfile); + show_expr (omp_clauses->priority); + fputc (')', dumpfile); + } + for (i = 0; i < OMP_IF_LAST; i++) + if (omp_clauses->if_exprs[i]) + { + static const char *ifs[] = { + "PARALLEL", + "TASK", + "TASKLOOP", + "TARGET", + "TARGET DATA", + "TARGET UPDATE", + "TARGET ENTER DATA", + "TARGET EXIT DATA" + }; + fputs (" IF(", dumpfile); + fputs (ifs[i], dumpfile); + fputs (": ", dumpfile); + show_expr (omp_clauses->if_exprs[i]); + fputc (')', dumpfile); + } + if (omp_clauses->depend_source) + fputs (" DEPEND(source)", dumpfile); } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -1365,7 +1482,8 @@ show_omp_node (int level, gfc_code *c) switch (c->op) { - case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; is_oacc = true; break; + case EXEC_OACC_PARALLEL_LOOP: + name = "PARALLEL LOOP"; is_oacc = true; break; case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break; case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break; case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break; @@ -1382,9 +1500,15 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_CANCEL: name = "CANCEL"; break; case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break; case EXEC_OMP_CRITICAL: name = "CRITICAL"; break; - case EXEC_OMP_FLUSH: name = "FLUSH"; break; + case EXEC_OMP_DISTRIBUTE: name = "DISTRIBUTE"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + name = "DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break; case EXEC_OMP_DO: name = "DO"; break; case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; + case EXEC_OMP_FLUSH: name = "FLUSH"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_ORDERED: name = "ORDERED"; break; case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; @@ -1395,10 +1519,38 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; + case EXEC_OMP_TARGET: name = "TARGET"; break; + case EXEC_OMP_TARGET_DATA: name = "TARGET DATA"; break; + case EXEC_OMP_TARGET_ENTER_DATA: name = "TARGET ENTER DATA"; break; + case EXEC_OMP_TARGET_EXIT_DATA: name = "TARGET EXIT DATA"; break; + case EXEC_OMP_TARGET_PARALLEL: name = "TARGET PARALLEL"; break; + case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + name = "TARGET_PARALLEL_DO_SIMD"; break; + case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break; + case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + name = "TARGET TEAMS DISTRIBUTE"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "TARGET TEAMS DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + name = "TARGET TEAMS DISTRIBUTE SIMD"; break; + case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break; case EXEC_OMP_TASK: name = "TASK"; break; case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; + case EXEC_OMP_TASKLOOP: name = "TASKLOOP"; break; + case EXEC_OMP_TASKLOOP_SIMD: name = "TASKLOOP SIMD"; break; case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; + case EXEC_OMP_TEAMS: name = "TEAMS"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "TEAMS DISTRIBUTE"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "TEAMS DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; default: gcc_unreachable (); @@ -1420,23 +1572,50 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_EXIT_DATA: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: - case EXEC_OMP_WORKSHARE: - case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_WORKSHARE: omp_clauses = c->ext.omp_clauses; break; case EXEC_OMP_CRITICAL: - if (c->ext.omp_name) - fprintf (dumpfile, " (%s)", c->ext.omp_name); + omp_clauses = c->ext.omp_clauses; + if (omp_clauses) + fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); break; case EXEC_OMP_FLUSH: if (c->ext.omp_namelist) @@ -1457,9 +1636,12 @@ show_omp_node (int level, gfc_code *c) show_omp_clauses (omp_clauses); fputc ('\n', dumpfile); - /* OpenACC executable directives don't have associated blocks. */ + /* OpenMP and OpenACC executable directives don't have associated blocks. */ if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE - || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA) + || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA + || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA + || c->op == EXEC_OMP_TARGET_EXIT_DATA + || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) { @@ -1493,8 +1675,8 @@ show_omp_node (int level, gfc_code *c) else if (omp_clauses->nowait) fputs (" NOWAIT", dumpfile); } - else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name) - fprintf (dumpfile, " (%s)", c->ext.omp_name); + else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses) + fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); } @@ -1636,6 +1818,10 @@ show_code_node (int level, gfc_code *c) break; + case EXEC_FAIL_IMAGE: + fputs ("FAIL IMAGE ", dumpfile); + break; + case EXEC_SYNC_ALL: fputs ("SYNC ALL ", dumpfile); if (c->expr2 != NULL) @@ -1815,8 +2001,12 @@ show_code_node (int level, gfc_code *c) break; case EXEC_SELECT: + case EXEC_SELECT_TYPE: d = c->block; - fputs ("SELECT CASE ", dumpfile); + if (c->op == EXEC_SELECT_TYPE) + fputs ("SELECT TYPE ", dumpfile); + else + fputs ("SELECT CASE ", dumpfile); show_expr (c->expr1); fputc ('\n', dumpfile); @@ -2516,9 +2706,13 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: - case EXEC_OMP_FLUSH: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: @@ -2529,10 +2723,31 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: show_omp_node (level, c); break; @@ -2628,7 +2843,7 @@ show_namespace (gfc_namespace *ns) fputs ("User operators:\n", dumpfile); gfc_traverse_user_op (ns, show_uop); } - + for (eq = ns->equiv; eq; eq = eq->next) show_equiv (eq); |